{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} module Http.Internal where import qualified Control.Exception.Safe as Exception import qualified Data.Aeson as Aeson import qualified Data.ByteString import qualified Data.ByteString.Lazy import qualified Data.Dynamic as Dynamic import Dict (Dict) import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Types.Header as Header import qualified Network.Mime as Mime import qualified Platform import Prelude (IO) -- | A handler for making HTTP requests. data Handler = Handler { handlerRequest :: forall e expect. (Dynamic.Typeable expect, Dynamic.Typeable e) => Request' e expect -> Task e expect, handlerWithThirdParty :: forall e a. (HTTP.Manager -> Task e a) -> Task e a, handlerWithThirdPartyIO :: forall a. Platform.LogHandler -> (HTTP.Manager -> IO a) -> IO a } -- | A simple request with the built-in 'Error' type. type Request a = Request' Error a -- | A custom request. data Request' x a = Request { -- | The request method, like @"GET"@ or @"PUT"@. method :: Text, -- | A list of request headers. headers :: [Header], -- | The url, like @\"https://fishes.com/salmon\"@. url :: Text, -- | The request body. body :: Body, -- | The amount of microseconds you're willing to wait before giving up. timeout :: Maybe Int, -- | The type of response you expect back from the request. expect :: Expect' x a } -- | An HTTP header for configuration requests. newtype Header = Header {unHeader :: Header.Header} deriving (Eq, Show) -- | Represents the body of a Request. data Body = Body { bodyContents :: Data.ByteString.Lazy.ByteString, bodyContentType :: Maybe Mime.MimeType } -- | A simple logic for interpreting a response body with the built-in 'Error' type. type Expect a = Expect' Error a -- | Logic for interpreting a response body. data Expect' x a where ExpectJson :: Aeson.FromJSON a => Expect a ExpectText :: Expect Text ExpectWhatever :: Expect () ExpectTextResponse :: (Response Text -> Result x a) -> Expect' x a ExpectBytesResponse :: (Response Data.ByteString.ByteString -> Result x a) -> Expect' x a -- | A 'Request' can fail in a couple of ways: -- -- - 'BadUrl' means you did not provide a valid URL. -- - 'Timeout' means it took too long to get a response. -- - 'NetworkError' means the user turned off their wifi, went in a cave, etc. -- - 'BadStatus' means you got a response back, but the status code indicates failure. -- - 'BadBody' means you got a response back with a nice status code, but the body of the response was something unexpected. The 'Text' in this cse is the debugging message that explains what went wrong with your JSONT decoder or whatever. data Error = BadUrl Text | Timeout | NetworkError Text | BadStatus Int | BadBody Text deriving (Generic, Eq, Show) instance Exception.Exception Error instance Aeson.ToJSON Error -- | A 'Response' can come back a couple different ways: -- -- - 'BadUrl_' — you did not provide a valid URL. -- - 'Timeout_' — it took too long to get a response. -- - 'NetworkError_' — the user turned off their wifi, went in a cave, etc. -- - 'BadStatus_' — a response arrived, but the status code indicates failure. -- - 'GoodStatus_' — a response arrived with a nice status code! -- - The type of the body depends on whether you use expectStringResponse or expectBytesResponse. data Response body = BadUrl_ Text | Timeout_ | NetworkError_ Text | BadStatus_ Metadata body | GoodStatus_ Metadata body deriving (Generic, Eq, Show) instance (Dynamic.Typeable body, Show body) => Exception.Exception (Response body) instance (Aeson.ToJSON body) => Aeson.ToJSON (Response body) -- Extra information about the response: -- -- Note: It is possible for a response to have the same header multiple times. In that case, all the values end up in a single entry in the headers dictionary. The values are separated by commas, following the rules outlined [here](https://stackoverflow.com/questions/4371328/are-duplicate-http-response-headers-acceptable). data Metadata = Metadata { -- statusCode like 200 or 404 metadataStatusCode :: Int, -- statusText describing what the statusCode means a little metadataStatusText :: Text, -- headers like Content-Length and Expires metadataHeaders :: Dict Text Text } deriving (Generic, Eq, Show) instance Aeson.ToJSON Metadata