{- |
Module      : Network.HTTP.Client.Extras
Description : Some stuff not included in Network.HTTP.Client
Copyright   : 2018, Automattic, Inc.
License     : BSD3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

HTTP helpers
-}

{-# LANGUAGE RecordWildCards, CPP #-}
module Network.HTTP.Client.Extras (
    Url
  , HttpResponse(..)
  , readHttpResponse
  , jsonResponseHeaders

  -- * Responses
  , _200ok
  , _400badRequest
  , _404notFound
  , _405methodNotAllowed
  , _408requestTimeout
  , _500internalServerError
) where



import qualified Data.ByteString as SB
  ( ByteString, unpack )
import Data.ByteString.Lazy
  ( ByteString, unpack )
import Data.Text
  ( Text )
import Data.Vector
  ( fromList )
import Network.HTTP.Client
  ( HttpException(..), CookieJar, HttpExceptionContent(StatusCodeException)
  , Response, responseCookieJar, responseBody, createCookieJar
  , responseHeaders, responseVersion, responseStatus )

#if MIN_VERSION_http_client(0,7,0)
-- http-client 0.7.0 removed the Eq instance for CookieJar in favor
-- of multiple explicit equivalence relations.
import Network.HTTP.Client
  ( equalCookieJar )
#endif

import Network.HTTP.Types
import Data.Aeson (Value(..), object, (.=))

#if MIN_VERSION_aeson(2,0,0)
-- aeson 2.0.0.0 introduced KeyMap over HashMap
import Data.Aeson.Key (fromString)
#endif

import qualified Data.Text as T (Text, pack)


-- | To make type signatures nicer
type Url = Text

-- | Non-opaque HTTP response type.
data HttpResponse = HttpResponse
  { HttpResponse -> Status
_responseStatus :: Status
  , HttpResponse -> HttpVersion
_responseVersion :: HttpVersion
  , HttpResponse -> ResponseHeaders
_responseHeaders :: ResponseHeaders
  , HttpResponse -> ByteString
_responseBody :: ByteString
  , HttpResponse -> CookieJar
_responseCookieJar :: CookieJar
  } deriving (Int -> HttpResponse -> ShowS
[HttpResponse] -> ShowS
HttpResponse -> String
(Int -> HttpResponse -> ShowS)
-> (HttpResponse -> String)
-> ([HttpResponse] -> ShowS)
-> Show HttpResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpResponse] -> ShowS
$cshowList :: [HttpResponse] -> ShowS
show :: HttpResponse -> String
$cshow :: HttpResponse -> String
showsPrec :: Int -> HttpResponse -> ShowS
$cshowsPrec :: Int -> HttpResponse -> ShowS
Show)

instance Eq HttpResponse where
  HttpResponse
r1 == :: HttpResponse -> HttpResponse -> Bool
== HttpResponse
r2 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [ Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
(==)           (HttpResponse -> Status
_responseStatus    HttpResponse
r1) (HttpResponse -> Status
_responseStatus    HttpResponse
r2)
    , HttpVersion -> HttpVersion -> Bool
forall a. Eq a => a -> a -> Bool
(==)           (HttpResponse -> HttpVersion
_responseVersion   HttpResponse
r1) (HttpResponse -> HttpVersion
_responseVersion   HttpResponse
r2)
    , ResponseHeaders -> ResponseHeaders -> Bool
forall a. Eq a => a -> a -> Bool
(==)           (HttpResponse -> ResponseHeaders
_responseHeaders   HttpResponse
r1) (HttpResponse -> ResponseHeaders
_responseHeaders   HttpResponse
r2)
    , ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==)           (HttpResponse -> ByteString
_responseBody      HttpResponse
r1) (HttpResponse -> ByteString
_responseBody      HttpResponse
r2)

#if MIN_VERSION_http_client(0,7,0)
    , CookieJar -> CookieJar -> Bool
equalCookieJar (HttpResponse -> CookieJar
_responseCookieJar HttpResponse
r1) (HttpResponse -> CookieJar
_responseCookieJar HttpResponse
r2)
#else
    , (==)           (_responseCookieJar r1) (_responseCookieJar r2)
#endif

    ]

-- | Convert an opaque `Response ByteString` into an `HttpResponse`.
readHttpResponse :: Response ByteString -> HttpResponse
readHttpResponse :: Response ByteString -> HttpResponse
readHttpResponse Response ByteString
r = HttpResponse :: Status
-> HttpVersion
-> ResponseHeaders
-> ByteString
-> CookieJar
-> HttpResponse
HttpResponse
  { _responseStatus :: Status
_responseStatus = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
r
  , _responseVersion :: HttpVersion
_responseVersion = Response ByteString -> HttpVersion
forall body. Response body -> HttpVersion
responseVersion Response ByteString
r
  , _responseHeaders :: ResponseHeaders
_responseHeaders = Response ByteString -> ResponseHeaders
forall body. Response body -> ResponseHeaders
responseHeaders Response ByteString
r
  , _responseBody :: ByteString
_responseBody = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
r
  , _responseCookieJar :: CookieJar
_responseCookieJar = Response ByteString -> CookieJar
forall body. Response body -> CookieJar
responseCookieJar Response ByteString
r
  }



-- | Convert response headers to a JSON value; specifically a list of objects, one for each header.
jsonResponseHeaders :: ResponseHeaders -> Value
jsonResponseHeaders :: ResponseHeaders -> Value
jsonResponseHeaders =
  Array -> Value
