{-# LANGUAGE ScopedTypeVariables #-}
module Network.HTTP.Client.OpenSSL
( opensslManagerSettings
, withOpenSSL
) where
import Network.HTTP.Client
import Network.HTTP.Client.Internal
import Control.Exception
import Network.Socket.ByteString (sendAll, recv)
import OpenSSL
import qualified Data.ByteString as S
import qualified Network.Socket as N
import qualified OpenSSL.Session as SSL
opensslManagerSettings :: IO SSL.SSLContext -> ManagerSettings
opensslManagerSettings mkContext = defaultManagerSettings
{ managerTlsConnection = do
ctx <- mkContext
return $ \_ha host' port' -> do
let hints = N.defaultHints
{ N.addrFlags = [N.AI_ADDRCONFIG, N.AI_NUMERICSERV]
, N.addrFamily = N.AF_INET
, N.addrSocketType = N.Stream
}
(addrInfo:_) <- N.getAddrInfo (Just hints) (Just host') (Just $ show port')
let family = N.addrFamily addrInfo
let socketType = N.addrSocketType addrInfo
let protocol = N.addrProtocol addrInfo
let address = N.addrAddress addrInfo
bracketOnError (N.socket family socketType protocol) (N.close)
$ \sock -> do
N.connect sock address
ssl <- SSL.connection ctx sock
SSL.setTlsextHostName ssl host'
SSL.connect ssl
makeConnection
(SSL.read ssl 32752 `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> pure S.empty)
(SSL.write ssl)
(N.close sock)
, managerTlsProxyConnection = do
ctx <- mkContext
return $ \connstr checkConn _serverName _ha host' port' -> do
let hints = N.defaultHints
{ N.addrFlags = [N.AI_ADDRCONFIG, N.AI_NUMERICSERV]
, N.addrFamily = N.AF_INET
, N.addrSocketType = N.Stream
}
(addrInfo:_) <- N.getAddrInfo (Just hints) (Just host') (Just $ show port')
let family = N.addrFamily addrInfo
let socketType = N.addrSocketType addrInfo
let protocol = N.addrProtocol addrInfo
let address = N.addrAddress addrInfo
bracketOnError (N.socket family socketType protocol) (N.close)
$ \sock -> do
N.connect sock address
conn <- makeConnection
(recv sock 32752)
(sendAll sock)
(return ())
connectionWrite conn connstr
checkConn conn
ssl <- SSL.connection ctx sock
SSL.setTlsextHostName ssl host'
SSL.connect ssl
makeConnection
(SSL.read ssl 32752 `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> pure S.empty)
(SSL.write ssl)
(N.close sock)
, managerRetryableException = \se ->
case () of
()
| Just (_ :: SSL.ConnectionAbruptlyTerminated) <- fromException se -> True
| otherwise -> managerRetryableException defaultManagerSettings se
, managerWrapException = \req ->
let
wrap se
| Just (_ :: IOException) <- fromException se = se'
| Just (_ :: SSL.SomeSSLException) <- fromException se = se'
| Just (_ :: SSL.ConnectionAbruptlyTerminated) <- fromException se = se'
| Just (_ :: SSL.ProtocolError) <- fromException se = se'
| otherwise = se
where
se' = toException (HttpExceptionRequest req (InternalException se))
in
handle (throwIO . wrap)
}