{-# LANGUAGE CPP, GADTs, OverloadedStrings #-}

module Network.Wreq.Internal
    (
      defaults
    , defaultManagerSettings
    , emptyMethodWith
    , foldResponseBody
    , ignoreResponse
    , readResponse
    , request
    , prepareGet
    , preparePost
    , runRead
    , runReadHistory
    , prepareHead
    , runIgnore
    , prepareOptions
    , preparePut
    , preparePatch
    , prepareDelete
    , prepareMethod
    , preparePayloadMethod
    ) where

import Control.Applicative ((<$>))
import Control.Arrow ((***))
import Control.Lens ((&), (.~), (%~))
import Control.Monad ((>=>))
import Data.Monoid ((<>))
import Data.Text.Encoding (encodeUtf8)
import Data.Version (showVersion)
import Network.HTTP.Client (BodyReader, HistoriedResponse(..))
import Network.HTTP.Client.Internal (Proxy(..), Request, Response(..), addProxy)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.Wreq.Internal.Lens (setHeader)
import Network.Wreq.Internal.Types (Mgr, Req(..), Run, RunHistory)
import Network.Wreq.Types (Auth(..), Options(..), Postable(..), Patchable(..), Putable(..))
import Prelude hiding (head)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as L
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wreq.Internal.Lens as Lens
import qualified Network.Wreq.Internal.AWS as AWS (signRequest,signRequestFull)
import qualified Network.Wreq.Internal.OAuth1 as OAuth1 (signRequest)
import qualified Network.Wreq.Lens as Lens hiding (checkResponse)

-- This mess allows this module to continue to load during interactive
-- development in ghci :-(
#if defined(VERSION_base)
import Paths_wreq (version)
#else
import Data.Version (Version(..))
version :: Version
version = Version [0] ["wip"]
#endif

defaultManagerSettings :: HTTP.ManagerSettings
defaultManagerSettings :: ManagerSettings
defaultManagerSettings = ManagerSettings
tlsManagerSettings

defaults :: Options
defaults :: Options
defaults = Options {
    manager :: Mgr
manager     = forall a b. a -> Either a b
Left ManagerSettings
defaultManagerSettings
  , proxy :: Maybe Proxy
proxy       = forall a. Maybe a
Nothing
  , auth :: Maybe Auth
auth        = forall a. Maybe a
Nothing
  , headers :: [Header]
headers     = [(HeaderName
"User-Agent", ByteString
userAgent)]
  , params :: [(Text, Text)]
params      = []
  , redirects :: Int
redirects   = Int
10
  , cookies :: Maybe CookieJar
cookies     = forall a. a -> Maybe a
Just ([Cookie] -> CookieJar
HTTP.createCookieJar [])
  , checkResponse :: Maybe ResponseChecker
checkResponse = forall a. Maybe a
Nothing
  }
  where userAgent :: ByteString
userAgent = ByteString
"haskell wreq-" forall a. Semigroup a => a -> a -> a
<> String -> ByteString
Char8.pack (Version -> String
showVersion Version
version)

setRedirects :: Options -> Request -> Request
setRedirects :: Options -> Request -> Request
setRedirects Options
opts Request
req
  | Options -> Int
redirects Options
opts forall a. Eq a => a -> a -> Bool
== Request -> Int
HTTP.redirectCount Request
req = Request
req
  | Bool
otherwise = Request
req { redirectCount :: Int
HTTP.redirectCount = Options -> Int
redirects Options
opts }

emptyMethodWith :: HTTP.Method -> Options -> String -> IO (Response ())
emptyMethodWith :: ByteString -> Options -> String -> IO (Response ())
emptyMethodWith ByteString
method Options
opts String
url =
  forall a.
(Request -> IO Request)
-> Options -> String -> (Response BodyReader -> IO a) -> IO a
request (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' Request ByteString
Lens.method forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
method)) Options
opts String
url Response BodyReader -> IO (Response ())
ignoreResponse

ignoreResponse :: Response BodyReader -> IO (Response ())
ignoreResponse :: Response BodyReader -> IO (Response ())
ignoreResponse Response BodyReader
resp = (forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Lens.responseBody forall s t a b. ASetter s t a b -> b -> s -> t
.~ ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response BodyReader -> IO (Response ByteString)
readResponse Response BodyReader
resp

readResponse :: Response BodyReader -> IO (Response L.ByteString)
readResponse :: Response BodyReader -> IO (Response ByteString)
readResponse Response BodyReader
resp = do
  [ByteString]
chunks <- BodyReader -> IO [ByteString]
HTTP.brConsume (forall body. Response body -> body
HTTP.responseBody Response BodyReader
resp)
  forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
resp { responseBody :: ByteString
responseBody = [ByteString] -> ByteString
L.fromChunks [ByteString]
chunks }

readHistoriedResponse :: HistoriedResponse BodyReader -> IO (HistoriedResponse L.ByteString)
readHistoriedResponse :: HistoriedResponse BodyReader -> IO (HistoriedResponse ByteString)
readHistoriedResponse HistoriedResponse BodyReader
resp = do
  let finalResp :: Response BodyReader
finalResp = forall body. HistoriedResponse body -> Response body
hrFinalResponse HistoriedResponse BodyReader
resp
  [ByteString]
chunks <- BodyReader -> IO [ByteString]
HTTP.brConsume (forall body. Response body -> body
HTTP.responseBody Response BodyReader
finalResp)
  forall (m :: * -> *) a. Monad m => a -> m a
return HistoriedResponse BodyReader
resp { hrFinalResponse :: Response ByteString
hrFinalResponse = Response BodyReader
finalResp { responseBody :: ByteString
responseBody = [ByteString] -> ByteString
L.fromChunks [ByteString]
chunks } }

foldResponseBody :: (a -> S.ByteString -> IO a) -> a
                 -> Response BodyReader -> IO a
foldResponseBody :: forall a.
(a -> ByteString -> IO a) -> a -> Response BodyReader -> IO a
foldResponseBody a -> ByteString -> IO a
f a
z0 Response BodyReader
resp = a -> IO a
go a
z0
  where go :: a -> IO a
go a
z = do
          ByteString
bs <- BodyReader -> BodyReader
HTTP.brRead (forall body. Response body -> body
HTTP.responseBody Response BodyReader
resp)
          if ByteString -> Bool
S.null ByteString
bs
            then forall (m :: * -> *) a. Monad m => a -> m a
return a
z
            else a -> ByteString -> IO a
f a
z ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
go

request :: (Request -> IO Request) -> Options -> String
        -> (Response BodyReader -> IO a) -> IO a
request :: forall a.
(Request -> IO Request)
-> Options -> String -> (Response BodyReader -> IO a) -> IO a
request Request -> IO Request
modify Options
opts String
url Response BodyReader -> IO a
act = forall a. Mgr -> (Response BodyReader -> IO a) -> Request -> IO a
run (Options -> Mgr
manager Options
opts) Response BodyReader -> IO a
act forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Request -> IO Request) -> Options -> String -> IO Request
prepare Request -> IO Request
modify Options
opts String
url

run :: Mgr -> (Response BodyReader -> IO a) -> Request -> IO a
run :: forall a. Mgr -> (Response BodyReader -> IO a) -> Request -> IO a
run Mgr
emgr Response BodyReader -> IO a
act Request
req = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ManagerSettings -> IO Manager
HTTP.newManager forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Manager -> IO a
go) Manager -> IO a
go Mgr
emgr
  where go :: Manager -> IO a
go Manager
mgr = forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
HTTP.withResponse Request
req Manager
mgr Response BodyReader -> IO a
act

runHistory :: Mgr -> (HistoriedResponse BodyReader -> IO a) -> Request -> IO a
runHistory :: forall a.
Mgr -> (HistoriedResponse BodyReader -> IO a) -> Request -> IO a
runHistory Mgr
emgr HistoriedResponse BodyReader -> IO a
act Request
req = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ManagerSettings -> IO Manager
HTTP.newManager forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Manager -> IO a
go) Manager -> IO a
go Mgr
emgr
  where go :: Manager -> IO a
go Manager
mgr = forall a.
Request
-> Manager -> (HistoriedResponse BodyReader -> IO a) -> IO a
HTTP.withResponseHistory Request
req Manager
mgr HistoriedResponse BodyReader -> IO a
act

prepare :: (Request -> IO Request) -> Options -> String -> IO Request
prepare :: (Request -> IO Request) -> Options -> String -> IO Request
prepare Request -> IO Request
modify Options
opts String
url = do
  Request -> IO Request
signRequest forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Request -> IO Request
modify forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Request -> Request
frob forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseUrlThrow String
url
  where
    frob :: Request -> Request
frob Request
req = Request
req forall a b. a -> (a -> b) -> b
& Lens' Request [Header]
Lens.requestHeaders forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Options -> [Header]
headers Options
opts forall a. [a] -> [a] -> [a]
++)
                   forall a b. a -> (a -> b) -> b
& Options -> Request -> Request
setQuery Options
opts
                   forall a b. a -> (a -> b) -> b
& Options -> Request -> Request
setAuth Options
opts
                   forall a b. a -> (a -> b) -> b
& Options -> Request -> Request
setProxy Options
opts
                   forall a b. a -> (a -> b) -> b
& Options -> Request -> Request
setCheckResponse Options
opts
                   forall a b. a -> (a -> b) -> b
& Options -> Request -> Request
setRedirects Options
opts
                   forall a b. a -> (a -> b) -> b
