implemented encodeGemResponse
This commit is contained in:
parent
391ffd3eea
commit
43b76aa39c
|
@ -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']
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 $
|
||||
|
|
Loading…
Reference in New Issue
Block a user