{-# 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 Header = (BS.ByteString, BS.ByteString)

type Headers = [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
  { forall a. IsString a => Request a -> Method
requestMethod  :: Method
  , forall a. IsString a => Request a -> String
requestUrl     :: String
  , forall a. IsString a => Request a -> Headers
requestHeaders :: Headers
  , forall a. IsString a => Request a -> Maybe a
requestBody    :: Maybe a
  } deriving (Int -> Request a -> ShowS
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 :: forall a. IsString a => Request a -> IO Request
toLowlevelRequest Request a
req = do
  Request
initReq <- forall (m :: * -> *). MonadThrow m => String -> m Request
LowLevelClient.parseRequest forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Request a -> String
requestUrl Request a
req
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Request
initReq { method :: ByteString
LowLevelClient.method = String -> ByteString
C.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Request a -> Method
requestMethod Request a
req
                   , requestHeaders :: RequestHeaders
LowLevelClient.requestHeaders = forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
k, ByteString
v) -> (forall s. FoldCase s => s -> CI s
CI.mk ByteString
k, ByteString
v)) forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Request a -> Headers
requestHeaders Request a
req
                   }

data Response = Response
  { Response -> Int
responseStatus  :: Int
  , Response -> Headers
responseHeaders :: Headers
  , Response -> ByteString
responseBody    :: BS.ByteString
  } deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> Status
LowLevelClient.responseStatus forall a b. (a -> b) -> a -> b
$ Response ByteString
res
      body :: ByteString
body = ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
LowLevelClient.responseBody Response ByteString
res
      headers :: RequestHeaders
headers = forall body. Response body -> RequestHeaders
LowLevelClient.responseHeaders Response ByteString
res
  in
  Int -> Headers -> ByteString -> Response
Response Int
status (forall a b. (a -> b) -> [a] -> [b]
map (\(CI ByteString
k,ByteString
v) ->
                         let hk :: ByteString
hk = forall s. CI s -> s
CI.original CI ByteString
k
                         in
                         (ByteString
hk, ByteString
v)) RequestHeaders
headers) ByteString
body

send :: (S.IsString a) => Request a -> IO Response
send :: forall a. IsString a => Request a -> IO Response
send Request a
req = do
  Manager
manager <- IO Manager
LowLevelTLSClient.getGlobalManager
  Request
llreq <- 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
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
  forall a. IsString a => Request a -> IO Response
send forall a b. (a -> b) -> a -> b
$ forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
GET String
url [] forall a. Maybe a
Nothing

delete :: String -> IO Response
delete :: String -> IO Response
delete String
url =
  forall a. IsString a => Request a -> IO Response
send forall a b. (a -> b) -> a -> b
$ forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
DELETE String
url [] forall a. Maybe a
Nothing

post :: (String, Maybe BS.ByteString) -> IO Response
post :: (String, Maybe ByteString) -> IO Response
post (String
url, Maybe ByteString
body) =
  forall a. IsString a => Request a -> IO Response
send forall a b. (a -> b) -> a -> b
$ forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
POST String
url [] Maybe ByteString
body

put :: (String, Maybe BS.ByteString) -> IO Response
put :: (String, Maybe ByteString) -> IO Response
put (String
url, Maybe ByteString
body) =
  forall a. IsString a => Request a -> IO Response
send forall a b. (a -> b) -> a -> b
$ forall a. Method -> String -> Headers -> Maybe a -> Request a
Request Method
PUT String
url [] Maybe ByteString
body