Allow optional TLS params
Merge pull request #129 from darrell-roberts/master for issue #126.
This commit is contained in:
commit
2ab662b2de
1 changed files with 14 additions and 9 deletions
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue