diff options
| -rw-r--r-- | src/Cana/Protocol.hs | 42 |
1 files 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" |