Array (Array -> Value)
-> (ResponseHeaders -> Array) -> ResponseHeaders -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
fromList ([Value] -> Array)
-> (ResponseHeaders -> [Value]) -> ResponseHeaders -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderName, ByteString) -> Value) -> ResponseHeaders -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\(HeaderName
k,ByteString
v) -> [Pair] -> Value
object [ (HeaderName -> Key
key HeaderName
k) Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (ByteString -> Text
val ByteString
v) ])
  where

    key :: HeaderName -> Key
key =
#if MIN_VERSION_aeson(2,0,0)
      String -> Key
fromString (String -> Key) -> (HeaderName -> String) -> HeaderName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc ShowS -> (HeaderName -> String) -> HeaderName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> String
forall a. Show a => a -> String
show
#else
      T.pack . concatMap esc . show
#endif

    val :: ByteString -> Text
val = String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show

    esc :: Char -> String
esc Char
c = case Char
c of
      Char
'\\' -> String
"\\"
      Char
'"'  -> String
"\\\""
      Char
_    -> [Char
c]



-- | Status 200; no headers
_200ok :: ByteString -> HttpResponse
_200ok :: ByteString -> HttpResponse
_200ok ByteString
body = HttpResponse :: Status
-> HttpVersion
-> ResponseHeaders
-> ByteString
-> CookieJar
-> HttpResponse
HttpResponse
  { _responseStatus :: Status
_responseStatus = Status
status200
  , _responseVersion :: HttpVersion
_responseVersion = HttpVersion
http11
  , _responseHeaders :: ResponseHeaders
_responseHeaders = []
  , _responseBody :: ByteString
_responseBody = ByteString
body
  , _responseCookieJar :: CookieJar
_responseCookieJar = [Cookie] -> CookieJar
createCookieJar []
  }

-- | Status 400; no headers
_400badRequest :: ByteString -> HttpResponse
_400badRequest :: ByteString -> HttpResponse
_400badRequest ByteString
body = HttpResponse :: Status
-> HttpVersion
-> ResponseHeaders
-> ByteString
-> CookieJar
-> HttpResponse
HttpResponse
  { _responseStatus :: Status
_responseStatus = Status
status400
  , _responseVersion :: HttpVersion
_responseVersion = HttpVersion
http11
  , _responseHeaders :: ResponseHeaders
_responseHeaders = []
  , _responseBody :: ByteString
_responseBody = ByteString
body
  , _responseCookieJar :: CookieJar
_responseCookieJar = [Cookie] -> CookieJar
createCookieJar []
  }

-- | Status 404; no headers
_404notFound :: ByteString -> HttpResponse
_404notFound :: ByteString -> HttpResponse
_404notFound ByteString
body = HttpResponse :: Status
-> HttpVersion
-> ResponseHeaders
-> ByteString
-> CookieJar
-> HttpResponse
HttpResponse
  { _responseStatus :: Status
_responseStatus = Status
status404
  , _responseVersion :: HttpVersion
_responseVersion = HttpVersion
http11
  , _responseHeaders :: ResponseHeaders
_responseHeaders = []
  , _responseBody :: ByteString
_responseBody = ByteString
body
  , _responseCookieJar :: CookieJar
_responseCookieJar = [Cookie] -> CookieJar
createCookieJar []
  }

-- | Status 405; no headers
_405methodNotAllowed :: ByteString -> HttpResponse
_405methodNotAllowed :: ByteString -> HttpResponse
_405methodNotAllowed ByteString
body = HttpResponse :: Status
-> HttpVersion
-> ResponseHeaders
-> ByteString
-> CookieJar
-> HttpResponse
HttpResponse
  { _responseStatus :: Status
_responseStatus = Status
status405
  , _responseVersion :: HttpVersion
_responseVersion = HttpVersion
http11
  , _responseHeaders :: ResponseHeaders
_responseHeaders = []
  , _responseBody :: ByteString
_responseBody = ByteString
body
  , _responseCookieJar :: CookieJar
_responseCookieJar = [Cookie] -> CookieJar
createCookieJar []
  }

-- | Status 408; no headers
_408requestTimeout :: ByteString -> HttpResponse
_408requestTimeout :: ByteString -> HttpResponse
_408requestTimeout ByteString
body = HttpResponse :: Status
-> HttpVersion
-> ResponseHeaders
-> ByteString
-> CookieJar
-> HttpResponse
HttpResponse
  { _responseStatus :: Status
_responseStatus = Status
status408
  , _responseVersion :: HttpVersion
_responseVersion = HttpVersion
http11
  , _responseHeaders :: ResponseHeaders
_responseHeaders = []
  , _responseBody :: ByteString
_responseBody = ByteString
body
  , _responseCookieJar :: CookieJar
_responseCookieJar = [Cookie] -> CookieJar
createCookieJar []
  }

-- | Status 500; no headers
_500internalServerError :: ByteString -> HttpResponse
_500internalServerError :: ByteString -> HttpResponse
_500internalServerError ByteString
body = HttpResponse :: Status
-> HttpVersion
-> ResponseHeaders
-> ByteString
-> CookieJar
-> HttpResponse
HttpResponse
  { _responseStatus :: Status
_responseStatus = Status
status500
  , _responseVersion :: HttpVersion
_responseVersion = HttpVersion
http11
  , _responseHeaders :: ResponseHeaders
_responseHeaders = []
  , _responseBody :: ByteString
_responseBody = ByteString
body
  , _responseCookieJar :: CookieJar
_responseCookieJar = [Cookie] -> CookieJar
createCookieJar []
  }