implemented runConnection logic

src/Network/GemServ.hs

@@ -42,12 +42,13 @@ module Network.GemServ (
 
 import Control.Concurrent (forkIO)
 import Control.Exception (IOException, try)
-import Control.Exception.Base (bracket)
+import Control.Exception.Base (bracket, finally)
 import Control.Monad (void)
 import qualified Data.ByteString as BS
 import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
 import qualified Data.ByteString.Lazy as BSL
 import Data.Char (chr, ord, toLower)
+import qualified Data.Connection as C
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.List (find, intercalate)
 import Data.Maybe (fromJust)
@@ -55,10 +56,10 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8')
 import Data.TLSSetting (makeServerParams)
 import Data.X509 (Certificate, CertificateChain (..), getSigned, signedObject)
-import Network.Socket (Socket, close)
+import qualified Network.Socket as S
 import Network.TLS (ServerParams, onClientCertificate, serverHooks)
 import System.IO.Streams.TCP (bindAndListen)
-import System.IO.Streams.TLS (accept)
+import System.IO.Streams.TLS (TLSConnection, accept)
 
 import Network.GemServ.Internal
 import Network.GemServ.Types
@@ -75,7 +76,7 @@ runGemServer settings handler = bracket
     (servConnections settings)
     (fromIntegral $ servPort settings)
   )
-  close
+  S.close
   ( \sock -> do
     params <- makeServerParams
       (servCert settings)
@@ -177,14 +178,15 @@ unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
     toNum ch = fst $ fromJust $
       find (\x -> snd x == ch) $ zip [0..] hexDigits
 
-listenLoop :: Socket -> ServerParams -> GemHandler -> IO a
+listenLoop :: S.Socket -> ServerParams -> GemHandler -> IO a
 listenLoop sock params handler = do
   certRef <- newIORef Nothing
   let params' = adjustServerParams certRef params
   try (accept params' sock) >>= \case
     Left (_ :: IOException) -> return ()
-    Right conn              -> void $ forkIO $
-      readIORef certRef >>= runConnection conn handler
+    Right conn              -> void $ forkIO $ finally
+      (readIORef certRef >>= runConnection conn handler)
+      (C.close conn)
   listenLoop sock params handler
 
 adjustServerParams
@@ -205,6 +207,20 @@ adjustServerParams certRef params = let
   hooks' = hooks { onClientCertificate = certHook' }
   in params { serverHooks = hooks' }
 
+runConnection
+  :: TLSConnection
+  -> 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
+
 hexDigits :: String
 hexDigits = ['0'..'9'] ++ ['a'..'f']
 

src/Network/GemServ/Internal.hs

@@ -31,24 +31,28 @@ time.
 -}
 
 module Network.GemServ.Internal (
-  runConnection
+  readURL,
+  sendResponse
 ) where
 
-import Data.X509 (Certificate)
-import System.IO.Streams.TLS (TLSConnection)
+import Data.Connection (Connection)
 
 import Network.GemServ.Types
 
--- | takes a Gemini request from a 'TLSConnection' and replies with
--- the response
-runConnection
-  :: TLSConnection
-  -- ^ The connection
-  -> GemHandler
-  -- ^ The handler that produces the response
-  -> Maybe Certificate
-  -- ^ The client certificate (if available)
+-- | Reads a 'GemURL' from a 'Connection'
+readURL
+  :: Connection a
+  -- ^ the connection
+  -> IO (Maybe GemURL)
+readURL = undefined
+
+-- | Sends a 'GemResponse' to a 'Connection'
+sendResponse
+  :: Connection a
+  -- ^ the connection
+  -> GemResponse
+  -- ^ the response being sent
   -> IO ()
-runConnection = undefined
+sendResponse = undefined
 
 --jl