From 05e83857a7c6364fb1d2c280cfda465582d0ab83 Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jonathan@jlamothe.net>
Date: Wed, 24 Nov 2021 18:56:12 -0500
Subject: [PATCH] tests for runConnection

---
 src/Network/Gemini/Capsule.hs               | 14 -----
 src/Network/Gemini/Capsule/Internal.hs      | 17 ++++++
 test/Network/Gemini/Capsule/InternalSpec.hs | 59 +++++++++++++++++++++
 3 files changed, 76 insertions(+), 14 deletions(-)

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