From 756299419f07699c73bb2b52c35cfccfa1b49287 Mon Sep 17 00:00:00 2001
From: Daniel Schadt <kingdread@gmx.de>
Date: Wed, 30 Jun 2021 12:55:28 +0200
Subject: Implement parseResponse
---
src/Cana/Protocol.hs | 42 ++++++++++++++++++++++++++++++++++++------
1 file changed, 36 insertions(+), 6 deletions(-)
diff --git a/src/Cana/Protocol.hs b/src/Cana/Protocol.hs
index 629353a..1a5f48e 100644
--- a/src/Cana/Protocol.hs
+++ b/src/Cana/Protocol.hs
@@ -33,15 +33,22 @@ module Cana.Protocol
, GeminiRequest(..)
, GeminiResponse(..)
, renderResponse
+ , parseResponse
-- * Various things
, defaultGeminiPort
) where
-import qualified Data.ByteString.Lazy as B
-import Data.ByteString.Builder
-import Data.X509 (CertificateChain)
-import Network.URI
-import Network.Socket (ServiceName)
+import Data.Maybe
+import Data.Char
+import Data.String
+import Text.Read
+import qualified Data.ByteString.Lazy as B
+import Data.ByteString.Lazy.Search
+import qualified Data.ByteString.Lazy.UTF8 as UTF
+import Data.ByteString.Builder
+import Data.X509 (CertificateChain)
+import Network.URI
+import Network.Socket (ServiceName)
-- | A Gemini status code, a two digit integer.
newtype StatusCode = StatusCode Int deriving (Eq, Show, Ord)
@@ -192,7 +199,7 @@ data GeminiResponse = GeminiResponse
{ responseStatus :: StatusCode -- ^ The response status code.
, responseMeta :: B.ByteString -- ^ The meta information.
, responseData :: B.ByteString -- ^ The actual response.
- }
+ } deriving (Show, Eq)
-- | Render a response to a 'ByteString', suitable to send over a socket.
renderResponse :: GeminiResponse -> B.ByteString
@@ -204,6 +211,29 @@ renderResponse rsp = toLazyByteString $ mconcat
, lazyByteString $ responseData rsp
]
+-- | Parse a text back to a 'GeminiResponse'.
+--
+-- This can be used to either verify that a response is well-formed, or it can
+-- be used to read back responses that have been serialized (for example, from
+-- CGI scripts).
+parseResponse :: B.ByteString -> Maybe GeminiResponse
+parseResponse text = do
+ let (header', body) = breakAfter headerDelim text
+ header = fromMaybe header' $ B.stripSuffix headerDelim header'
+ (code, meta') = B.break (== codeDelim) header
+ meta = B.dropWhile (== codeDelim) meta'
+ statusCode <- readMaybe (UTF.toString code) >>= fromInt
+ return GeminiResponse
+ { responseStatus = statusCode
+ , responseMeta = meta
+ , responseData = body
+ }
+ where
+ codeDelim :: Integral a => a
+ codeDelim = fromIntegral $ ord ' '
+ headerDelim :: IsString a => a
+ headerDelim = "\r\n"
+
-- | The default Gemini port, as given in the specification.
defaultGeminiPort :: ServiceName
defaultGeminiPort = "1965"
--
cgit v1.2.3