& Lens' Request (Maybe CookieJar)
Lens.cookieJar forall s t a b. ASetter s t a b -> b -> s -> t
.~ Options -> Maybe CookieJar
cookies Options
opts
    signRequest :: Request -> IO Request
    signRequest :: Request -> IO Request
signRequest = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. Monad m => a -> m a
return Auth -> Request -> IO Request
f forall a b. (a -> b) -> a -> b
$ Options -> Maybe Auth
auth Options
opts
      where
        f :: Auth -> Request -> IO Request
f (AWSAuth AWSAuthVersion
versn ByteString
key ByteString
secret Maybe ByteString
_) = AWSAuthVersion -> ByteString -> ByteString -> Request -> IO Request
AWS.signRequest AWSAuthVersion
versn ByteString
key ByteString
secret
        f (AWSFullAuth AWSAuthVersion
versn ByteString
key ByteString
secret Maybe ByteString
_ Maybe (ByteString, ByteString)
serviceRegion) = AWSAuthVersion
-> ByteString
-> ByteString
-> Maybe (ByteString, ByteString)
-> Request
-> IO Request
AWS.signRequestFull AWSAuthVersion
versn ByteString
key ByteString
secret Maybe (ByteString, ByteString)
serviceRegion
        f (OAuth1 ByteString
consumerToken ByteString
consumerSecret ByteString
token ByteString
secret) = ByteString
-> ByteString -> ByteString -> ByteString -> Request -> IO Request
OAuth1.signRequest ByteString
consumerToken ByteString
consumerSecret ByteString
token ByteString
secret
        f Auth
_ = forall (m :: * -> *) a. Monad m => a -> m a
return


setQuery :: Options -> Request -> Request
setQuery :: Options -> Request -> Request
setQuery Options
opts =
  case Options -> [(Text, Text)]
params Options
opts of
    [] -> forall a. a -> a
id
    [(Text, Text)]
ps -> Lens' Request ByteString
Lens.queryString forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \ByteString
qs ->
          let n :: Int
n = ByteString -> Int
S.length ByteString
qs in
          ByteString
qs forall a. Semigroup a => a -> a -> a
<> (if Int
n forall a. Ord a => a -> a -> Bool
> Int
1 then ByteString
"&" else ByteString
"") forall a. Semigroup a => a -> a -> a
<> Bool -> SimpleQuery -> ByteString
HTTP.renderSimpleQuery (Int
nforall a. Eq a => a -> a -> Bool
==Int
0)
          (forall a b. (a -> b) -> [a] -> [b]
map (Text -> ByteString
encodeUtf8 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> ByteString
encodeUtf8) [(Text, Text)]
ps)

setAuth :: Options -> Request -> Request
setAuth :: Options -> Request -> Request
setAuth = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Auth -> Request -> Request
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Maybe Auth
auth
  where
    f :: Auth -> Request -> Request
f (BasicAuth ByteString
user ByteString
pass) = ByteString -> ByteString -> Request -> Request
HTTP.applyBasicAuth ByteString
user ByteString
pass
    f (OAuth2Bearer ByteString
token)  = HeaderName -> ByteString -> Request -> Request
setHeader HeaderName
"Authorization" (ByteString
"Bearer " forall a. Semigroup a => a -> a -> a
<> ByteString
token)
    f (OAuth2Token ByteString
token)   = HeaderName -> ByteString -> Request -> Request
setHeader HeaderName
"Authorization" (ByteString
"token " forall a. Semigroup a => a -> a -> a
<> ByteString
token)
    -- for AWS request signature implementation, see Internal/AWS
    f (AWSAuth AWSAuthVersion
_ ByteString
_ ByteString
_ Maybe ByteString
mSessionToken) =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (HeaderName -> ByteString -> Request -> Request
setHeader HeaderName
"X-Amz-Security-Token") Maybe ByteString
mSessionToken
    f (AWSFullAuth AWSAuthVersion
_ ByteString
_ ByteString
_ Maybe ByteString
mSessionToken Maybe (ByteString, ByteString)
_) =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (HeaderName -> ByteString -> Request -> Request
setHeader HeaderName
"X-Amz-Security-Token") Maybe ByteString
mSessionToken
    f (OAuth1 ByteString
_ ByteString
_ ByteString
_ ByteString
_)      = forall a. a -> a
id

setProxy :: Options -> Request -> Request
setProxy :: Options -> Request -> Request
setProxy = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Proxy -> Request -> Request
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Maybe Proxy
proxy
  where f :: Proxy -> Request -> Request
f (Proxy ByteString
host Int
port) = ByteString -> Int -> Request -> Request
addProxy ByteString
host Int
port

setCheckResponse :: Options -> Request -> Request
setCheckResponse :: Options -> Request -> Request
setCheckResponse = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ResponseChecker -> Request -> Request
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Maybe ResponseChecker
checkResponse
  where f :: ResponseChecker -> Request -> Request
