{-# LANGUAGE RecordWildCards, CPP #-}
module Network.HTTP.Client.Extras (
Url
, HttpResponse(..)
, readHttpResponse
, jsonResponseHeaders
, _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)
import Network.HTTP.Client
( equalCookieJar )
#endif
import Network.HTTP.Types
import Data.Aeson (Value(..), object, (.=))
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (fromString)
#endif
import qualified Data.Text as T (Text, pack)
type Url = Text
data HttpResponse = HttpResponse
{ HttpResponse -> Status
_responseStatus :: Status
, HttpResponse -> HttpVersion
_responseVersion :: HttpVersion
, :: 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
]
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
}
jsonResponseHeaders :: ResponseHeaders -> Value
=
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]
_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 []
}
_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 []
}
_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 []
}
_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 []
}
_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 []
}
_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 []
}