Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Allow optional TLS params

Browse source 
Merge pull request #129 from darrell-roberts/master

for issue #126.
This commit is contained in:
Victor Denisov 2022-03-21 21:08:47 -07:00 committed by GitHub
commit 2ab662b2de
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 14 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
Database/MongoDB/Transport/Tls.hs
View file

@ -22,15 +22,16 @@ barely tested. The current implementation doesn't verify server's identity.
It only allows you to connect to a mongodb server using TLS protocol. It only allows you to connect to a mongodb server using TLS protocol.
-} -}
module Database.MongoDB.Transport.Tls module Database.MongoDB.Transport.Tls
(connect) ( connect
, connectWithTlsParams
)
where where
import Data.IORef import Data.IORef
import Data.Monoid
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy.ByteString import qualified Data.ByteString.Lazy as Lazy.ByteString
import Data.Default.Class (def) import Data.Default.Class (def)
import Control.Applicative ((<$>))
import Control.Exception (bracketOnError) import Control.Exception (bracketOnError)
import Control.Monad (when, unless) import Control.Monad (when, unless)
import System.IO import System.IO
@ -45,15 +46,19 @@ import Database.MongoDB.Query (access, slaveOk, retrieveServerData)
-- | Connect to mongodb using TLS -- | Connect to mongodb using TLS
connect :: HostName -> PortID -> IO Pipe connect :: HostName -> PortID -> IO Pipe
connect host port = bracketOnError (connectTo host port) hClose $ \handle -> do connect host port = connectWithTlsParams params host port
where
let params = (TLS.defaultParamsClient host "") params = (TLS.defaultParamsClient host "")
{ TLS.clientSupported = def { TLS.clientSupported = def
{ TLS.supportedCiphers = TLS.ciphersuite_default} { TLS.supportedCiphers = TLS.ciphersuite_default }
, TLS.clientHooks = def , 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 TLS.handshake context
conn <- tlsConnection context conn <- tlsConnection context