{-# Language OverloadedStrings, LambdaCase
, ExistentialQuantification #-}
module Network.HTTP.ClientExtra
(
QueryE (..)
, ToQueryE (..)
, RequestHeadersE (..)
, HH.RequestHeaders
, methodBSL
, methodJSON
, fromQueryE
, fromQueryE'
, EResp
, Method
) where
import Network.HTTP.Client
import Network.HTTP.ClientExtra.Multipart()
import Network.HTTP.ClientExtra.Types
import Network.HTTP.Types.Method (Method(..))
import qualified Network.HTTP.Types.Header as HH
import qualified Network.HTTP.Types.Status as HS
import qualified Data.Aeson as DA
import Control.Applicative ((<$>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Catch (MonadThrow (..))
import Data.Monoid
import Data.Either
import Prelude
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSL8
type EResp k = Either (BSL.ByteString, CookieJar, HH.ResponseHeaders, Int) (k, CookieJar, HH.ResponseHeaders, Int)
methodBSL :: (MonadIO m, ContentEncoder m b, MonadThrow m) => Manager -> Method -> Maybe CookieJar -> String -> QueryE -> RequestHeadersE -> b -> m (EResp BSL.ByteString)
methodBSL manager m j url extraQuery extraHeaders reqBody = do
initReq <- parseUrlThrow url
(bb,eh) <- buildBody reqBody
let req = initReq
{ method = m
, requestHeaders = unRequestHeaders $ eh <> extraHeaders
, queryString = fromQueryE . (<> extraQuery) . toQueryE . queryString $ initReq
, requestBody = bb
, cookieJar=j
}
liftIO $ withResponse req manager $ \rb' -> do
let cj = responseCookieJar rb'
rh = responseHeaders rb'
rb <- BSL.fromChunks <$> brConsume (responseBody rb')
return $ case HS.statusCode (responseStatus rb') of
200 -> Right (rb, cj, rh, 200)
201 -> Right (rb, cj, rh, 201)
202 -> Right (rb, cj, rh, 202)
s -> Left (rb, cj, rh, s )
methodJSON :: (MonadIO m, ContentEncoder m b, MonadThrow m, Functor m, DA.FromJSON a) => Manager -> Method -> Maybe CookieJar -> String -> QueryE -> RequestHeadersE -> b -> m (EResp a)
methodJSON a b c d e f g = methodBSL a b c d e f g >>= return . \case
Left err -> Left err
Right r@(a1,b1,c1,d1) -> case DA.eitherDecode a1 of
Left _err -> Left r
Right v1 -> Right (v1,b1,c1,d1)