From 408cc267f5a2e269ce0413840844f5ec6c972cbf Mon Sep 17 00:00:00 2001
From: Darrell Roberts <droberts@paymentus.com>
Date: Mon, 7 Mar 2022 08:50:11 -0500
Subject: [PATCH 1/2] for issue #126. Allow optional TLS params

---
 Database/MongoDB/Transport/Tls.hs | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

diff --git a/Database/MongoDB/Transport/Tls.hs b/Database/MongoDB/Transport/Tls.hs
index 6915d1f..338b738 100644
--- a/Database/MongoDB/Transport/Tls.hs
+++ b/Database/MongoDB/Transport/Tls.hs
@@ -22,11 +22,14 @@ barely tested. The current implementation doesn't verify server's identity.
 It only allows you to connect to a mongodb server using TLS protocol.
 -}
 module Database.MongoDB.Transport.Tls
-(connect)
+( connect
+, connectWithTlsParams
+)
 where
 
 import Data.IORef
 import Data.Monoid
+import Data.Maybe(fromMaybe)
 import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Lazy as Lazy.ByteString
 import Data.Default.Class (def)
@@ -45,15 +48,19 @@ import Database.MongoDB.Query (access, slaveOk, retrieveServerData)
 
 -- | Connect to mongodb using TLS
 connect :: HostName -> PortID -> IO Pipe
-connect host port = bracketOnError (connectTo host port) hClose $ \handle -> do
-
-  let params = (TLS.defaultParamsClient host "")
+connect host port = connectWithTlsParams params host port
+  where
+    params = (TLS.defaultParamsClient host "")
         { TLS.clientSupported = def
-            { TLS.supportedCiphers = TLS.ciphersuite_default}
+            { TLS.supportedCiphers = TLS.ciphersuite_default }
         , TLS.clientHooks = def
-            { TLS.onServerCertificate = \_ _ _ _ -> return []}
+            { TLS.onServerCertificate = \_ _ _ _ -> return [] }
         }
-  context <- TLS.contextNew handle params
+
+-- | Connect to mongodb using TLS using provided TLS client parameters
+connectWithTlsParams :: TLS.ClientParams -> HostName -> PortID -> IO Pipe
+connectWithTlsParams clientParams host port = bracketOnError (connectTo host port) hClose $ \handle -> do
+  context <- TLS.contextNew handle clientParams
   TLS.handshake context
 
   conn <- tlsConnection context
@@ -62,6 +69,7 @@ connect host port = bracketOnError (connectTo host port) hClose $ \handle -> do
     sd <- access p slaveOk "admin" retrieveServerData
   return p
 
+
 tlsConnection :: TLS.Context -> IO Transport
 tlsConnection ctx = do
   restRef <- newIORef mempty

From e3ce8698c73d052e7e04eb3291a1408c5162a780 Mon Sep 17 00:00:00 2001
From: Darrell Roberts <droberts@paymentus.com>
Date: Thu, 10 Mar 2022 08:33:16 -0500
Subject: [PATCH 2/2] for issue #126. Allow optional TLS params

---
 Database/MongoDB/Transport/Tls.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/Database/MongoDB/Transport/Tls.hs b/Database/MongoDB/Transport/Tls.hs
index 338b738..a02a318 100644
--- a/Database/MongoDB/Transport/Tls.hs
+++ b/Database/MongoDB/Transport/Tls.hs
@@ -28,12 +28,10 @@ module Database.MongoDB.Transport.Tls
 where
 
 import Data.IORef
-import Data.Monoid
-import Data.Maybe(fromMaybe)
+
 import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Lazy as Lazy.ByteString
 import Data.Default.Class (def)
-import Control.Applicative ((<$>))
 import Control.Exception (bracketOnError)
 import Control.Monad (when, unless)
 import System.IO
@@ -69,7 +67,6 @@ connectWithTlsParams clientParams host port = bracketOnError (connectTo host por
     sd <- access p slaveOk "admin" retrieveServerData
   return p
 
-
 tlsConnection :: TLS.Context -> IO Transport
 tlsConnection ctx = do
   restRef <- newIORef mempty