implemented encodeGemResponse
This commit is contained in:
parent
391ffd3eea
commit
43b76aa39c
|
@ -30,15 +30,21 @@ module Network.Gemini.Capsule.Encoding (
|
||||||
encodeGemURL,
|
encodeGemURL,
|
||||||
decodeGemURL,
|
decodeGemURL,
|
||||||
escapeString,
|
escapeString,
|
||||||
unescapeString
|
unescapeString,
|
||||||
|
encodeGemResponse
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString as BS
|
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 qualified Data.ByteString.Lazy as BSL
|
||||||
import Data.Char (chr, ord, toLower)
|
import Data.Char (chr, ord, toLower)
|
||||||
import Data.List (find, intercalate)
|
import Data.List (find, intercalate)
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust, fromMaybe)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text.Encoding (decodeUtf8')
|
import Data.Text.Encoding (decodeUtf8')
|
||||||
|
|
||||||
|
@ -137,6 +143,25 @@ unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
|
||||||
toNum ch = fst $ fromJust $
|
toNum ch = fst $ fromJust $
|
||||||
find (\x -> snd x == ch) $ zip [0..] hexDigits
|
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 :: String
|
||||||
hexDigits = ['0'..'9'] ++ ['a'..'f']
|
hexDigits = ['0'..'9'] ++ ['a'..'f']
|
||||||
|
|
||||||
|
|
|
@ -35,7 +35,6 @@ time.
|
||||||
module Network.Gemini.Capsule.Internal (
|
module Network.Gemini.Capsule.Internal (
|
||||||
runConnection,
|
runConnection,
|
||||||
readURL,
|
readURL,
|
||||||
sendResponse,
|
|
||||||
strFromConn,
|
strFromConn,
|
||||||
readMax,
|
readMax,
|
||||||
stripCRLF
|
stripCRLF
|
||||||
|
@ -47,7 +46,7 @@ import Control.Monad.Trans.Maybe (MaybeT (..))
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.ByteString.Builder (Builder, byteString, toLazyByteString)
|
import Data.ByteString.Builder (Builder, byteString, toLazyByteString)
|
||||||
import qualified Data.ByteString.Lazy as BSL
|
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 qualified Data.Text as T
|
||||||
import Data.Text.Encoding (decodeUtf8')
|
import Data.Text.Encoding (decodeUtf8')
|
||||||
import Data.X509 (Certificate)
|
import Data.X509 (Certificate)
|
||||||
|
@ -87,15 +86,6 @@ readURL conn =
|
||||||
Nothing -> Nothing
|
Nothing -> Nothing
|
||||||
Just str -> decodeGemURL str
|
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
|
-- | Reads up to a maxumum number of bytes from a 'Connection', UTF-8
|
||||||
-- decodes it, and returns the resulting string (if possible) without
|
-- decodes it, and returns the resulting string (if possible) without
|
||||||
-- the trailing CR/LF
|
-- the trailing CR/LF
|
||||||
|
@ -150,4 +140,12 @@ readLoop maxLen src = lift (S.read src) >>= \case
|
||||||
then return b
|
then return b
|
||||||
else (b <>) <$> readLoop (maxLen - len) src
|
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
|
--jl
|
||||||
|
|
|
@ -20,6 +20,8 @@ License along with this program. If not, see
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Network.Gemini.Capsule.EncodingSpec (spec) where
|
module Network.Gemini.Capsule.EncodingSpec (spec) where
|
||||||
|
|
||||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||||
|
@ -33,6 +35,7 @@ spec = describe "Encoding" $ do
|
||||||
decodeGemURLSpec
|
decodeGemURLSpec
|
||||||
escapeStringSpec
|
escapeStringSpec
|
||||||
unescapeStringSpec
|
unescapeStringSpec
|
||||||
|
encodeGemResponseSpec
|
||||||
|
|
||||||
encodeGemURLSpec :: Spec
|
encodeGemURLSpec :: Spec
|
||||||
encodeGemURLSpec = describe "encodeGemURL" $ mapM_
|
encodeGemURLSpec = describe "encodeGemURL" $ mapM_
|
||||||
|
@ -143,4 +146,12 @@ unescapeStringSpec = describe "unescapeString" $ mapM_
|
||||||
, ( "foo%ff", Nothing )
|
, ( "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
|
--jl
|
||||||
|
|
|
@ -37,8 +37,7 @@ import Test.Hspec (
|
||||||
describe,
|
describe,
|
||||||
it,
|
it,
|
||||||
shouldBe,
|
shouldBe,
|
||||||
shouldReturn,
|
shouldReturn)
|
||||||
xit)
|
|
||||||
|
|
||||||
import Network.Gemini.Capsule.Types
|
import Network.Gemini.Capsule.Types
|
||||||
import Network.Gemini.Capsule.Internal
|
import Network.Gemini.Capsule.Internal
|
||||||
|
@ -47,7 +46,6 @@ spec :: Spec
|
||||||
spec = describe "Internal" $ do
|
spec = describe "Internal" $ do
|
||||||
runConnectionSpec
|
runConnectionSpec
|
||||||
readURLSpec
|
readURLSpec
|
||||||
sendResponseSpec
|
|
||||||
strFromConnSpec
|
strFromConnSpec
|
||||||
readMaxSpec
|
readMaxSpec
|
||||||
stripCRLFSpec
|
stripCRLFSpec
|
||||||
|
@ -55,7 +53,7 @@ spec = describe "Internal" $ do
|
||||||
runConnectionSpec :: Spec
|
runConnectionSpec :: Spec
|
||||||
runConnectionSpec = describe "runConnection" $ mapM_
|
runConnectionSpec = describe "runConnection" $ mapM_
|
||||||
( \(desc, ioConnRef, handler, mCert, expect) -> context desc $
|
( \(desc, ioConnRef, handler, mCert, expect) -> context desc $
|
||||||
xit ("should return " ++ show expect) $ do
|
it ("should return " ++ show expect) $ do
|
||||||
(conn, outRef) <- ioConnRef
|
(conn, outRef) <- ioConnRef
|
||||||
runConnection conn handler mCert
|
runConnection conn handler mCert
|
||||||
readIORef outRef `shouldReturn` expect
|
readIORef outRef `shouldReturn` expect
|
||||||
|
@ -116,9 +114,6 @@ readURLSpec = describe "readURL" $ mapM_
|
||||||
longDir = replicate (1024 - BS.length prefix) 'A'
|
longDir = replicate (1024 - BS.length prefix) 'A'
|
||||||
prefix = "gemini://example.com/"
|
prefix = "gemini://example.com/"
|
||||||
|
|
||||||
sendResponseSpec :: Spec
|
|
||||||
sendResponseSpec = describe "sendResponse" $ return ()
|
|
||||||
|
|
||||||
strFromConnSpec :: Spec
|
strFromConnSpec :: Spec
|
||||||
strFromConnSpec = describe "strFromConn" $ mapM_
|
strFromConnSpec = describe "strFromConn" $ mapM_
|
||||||
( \(desc, maxLen, ioConn, expect) -> context desc $
|
( \(desc, maxLen, ioConn, expect) -> context desc $
|
||||||
|
|
Loading…
Reference in New Issue
Block a user