diff --git a/src/Network/Gemini/Capsule/Encoding.hs b/src/Network/Gemini/Capsule/Encoding.hs index 8d40d03..2027916 100644 --- a/src/Network/Gemini/Capsule/Encoding.hs +++ b/src/Network/Gemini/Capsule/Encoding.hs @@ -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'] diff --git a/src/Network/Gemini/Capsule/Internal.hs b/src/Network/Gemini/Capsule/Internal.hs index a69820a..7b8b9c6 100644 --- a/src/Network/Gemini/Capsule/Internal.hs +++ b/src/Network/Gemini/Capsule/Internal.hs @@ -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 diff --git a/test/Network/Gemini/Capsule/EncodingSpec.hs b/test/Network/Gemini/Capsule/EncodingSpec.hs index 02f816d..d5ece5d 100644 --- a/test/Network/Gemini/Capsule/EncodingSpec.hs +++ b/test/Network/Gemini/Capsule/EncodingSpec.hs @@ -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 diff --git a/test/Network/Gemini/Capsule/InternalSpec.hs b/test/Network/Gemini/Capsule/InternalSpec.hs index 54de843..9a83234 100644 --- a/test/Network/Gemini/Capsule/InternalSpec.hs +++ b/test/Network/Gemini/Capsule/InternalSpec.hs @@ -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 $