{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Request
( Header
, Headers
, Method (..)
, Request (..)
, Response (..)
, get
, post
, put
, send
) where
import qualified Data.String as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.List as List
import qualified Network.HTTP.Client as LowLevelClient
import qualified Network.HTTP.Client.TLS as LowLevelTLSClient
import qualified Network.HTTP.Types.Status as LowLevelStatus
type = (BS.ByteString, BS.ByteString)
type = [Header]
data Method
= DELETE
| GET
| HEAD
| OPTIONS
| PATCH
| POST
| PUT
| TRACE
| Method String
instance Show Method where
show :: Method -> String
show Method
GET = String
"GET"
show Method
HEAD = String
"HEAD"
show Method
OPTIONS = String
"OPTIONS"
show Method
PATCH = String
"PATCH"
show Method
POST = String
"POST"
show Method
PUT = String
"PUT"
show Method
TRACE = String
"TRACE"
show (Method String
method) = String
method
data (S.IsString a) => Request a = Request
{ Request a -> Method
requestMethod :: Method
, Request a -> String
requestUrl :: String
, :: Headers
, Request a -> Maybe a
requestBody :: Maybe a
} deriving (Int -> Request a -> ShowS
[Request a] -> ShowS
Request a -> String
(Int -> Request a -> ShowS)
-> (Request a -> String)
-> ([Request a] -> ShowS)
-> Show (Request a)
forall a. (IsString a, Show a) => Int -> Request a -> ShowS
forall a. (IsString a, Show a) => [Request a] -> ShowS
forall a. (IsString a, Show a) => Request a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request a] -> ShowS
$cshowList :: forall a. (IsString a, Show a) => [Request a] -> ShowS
show :: Request a -> String
$cshow :: forall a. (IsString a, Show a) => Request a -> String
showsPrec :: Int -> Request a -> ShowS
$cshowsPrec :: forall a. (IsString a, Show a) => Int -> Request a -> ShowS
Show)
toLowlevelRequest :: (S.IsString a) => Request a -> IO LowLevelClient.Request
toLowlevelRequest :: Request a -> IO Request
toLowlevelRequest Request a
req = do
Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
LowLevelClient.parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ Request a -> String
forall a. IsString a => Request a -> String
requestUrl Request a
req
Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ Request
initReq { method :: Method
LowLevelClient.method = String -> Method
C.pack (String -> Method) -> (Method -> String) -> Method -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> String
forall a. Show a => a -> String
show (Method -> Method) -> Method -> Method
forall a b. (a -> b) -> a -> b
$ Request a -> Method
forall a. IsString a => Request a -> Method
requestMethod Request a
req
, requestHeaders :: RequestHeaders
LowLevelClient.requestHeaders = ((Method, Method) -> (CI Method, Method))
-> Headers -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map (\(Method
k, Method
v) -> (Method -> CI Method
forall s. FoldCase s => s -> CI s
CI.mk Method
k, Method
v)) (Headers -> RequestHeaders) -> Headers -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ Request a -> Headers
forall a. IsString a => Request a -> Headers
requestHeaders Request a
req
}
data Response = Response
{ Response -> Int
responseStatus :: Int
, :: Headers
, Response -> Method
responseBody :: BS.ByteString
} deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)
fromLowLevelRequest :: LowLevelClient.Response LBS.ByteString -> Response
fromLowLevelRequest :: Response ByteString -> Response
fromLowLevelRequest Response ByteString
res =
let status :: Int
status = Status -> Int
LowLevelStatus.statusCode (Status -> Int)
-> (Response ByteString -> Status) -> Response ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> Status
forall body. Response body -> Status
LowLevelClient.responseStatus (Response ByteString -> Int) -> Response ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString
res
body :: Method
body = ByteString -> Method
LBS.toStrict (ByteString -> Method) -> ByteString -> Method
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
LowLevelClient.responseBody Response ByteString
res
headers :: RequestHeaders
headers = Response ByteString -> RequestHeaders
forall body. Response body -> RequestHeaders
LowLevelClient.responseHeaders Response ByteString
res
in
Int -> Headers -> Method -> Response
Response Int
status (((CI Method, Method) -> (Method, Method))
-> RequestHeaders -> Headers
forall a b. (a -> b) -> [a] -> [b]
map (\(CI Method
k,Method
v) ->
let hk :: Method
hk = CI Method -> Method
forall s. CI s -> s
CI.original CI Method
k
in
(Method
hk, Method
v)) RequestHeaders
headers) Method
body
getManagerForUrl :: String -> IO LowLevelClient.Manager
getManagerForUrl :: String -> IO Manager
getManagerForUrl String
url =
if String
"https" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
url then ManagerSettings -> IO Manager
LowLevelClient.newManager ManagerSettings
LowLevelTLSClient.tlsManagerSettings
else ManagerSettings -> IO Manager
LowLevelClient.newManager ManagerSettings
LowLevelClient.defaultManagerSettings
send :: (S.IsString a) => Request a -> IO Response
send :: Request a -> IO Response
send Request a
req = do
Manager
manager <- String -> IO Manager
getManagerForUrl (String -> IO Manager) -> String -> IO Manager
forall a b. (a -> b) -> a -> b
$ Request a -> String
forall a. IsString a => Request a -> String
requestUrl Request a
req
Request
llreq <- Request a -> IO Request
forall a. IsString a => Request a -> IO Request
toLowlevelRequest Request a
req
Response ByteString
llres <- Request -> Manager -> IO (Response ByteString)
LowLevelClient.httpLbs Request
llreq Manager
manager
Response -> IO Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Response
fromLowLevelRequest Response ByteString
llres
get :: String -> IO Response
get :: String -> IO Response
get String
url =
Request String -> IO Response
forall a. IsString a => Request a -> IO Response
send (Request String -> IO Response) -> Request String -> IO Response
forall a b. (a -> b) -> a -> b
$ Method -> String -> Headers -> Maybe String -> Request String
forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
GET String
url [] Maybe String
forall a. Maybe a
Nothing
delete :: String -> IO Response
delete :: String -> IO Response
delete String
url =
Request String -> IO Response
forall a. IsString a => Request a -> IO Response
send (Request String -> IO Response) -> Request String -> IO Response
forall a b. (a -> b) -> a -> b
$ Method -> String -> Headers -> Maybe String -> Request String
forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
DELETE String
url [] Maybe String
forall a. Maybe a
Nothing
post :: (String, Maybe BS.ByteString) -> IO Response
post :: (String, Maybe Method) -> IO Response
post (String
url, Maybe Method
body) =
Request Method -> IO Response
forall a. IsString a => Request a -> IO Response
send (Request Method -> IO Response) -> Request Method -> IO Response
forall a b. (a -> b) -> a -> b
$ Method -> String -> Headers -> Maybe Method -> Request Method
forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
POST String
url [] Maybe Method
body
put :: (String, Maybe BS.ByteString) -> IO Response
put :: (String, Maybe Method) -> IO Response
put (String
url, Maybe Method
body) =
Request Method -> IO Response
forall a. IsString a => Request a -> IO Response
send (Request Method -> IO Response) -> Request Method -> IO Response
forall a b. (a -> b) -> a -> b
$ Method -> String -> Headers -> Maybe Method -> Request Method
forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
PUT String
url [] Maybe Method
body