f ResponseChecker
cs = ( forall a b. a -> (a -> b) -> b
& Lens' Request ResponseChecker
Lens.checkResponse forall s t a b. ASetter s t a b -> b -> s -> t
.~ ResponseChecker
cs)

prepareGet :: Options -> String -> IO Req
prepareGet :: Options -> String -> IO Req
prepareGet Options
opts String
url = Mgr -> Request -> Req
Req (Options -> Mgr
manager Options
opts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Request -> IO Request) -> Options -> String -> IO Request
prepare forall (m :: * -> *) a. Monad m => a -> m a
return Options
opts String
url

runRead :: Run L.ByteString
runRead :: Run ByteString
runRead (Req Mgr
mgr Request
req) = forall a. Mgr -> (Response BodyReader -> IO a) -> Request -> IO a
run Mgr
mgr Response BodyReader -> IO (Response ByteString)
readResponse Request
req

runReadHistory :: RunHistory L.ByteString
runReadHistory :: RunHistory ByteString
runReadHistory (Req Mgr
mgr Request
req) = forall a.
Mgr -> (HistoriedResponse BodyReader -> IO a) -> Request -> IO a
runHistory Mgr
mgr HistoriedResponse BodyReader -> IO (HistoriedResponse ByteString)
readHistoriedResponse Request
req

preparePost :: Postable a => Options -> String -> a -> IO Req
preparePost :: forall a. Postable a => Options -> String -> a -> IO Req
preparePost Options
opts String
url a
payload = Mgr -> Request -> Req
Req (Options -> Mgr
manager Options
opts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Request -> IO Request) -> Options -> String -> IO Request
prepare (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' Request ByteString
Lens.method forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
HTTP.methodPost) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Postable a => a -> Request -> IO Request
postPayload a
payload) Options
opts String
url

prepareMethod :: HTTP.Method -> Options -> String -> IO Req
prepareMethod :: ByteString -> Options -> String -> IO Req
prepareMethod ByteString
method Options
opts String
url = Mgr -> Request -> Req
Req (Options -> Mgr
manager Options
opts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Request -> IO Request) -> Options -> String -> IO Request
prepare (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' Request ByteString
Lens.method forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
method)) Options
opts String
url

preparePayloadMethod :: Postable a => HTTP.Method -> Options -> String -> a
                        -> IO Req
preparePayloadMethod :: forall a.
Postable a =>
ByteString -> Options -> String -> a -> IO Req
preparePayloadMethod ByteString
method Options
opts String
url a
payload = Mgr -> Request -> Req
Req (Options -> Mgr
manager Options
opts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Request -> IO Request) -> Options -> String -> IO Request
prepare (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' Request ByteString
Lens.method forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
method) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Postable a => a -> Request -> IO Request
postPayload a
payload) Options
opts String
url

prepareHead :: Options -> String -> IO Req
prepareHead :: Options -> String -> IO Req
prepareHead = ByteString -> Options -> String -> IO Req
prepareMethod ByteString
HTTP.methodHead

runIgnore :: Run ()
runIgnore :: Run ()
runIgnore (Req Mgr
mgr Request
req) = forall a. Mgr -> (Response BodyReader -> IO a) -> Request -> IO a
run Mgr
mgr Response BodyReader -> IO (Response ())
ignoreResponse Request
req

prepareOptions :: Options -> String -> IO Req
prepareOptions :: Options -> String -> IO Req
prepareOptions = ByteString -> Options -> String -> IO Req
prepareMethod ByteString
HTTP.methodOptions

preparePut :: Putable a => Options -> String -> a -> IO Req
preparePut :: forall a. Putable a => Options -> String -> a -> IO Req
preparePut Options
opts String
url a
payload = Mgr -> Request -> Req
Req (Options -> Mgr
manager Options
opts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Request -> IO Request) -> Options -> String -> IO Request
prepare (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' Request ByteString
Lens.method forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
HTTP.methodPut) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Putable a => a -> Request -> IO Request
putPayload a
payload) Options
opts String
url

preparePatch :: Patchable a => Options -> String -> a -> IO Req
preparePatch :: forall a. Patchable a => Options -> String -> a -> IO Req
preparePatch Options
opts String
url a
payload = Mgr -> Request -> Req
Req (Options -> Mgr
manager Options
opts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Request -> IO Request) -> Options -> String -> IO Request
prepare (forall a. Patchable a => a -> Request -> IO Request
patchPayload a
payload forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' Request ByteString
Lens.method forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
HTTP.methodPatch)) Options
opts String
url

prepareDelete :: Options -> String -> IO Req
prepareDelete :: Options -> String -> IO Req
prepareDelete = ByteString -> Options -> String -> IO Req
prepareMethod ByteString
HTTP.methodDelete