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