diff --git a/src/Network/Gemini/Capsule.hs b/src/Network/Gemini/Capsule.hs index 94fac5a..8ef2d6c 100644 --- a/src/Network/Gemini/Capsule.hs +++ b/src/Network/Gemini/Capsule.hs @@ -97,18 +97,4 @@ adjustServerParams certRef params = let hooks' = hooks { onClientCertificate = certHook' } in params { serverHooks = hooks' } -runConnection - :: C.Connection a - -> GemHandler - -> Maybe Certificate - -> IO () -runConnection conn handler mCert = - ( readURL conn >>= \case - Nothing -> return $ newGemResponse - { respStatus = 59 - , respMeta = "bad request" - } - Just url -> handler (newGemRequest url) { reqCert = mCert } - ) >>= sendResponse conn - --jl diff --git a/src/Network/Gemini/Capsule/Internal.hs b/src/Network/Gemini/Capsule/Internal.hs index 0bf5902..36f06a1 100644 --- a/src/Network/Gemini/Capsule/Internal.hs +++ b/src/Network/Gemini/Capsule/Internal.hs @@ -33,6 +33,7 @@ time. {-# LANGUAGE LambdaCase #-} module Network.Gemini.Capsule.Internal ( + runConnection, readURL, sendResponse, strFromConn, @@ -49,6 +50,7 @@ import qualified Data.ByteString.Lazy as BSL import Data.Connection (Connection, source) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8') +import Data.X509 (Certificate) import qualified System.IO.Streams as S import Network.Gemini.Capsule.Encoding @@ -60,6 +62,21 @@ import Network.Gemini.Capsule.Types inBufSize :: Int inBufSize = 1026 +-- | process a request and return a response over a 'Connection' +runConnection + :: Connection a + -> GemHandler + -> Maybe Certificate + -> IO () +runConnection conn handler mCert = + ( readURL conn >>= \case + Nothing -> return $ newGemResponse + { respStatus = 59 + , respMeta = "bad request" + } + Just url -> handler (newGemRequest url) { reqCert = mCert } + ) >>= sendResponse conn + -- | Reads a 'GemURL' from a 'Connection' readURL :: Connection a diff --git a/test/Network/Gemini/Capsule/InternalSpec.hs b/test/Network/Gemini/Capsule/InternalSpec.hs index 8746978..6850a7d 100644 --- a/test/Network/Gemini/Capsule/InternalSpec.hs +++ b/test/Network/Gemini/Capsule/InternalSpec.hs @@ -25,8 +25,11 @@ License along with this program. If not, see module Network.Gemini.Capsule.InternalSpec (spec) where import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL import Data.Char (ord) import Data.Connection (Connection (..)) +import Data.IORef (IORef, modifyIORef', newIORef, readIORef) +import Data.X509 (Certificate (..)) import System.IO.Streams (nullInput, unRead) import Test.Hspec (Spec, context, describe, it, shouldReturn, xit) @@ -35,12 +38,48 @@ import Network.Gemini.Capsule.Internal spec :: Spec spec = describe "Internal" $ do + runConnectionSpec readURLSpec sendResponseSpec strFromConnSpec readMaxSpec stripCRLFSpec +runConnectionSpec :: Spec +runConnectionSpec = describe "runConnection" $ mapM_ + ( \(desc, ioConnRef, handler, mCert, expect) -> context desc $ + xit ("should return " ++ show expect) $ do + (conn, outRef) <- ioConnRef + runConnection conn handler mCert + readIORef outRef `shouldReturn` expect + ) + + -- description, connection, handler, certificate, expectation + [ ( "basic connection", basicConn, basicH, Nothing, basicExp ) + , ( "no certificate", basicConn, certH, Nothing, noCertExp ) + , ( "with certificate", basicConn, certH, Just sampleCert, basicExp ) + , ( "gibberish with CR/LF", gibConnCRLF, basicH, Nothing, gibExp ) + , ( "gibberish w/o CR/LF", gibConn, basicH, Nothing, gibExp ) + ] + + where + basicConn = mkIOConn ["gemini://example.com/\r\n"] + gibConnCRLF = mkIOConn ["aosidjgfoeribjeworifj\r\n"] + gibConn = mkIOConn ["sodifjboije"] + basicH _ = return newGemResponse { respBody = Just success } + + certH req = return $ case reqCert req of + Nothing -> newGemResponse + { respStatus = 60 + , respMeta = "certificate required" + } + Just _ -> newGemResponse { respBody = Just success } + + basicExp = ["20 text/gemini\r\nSuccess!\r\n"] + noCertExp = ["60 certificate required\r\n"] + gibExp = ["59 bad request\r\n"] + success = "Success!\r\n" + readURLSpec :: Spec readURLSpec = describe "readURL" $ mapM_ ( \(desc, ioConn, expect) -> context desc $ @@ -117,6 +156,14 @@ readMaxSpec = describe "readMax" $ mapM_ stripCRLFSpec :: Spec stripCRLFSpec = describe "stripCRLF" $ return () +mkIOConn :: [BS.ByteString] -> IO (Connection (), IORef [BSL.ByteString]) +mkIOConn input = do + ref <- newIORef [] + conn <- + ( \c -> c { send = \bs -> modifyIORef' ref (++[bs]) } + ) <$> mkInConn input + return (conn, ref) + mkInConn :: [BS.ByteString] -> IO (Connection ()) mkInConn bss = do source <- nullInput @@ -127,4 +174,16 @@ mkInConn bss = do connExtraInfo = () return Connection {..} +sampleCert :: Certificate +sampleCert = Certificate + { certVersion = undefined + , certSerial = undefined + , certSignatureAlg = undefined + , certIssuerDN = undefined + , certValidity = undefined + , certSubjectDN = undefined + , certPubKey = undefined + , certExtensions = undefined + } + --jl