implemented encodeGemResponse

This commit is contained in:
Jonathan Lamothe 2021-11-24 19:43:16 -05:00
parent 391ffd3eea
commit 43b76aa39c
4 changed files with 50 additions and 21 deletions

View File

@ -30,15 +30,21 @@ module Network.Gemini.Capsule.Encoding (
encodeGemURL,
decodeGemURL,
escapeString,
unescapeString
unescapeString,
encodeGemResponse
) where
import qualified Data.ByteString as BS
import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
import Data.ByteString.Builder (
charUtf8,
lazyByteString,
stringUtf8,
toLazyByteString,
word8Dec)
import qualified Data.ByteString.Lazy as BSL
import Data.Char (chr, ord, toLower)
import Data.List (find, intercalate)
import Data.Maybe (fromJust)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8')
@ -137,6 +143,25 @@ unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
toNum ch = fst $ fromJust $
find (\x -> snd x == ch) $ zip [0..] hexDigits
-- | encodes a 'GemResponse' into a lazy ByteString
encodeGemResponse :: GemResponse -> BSL.ByteString
encodeGemResponse resp = let
code = respStatus resp
high = code `div` 10
low = code `mod` 10
meta = respMeta resp
body = fromMaybe "" $ respBody resp
builder
= word8Dec high
<> word8Dec low
<> charUtf8 ' '
<> stringUtf8 meta
<> stringUtf8 "\r\n"
<> lazyByteString body
in toLazyByteString builder
hexDigits :: String
hexDigits = ['0'..'9'] ++ ['a'..'f']

View File

@ -35,7 +35,6 @@ time.
module Network.Gemini.Capsule.Internal (
runConnection,
readURL,
sendResponse,
strFromConn,
readMax,
stripCRLF
@ -47,7 +46,7 @@ import Control.Monad.Trans.Maybe (MaybeT (..))
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder, byteString, toLazyByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Connection (Connection, source)
import Data.Connection (Connection, send, source)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8')
import Data.X509 (Certificate)
@ -87,15 +86,6 @@ readURL conn =
Nothing -> Nothing
Just str -> decodeGemURL str
-- | Sends a 'GemResponse' to a 'Connection'
sendResponse
:: Connection a
-- ^ the connection
-> GemResponse
-- ^ the response being sent
-> IO ()
sendResponse = undefined
-- | Reads up to a maxumum number of bytes from a 'Connection', UTF-8
-- decodes it, and returns the resulting string (if possible) without
-- the trailing CR/LF
@ -150,4 +140,12 @@ readLoop maxLen src = lift (S.read src) >>= \case
then return b
else (b <>) <$> readLoop (maxLen - len) src
sendResponse
:: Connection a
-- ^ the connection
-> GemResponse
-- ^ the response being sent
-> IO ()
sendResponse conn resp = send conn $ encodeGemResponse resp
--jl

View File

@ -20,6 +20,8 @@ License along with this program. If not, see
-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Gemini.Capsule.EncodingSpec (spec) where
import Test.Hspec (Spec, context, describe, it, shouldBe)
@ -33,6 +35,7 @@ spec = describe "Encoding" $ do
decodeGemURLSpec
escapeStringSpec
unescapeStringSpec
encodeGemResponseSpec
encodeGemURLSpec :: Spec
encodeGemURLSpec = describe "encodeGemURL" $ mapM_
@ -143,4 +146,12 @@ unescapeStringSpec = describe "unescapeString" $ mapM_
, ( "foo%ff", Nothing )
]
encodeGemResponseSpec :: Spec
encodeGemResponseSpec = describe "encodeGemResponse" $
it ("should be " ++ show expect) $
encodeGemResponse resp `shouldBe` expect
where
resp = newGemResponse { respBody = Just "Success!\r\n" }
expect = "20 text/gemini\r\nSuccess!\r\n"
--jl

View File

@ -37,8 +37,7 @@ import Test.Hspec (
describe,
it,
shouldBe,
shouldReturn,
xit)
shouldReturn)
import Network.Gemini.Capsule.Types
import Network.Gemini.Capsule.Internal
@ -47,7 +46,6 @@ spec :: Spec
spec = describe "Internal" $ do
runConnectionSpec
readURLSpec
sendResponseSpec
strFromConnSpec
readMaxSpec
stripCRLFSpec
@ -55,7 +53,7 @@ spec = describe "Internal" $ do
runConnectionSpec :: Spec
runConnectionSpec = describe "runConnection" $ mapM_
( \(desc, ioConnRef, handler, mCert, expect) -> context desc $
xit ("should return " ++ show expect) $ do
it ("should return " ++ show expect) $ do
(conn, outRef) <- ioConnRef
runConnection conn handler mCert
readIORef outRef `shouldReturn` expect
@ -116,9 +114,6 @@ readURLSpec = describe "readURL" $ mapM_
longDir = replicate (1024 - BS.length prefix) 'A'
prefix = "gemini://example.com/"
sendResponseSpec :: Spec
sendResponseSpec = describe "sendResponse" $ return ()
strFromConnSpec :: Spec
strFromConnSpec = describe "strFromConn" $ mapM_
( \(desc, maxLen, ioConn, expect) -> context desc $