tests for runConnection

This commit is contained in:
Jonathan Lamothe 2021-11-24 18:56:12 -05:00
parent 7126838eb0
commit 05e83857a7
3 changed files with 76 additions and 14 deletions

View File

@ -97,18 +97,4 @@ adjustServerParams certRef params = let
hooks' = hooks { onClientCertificate = certHook' } hooks' = hooks { onClientCertificate = certHook' }
in params { serverHooks = hooks' } 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 --jl

View File

@ -33,6 +33,7 @@ time.
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module Network.Gemini.Capsule.Internal ( module Network.Gemini.Capsule.Internal (
runConnection,
readURL, readURL,
sendResponse, sendResponse,
strFromConn, strFromConn,
@ -49,6 +50,7 @@ import qualified Data.ByteString.Lazy as BSL
import Data.Connection (Connection, source) import Data.Connection (Connection, 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 qualified System.IO.Streams as S import qualified System.IO.Streams as S
import Network.Gemini.Capsule.Encoding import Network.Gemini.Capsule.Encoding
@ -60,6 +62,21 @@ import Network.Gemini.Capsule.Types
inBufSize :: Int inBufSize :: Int
inBufSize = 1026 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' -- | Reads a 'GemURL' from a 'Connection'
readURL readURL
:: Connection a :: Connection a

View File

@ -25,8 +25,11 @@ License along with this program. If not, see
module Network.Gemini.Capsule.InternalSpec (spec) where module Network.Gemini.Capsule.InternalSpec (spec) where
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Char (ord) import Data.Char (ord)
import Data.Connection (Connection (..)) import Data.Connection (Connection (..))
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.X509 (Certificate (..))
import System.IO.Streams (nullInput, unRead) import System.IO.Streams (nullInput, unRead)
import Test.Hspec (Spec, context, describe, it, shouldReturn, xit) import Test.Hspec (Spec, context, describe, it, shouldReturn, xit)
@ -35,12 +38,48 @@ import Network.Gemini.Capsule.Internal
spec :: Spec spec :: Spec
spec = describe "Internal" $ do spec = describe "Internal" $ do
runConnectionSpec
readURLSpec readURLSpec
sendResponseSpec sendResponseSpec
strFromConnSpec strFromConnSpec
readMaxSpec readMaxSpec
stripCRLFSpec 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 :: Spec
readURLSpec = describe "readURL" $ mapM_ readURLSpec = describe "readURL" $ mapM_
( \(desc, ioConn, expect) -> context desc $ ( \(desc, ioConn, expect) -> context desc $
@ -117,6 +156,14 @@ readMaxSpec = describe "readMax" $ mapM_
stripCRLFSpec :: Spec stripCRLFSpec :: Spec
stripCRLFSpec = describe "stripCRLF" $ return () 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 :: [BS.ByteString] -> IO (Connection ())
mkInConn bss = do mkInConn bss = do
source <- nullInput source <- nullInput
@ -127,4 +174,16 @@ mkInConn bss = do
connExtraInfo = () connExtraInfo = ()
return Connection {..} return Connection {..}
sampleCert :: Certificate
sampleCert = Certificate
{ certVersion = undefined
, certSerial = undefined
, certSignatureAlg = undefined
, certIssuerDN = undefined
, certValidity = undefined
, certSubjectDN = undefined
, certPubKey = undefined
, certExtensions = undefined
}
--jl --jl