Rustls.hs

-- | Make HTTPS connections using
-- [http-client](https://hackage.haskell.org/package/http-client) and
-- [Rustls](https://github.com/rustls/rustls).
--
-- >>> import qualified Rustls
-- >>> import qualified Network.HTTP.Client as HTTP
-- >>> :{
-- newRustlsManager :: IO HTTP.Manager
-- newRustlsManager = do
--   clientConfig <-
--     Rustls.buildClientConfig $ Rustls.defaultClientConfigBuilder roots
--   HTTP.newManager $ rustlsManagerSettings clientConfig
--   where
--     -- For now, rustls-ffi does not provide a built-in way to access
--     -- the OS certificate store.
--     roots = Rustls.ClientRootsFromFile "/etc/ssl/certs/ca-certificates.crt"
-- >>> :}
--
-- >>> :{
-- example = do
--   mgr <- newRustlsManager -- this should be shared across multiple requests
--   req <- HTTP.parseUrlThrow "https://example.org"
--   res <- HTTP.httpLbs req mgr
--   print $ HTTP.responseBody res
-- :}
module Network.HTTP.Client.Rustls
  ( rustlsManagerSettings,
  )
where

import qualified Control.Exception as E
import Data.Acquire (ReleaseType (..))
import Data.Acquire.Internal (Acquire (..), Allocated (..))
import qualified Data.ByteString.Builder.Extra as B
import qualified Data.Text as T
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.Internal as HTTP
import qualified Network.Socket as NS
import qualified Rustls

-- | Get TLS-enabled HTTP 'HTTP.ManagerSettings' from a Rustls
-- 'Rustls.ClientConfig', consumable via 'HTTP.newManager'.
rustlsManagerSettings :: Rustls.ClientConfig -> HTTP.ManagerSettings
rustlsManagerSettings conf =
  HTTP.defaultManagerSettings
    { HTTP.managerTlsConnection = pure \hostAddress host port ->
        HTTP.withSocket mempty hostAddress host port \sock ->
          makeTlsConnection conf sock host,
      HTTP.managerTlsProxyConnection = pure \connStr checkConn serverName _ host port ->
        HTTP.withSocket mempty Nothing host port \sock -> do
          conn <- HTTP.socketConnection sock B.defaultChunkSize
          HTTP.connectionWrite conn connStr
          checkConn conn
          makeTlsConnection conf sock serverName,
      HTTP.managerWrapException = \req ->
        E.handle @Rustls.RustlsException
          (E.throwIO . HTTP.HttpExceptionRequest req . HTTP.InternalException . E.toException)
          . HTTP.managerWrapException HTTP.defaultManagerSettings req
    }
  where
    makeTlsConnection conf socket hostname = E.mask \restore -> do
      let strippedHost = T.pack $ HTTP.strippedHostName hostname
          Acquire allocate = Rustls.newClientConnection socket conf strippedHost
      Allocated conn freeConn <- allocate restore
      HTTP.makeConnection
        do Rustls.readBS conn (fromIntegral B.defaultChunkSize)
        do Rustls.writeBS conn
        do freeConn ReleaseNormal; NS.close socket