get the client certificate from the connection's context

...instead of the janky thing we were doing before

gemcap.cabal

@@ -39,7 +39,7 @@ library
     , network
     , tcp-streams >=1.0.1.1 && <1.1
     , text >=1.2.4.1 && <1.3
-    , tls
+    , tls >=1.5.8 && <1.6
     , transformers
     , x509
   default-language: Haskell2010
@@ -65,7 +65,7 @@ test-suite gemcap-test
     , network
     , tcp-streams >=1.0.1.1 && <1.1
     , text >=1.2.4.1 && <1.3
-    , tls
+    , tls >=1.5.8 && <1.6
     , transformers
     , x509
   default-language: Haskell2010

package.yaml

@@ -30,7 +30,7 @@ dependencies:
 - text >= 1.2.4.1 && < 1.3
 - io-streams
 - network
-- tls
+- tls >= 1.5.8 && < 1.6
 - transformers
 - x509
 

src/Network/Gemini/Capsule.hs

@@ -34,12 +34,12 @@ import Control.Concurrent (forkIO)
 import Control.Exception (IOException, try)
 import Control.Exception.Base (bracket, finally)
 import Control.Monad (void)
+import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
 import qualified Data.Connection as C
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.TLSSetting (makeServerParams)
-import Data.X509 (Certificate, CertificateChain (..), getSigned, signedObject)
+import Data.X509 (CertificateChain (..), getSigned, signedObject)
 import qualified Network.Socket as S
-import Network.TLS (ServerParams, onClientCertificate, serverHooks)
+import Network.TLS (ServerParams, getClientCertificateChain)
 import System.IO.Streams.TCP (bindAndListen)
 import System.IO.Streams.TLS (accept)
 
@@ -69,32 +69,18 @@ runGemCapsule settings handler = bracket
 
 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
+  try (accept params sock) >>= \case
     Left (_::IOException) -> return ()
     Right conn            -> void $ forkIO $ finally
-      (readIORef certRef >>= runConnection conn handler)
+      ( do
+        let (context, _) = C.connExtraInfo conn
+        mCert <- runMaybeT $
+          MaybeT (getClientCertificateChain context) >>= \case
+            CertificateChain []     -> fail "no certificate"
+            CertificateChain (se:_) -> return $ signedObject $ getSigned se
+        runConnection conn handler mCert
+      )
       (C.close conn)
   listenLoop sock params handler
 
-adjustServerParams
-  :: IORef (Maybe Certificate)
-  -> ServerParams
-  -> ServerParams
-adjustServerParams certRef params = let
-  hooks    = serverHooks params
-  certHook = onClientCertificate hooks
-
-  certHook' chain = do
-    case chain of
-      CertificateChain []     -> return ()
-      CertificateChain (se:_) -> do
-        let cert = signedObject $ getSigned se
-        writeIORef certRef (Just cert)
-    certHook chain
-
-  hooks' = hooks { onClientCertificate = certHook' }
-  in params { serverHooks = hooks' }
-
 --jl