-- | Issue HTTPS requests using the 'Context' type from the @tls@
-- library.
module Http.Exchange.Tls
( -- * Issue Requests
exchange
-- * Types
, SocketThrowingNetworkException(..)
, NetworkException(..)
, TransportException(..)
-- * Example Use
-- $example
-- * Exceptions
-- $exceptionnotes
, Exception(..)
, HttpException(..)
) where
import Network.TLS (Context)
import Http.Types (Request,Bodied,Response)
import TlsChannel (SocketThrowingNetworkException(..),NetworkException(..))
import TlsChannel (TransportException(..))
import TlsExchange (Exception(..),HttpException(..))
import qualified TlsExchange as X
-- | Issue an HTTP request and await a response. This is does not use TLS
-- (i.e. HTTP, not HTTPS). This function returns exceptions in @Left@ rather
-- than throwing them, so it is not necessary to use @catch@ when calling it.
exchange ::
Context -- ^ TLS Context
-> Bodied Request -- ^ HTTP Request
-> IO (Either Exception (Bodied Response)) -- ^ HTTP Response or exception
exchange = X.exchange
{- $example
Here is an example that illustrates:
* Resolving a domain name
* Establishing a TCP connection
* Sending and HTTP request and receiving a response
This example issues a request to @https://ifconfig.me/ip@.
It uses functions like @connect@ and @openSocket@ that can throw
exceptions of type @IOException@. It uses @handshake@, which can
throw exceptions of type @TLSException@. It also uses @throwIO@ to throw
any HTTP-related failures, but it is possible to handle these cases
more gracefully. This example requires the @OverloadedStrings@ extension
to be enabled. It is available in @app-http-secure/Main.hs@.
> communicateWithServer :: IO ()
> communicateWithServer = do
> let noValidation = Tls.ValidationCache
> (\_ _ _ -> return Tls.ValidationCachePass)
> (\_ _ _ -> return ())
> let clientParams = (Tls.defaultParamsClient "ifconfig.me" mempty)
> { Tls.clientSupported = def
> { Tls.supportedVersions = [Tls.TLS13]
> , Tls.supportedCiphers =
> [ Tls.cipher_TLS13_AES128GCM_SHA256
> , Tls.cipher_TLS13_AES256GCM_SHA384
> , Tls.cipher_TLS13_CHACHA20POLY1305_SHA256
> , Tls.cipher_TLS13_AES128CCM_SHA256
> , Tls.cipher_TLS13_AES128CCM8_SHA256
> ]
> }
> , Tls.clientShared = def
> { Tls.sharedValidationCache = noValidation
> }
> }
> let hints = N.defaultHints { N.addrSocketType = N.Stream }
> minfo <- N.getAddrInfo (Just hints) (Just "ifconfig.me") (Just "443")
> info <- case minfo of
> info : _ -> pure info
> [] -> fail "Impossible: getAddrInfo cannot return empty list"
> bracket (N.openSocket info) N.close $ \sock -> do
> N.connect sock (N.addrAddress info)
> ctx <- Tls.contextNew (SocketThrowingNetworkException sock) clientParams
> Tls.handshake ctx
> result <- exchange ctx Bodied
> { metadata = Request
> { requestLine = RequestLine
> { method = "GET"
> , path = "/ip"
> }
> , headers = Headers.fromList
> [ Header "Host" "ifconfig.me"
> , Header "Accept" "text/plain"
> , Header "User-Agent" "curl/0.0.0"
> ]
> }
> , body = mempty
> }
> case result of
> Left e -> throwIO e
> Right resp -> pPrint resp
Running this results in this being printed:
> Bodied
> { metadata =
> Response
> { statusLine =
> StatusLine { statusCode = 200 , statusReason = "OK" }
> , headers =
> [ Header { name = "access-control-allow-origin" , value = "*" }
> , Header { name = "content-type" , value = "text/plain; charset=utf-8" }
> , Header { name = "content-length" , value = "15" }
> , Header { name = "date" , value = "Tue, 15 Aug 2023 19:57:40 GMT" }
> , Header { name = "x-envoy-upstream-service-time" , value = "2" }
> , Header
> { name = "strict-transport-security"
> , value = "max-age=2592000; includeSubDomains"
> }
> , Header { name = "server" , value = "istio-envoy" }
> , Header { name = "Via" , value = "1.1 google" }
> , Header
> { name = "Alt-Svc"
> , value = "h3=\":443\"; ma=2592000,h3-29=\":443\"; ma=2592000"
> }
> ]
> }
> , body = ...
> }
-}
{- $exceptionnotes
Note: In the documentation generated by Haddock, the @Send@ and @Receive@
data constructors in the @Exception@ type show types from an indefinite
module, but in this instantiation, these types are both aliases
for 'Foreign.C.Error.Errno'.
-}