tests for runConnection
This commit is contained in:
parent
7126838eb0
commit
05e83857a7
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user