module Effectful.Wreq (
  -- * Effect
    Wreq
  -- ** Handlers
  , runWreq

  -- * GET
  , get
  , getWith

  -- * POST
  , post
  , postWith

  -- * HEAD
  , head_
  , headWith

  -- * PUT
  , put
  , putWith

  -- * PATCH
  , patch
  , patchWith

  -- * OPTIONS
  , options
  , optionsWith

  -- * DELETE
  , delete
  , deleteWith

  -- * Custom Method
  , customMethod
  , customMethodWith
  , customHistoriedMethod
  , customHistoriedMethodWith

  -- * Custom Payload Method
  , customPayloadMethod
  , customPayloadMethodWith
  , customHistoriedPayloadMethod
  , customHistoriedPayloadMethodWith

  -- * Reexports
  , W.Options
  , W.defaults
  , WL.manager
  , WL.header
  , WL.param
  , WL.redirects
  , WL.headers
  , WL.params
  , WL.cookie
  , WL.cookies
  , WL.checkResponse

  -- ** Authentication
  , W.Auth
  , W.AWSAuthVersion(..)
  , WL.auth
  , W.basicAuth
  , W.oauth1Auth
  , W.oauth2Bearer
  , W.oauth2Token
  , W.awsAuth
  , W.awsFullAuth
  , W.awsSessionTokenAuth
  -- ** Proxy settings
  , W.Proxy(Proxy)
  , WL.proxy
  , W.httpProxy
  -- ** Using a manager with defaults
  , W.withManager

  -- ** Payloads for POST and PUT
  , W.Payload(..)
  -- *** URL-encoded form data
  , W.FormParam(..)
  , W.FormValue
  -- *** Multipart form data
  , HF.Part
  , WL.partName
  , WL.partFileName
  , WL.partContentType
  , WL.partGetBody
  -- **** Smart constructors
  , HF.partBS
  , HF.partLBS
  , W.partText
  , W.partString
  , HF.partFile
  , HF.partFileSource

  -- ** Responses
  , W.Response
  , WL.responseBody
  , WL.responseHeader
  , WL.responseLink
  , WL.responseCookie
  , WL.responseHeaders
  , WL.responseCookieJar
  , WL.responseStatus
  , WL.Status
  , WL.statusCode
  , WL.statusMessage
  , W.HistoriedResponse
  , WL.hrFinalRequest
  , WL.hrFinalResponse
  , WL.hrRedirects
  -- *** Link headers
  , WL.Link
  , WL.linkURL
  , WL.linkParams
  -- *** Decoding responses
  , W.JSONError(..)
  , W.asJSON
  , W.asValue

  -- ** Cookies
  , WL.Cookie
  , WL.cookieName
  , WL.cookieValue
  , WL.cookieExpiryTime
  , WL.cookieDomain
  , WL.cookiePath

  -- ** Parsing responses
  , WL.atto
  , WL.atto_
  ) where

import Effectful
import Effectful.Dispatch.Static
import Data.ByteString.Lazy qualified as L
import Network.HTTP.Client.MultipartFormData qualified as HF
import Network.Wreq         qualified as W
import Network.Wreq.Lens    qualified as WL
import Network.Wreq.Types as WT

data Wreq :: Effect where

type instance DispatchOf Wreq = Static WithSideEffects
data instance StaticRep Wreq = Wreq

-- | Run the 'Wreq' effect.
runWreq :: (HasCallStack, IOE :> es) => Eff (Wreq : es) a -> Eff es a
runWreq :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (Wreq : es) a -> Eff es a
runWreq = StaticRep Wreq -> Eff (Wreq : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep Wreq
Wreq

-- | Lifted `W.get`
get :: Wreq :> es => String -> Eff es (W.Response L.ByteString)
get :: forall (es :: [Effect]).
(Wreq :> es) =>
String -> Eff es (Response ByteString)
get = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (String -> IO (Response ByteString))
-> String
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Response ByteString)
W.get

-- | Lifted `W.getWith`
getWith :: Wreq :> es => W.Options -> String -> Eff es (W.Response L.ByteString)
getWith :: forall (es :: [Effect]).
(Wreq :> es) =>
Options -> String -> Eff es (Response ByteString)
getWith Options
opts = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (String -> IO (Response ByteString))
-> String
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> IO (Response ByteString)
W.getWith Options
opts

-- | Lifted `W.post`
post :: Wreq :> es => WT.Postable a => String -> a -> Eff es (W.Response L.ByteString)
post :: forall (es :: [Effect]) a.
(Wreq :> es, Postable a) =>
String -> a -> Eff es (Response ByteString)
post String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> IO (Response ByteString)
forall a. Postable a => String -> a -> IO (Response ByteString)
W.post String
url

-- | Lifted `W.postWith`
postWith :: Wreq :> es => WT.Postable a => W.Options -> String -> a -> Eff es (W.Response L.ByteString)
postWith :: forall (es :: [Effect]) a.
(Wreq :> es, Postable a) =>
Options -> String -> a -> Eff es (Response ByteString)
postWith Options
opts String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> a -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
W.postWith Options
opts String
url

-- | Lifted `W.head_`
head_ :: Wreq :> es => String -> Eff es (W.Response ())
head_ :: forall (es :: [Effect]).
(Wreq :> es) =>
String -> Eff es (Response ())
head_ = IO (Response ()) -> Eff es (Response ())
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ()) -> Eff es (Response ()))
-> (String -> IO (Response ())) -> String -> Eff es (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Response ())
W.head_

-- | Lifted `W.headWith`
headWith :: Wreq :> es => W.Options -> String -> Eff es (W.Response ())
headWith :: forall (es :: [Effect]).
(Wreq :> es) =>
Options -> String -> Eff es (Response ())
headWith Options
opts = IO (Response ()) -> Eff es (Response ())
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ()) -> Eff es (Response ()))
-> (String -> IO (Response ())) -> String -> Eff es (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> IO (Response ())
W.headWith Options
opts

-- | Lifted `W.put`
put :: Wreq :> es => Putable a => String -> a -> Eff es (W.Response L.ByteString)
put :: forall (es :: [Effect]) a.
(Wreq :> es, Putable a) =>
String -> a -> Eff es (Response ByteString)
put String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> IO (Response ByteString)
forall a. Putable a => String -> a -> IO (Response ByteString)
W.put String
url

-- | Lifted `W.putWith`
putWith :: Wreq :> es => Putable a => W.Options -> String -> a -> Eff es (W.Response L.ByteString)
putWith :: forall (es :: [Effect]) a.
(Wreq :> es, Putable a) =>
Options -> String -> a -> Eff es (Response ByteString)
putWith Options
opts String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> a -> IO (Response ByteString)
forall a.
Putable a =>
Options -> String -> a -> IO (Response ByteString)
W.putWith Options
opts String
url

-- | Lifted `W.patch`
patch :: Wreq :> es => Patchable a => String -> a -> Eff es (W.Response L.ByteString)
patch :: forall (es :: [Effect]) a.
(Wreq :> es, Patchable a) =>
String -> a -> Eff es (Response ByteString)
patch String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> IO (Response ByteString)
forall a. Patchable a => String -> a -> IO (Response ByteString)
W.patch String
url

-- | Lifted `W.patchWith`
patchWith :: Wreq :> es => Patchable a => W.Options -> String -> a -> Eff es (W.Response L.ByteString)
patchWith :: forall (es :: [Effect]) a.
(Wreq :> es, Patchable a) =>
Options -> String -> a -> Eff es (Response ByteString)
patchWith Options
opts String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> a -> IO (Response ByteString)
forall a.
Patchable a =>
Options -> String -> a -> IO (Response ByteString)
W.patchWith Options
opts String
url

-- | Lifted `W.options`
options :: Wreq :> es => String -> Eff es (W.Response ())
options :: forall (es :: [Effect]).
(Wreq :> es) =>
String -> Eff es (Response ())
options = IO (Response ()) -> Eff es (Response ())
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ()) -> Eff es (Response ()))
-> (String -> IO (Response ())) -> String -> Eff es (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Response ())
W.options

-- | Lifted `W.optionsWith`
optionsWith :: Wreq :> es => W.Options -> String -> Eff es (W.Response ())
optionsWith :: forall (es :: [Effect]).
(Wreq :> es) =>
Options -> String -> Eff es (Response ())
optionsWith Options
opts = IO (Response ()) -> Eff es (Response ())
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ()) -> Eff es (Response ()))
-> (String -> IO (Response ())) -> String -> Eff es (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> IO (Response ())
W.optionsWith Options
opts

-- | Lifted `W.delete`
delete :: Wreq :> es => String -> Eff es (W.Response L.ByteString)
delete :: forall (es :: [Effect]).
(Wreq :> es) =>
String -> Eff es (Response ByteString)
delete = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (String -> IO (Response ByteString))
-> String
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Response ByteString)
W.delete

-- | Lifted `W.deleteWith`
deleteWith :: Wreq :> es => W.Options -> String -> Eff es (W.Response L.ByteString)
deleteWith :: forall (es :: [Effect]).
(Wreq :> es) =>
Options -> String -> Eff es (Response ByteString)
deleteWith Options
opts = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (String -> IO (Response ByteString))
-> String
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> String -> IO (Response ByteString)
W.deleteWith Options
opts

-- | Lifted `W.customMethod`
customMethod :: Wreq :> es => String -> String -> Eff es (W.Response L.ByteString)
customMethod :: forall (es :: [Effect]).
(Wreq :> es) =>
String -> String -> Eff es (Response ByteString)
customMethod String
method = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (String -> IO (Response ByteString))
-> String
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO (Response ByteString)
W.customMethod String
method

-- | Lifted `W.customMethodWith`
customMethodWith :: Wreq :> es => String -> W.Options -> String -> Eff es (W.Response L.ByteString)
customMethodWith :: forall (es :: [Effect]).
(Wreq :> es) =>
String -> Options -> String -> Eff es (Response ByteString)
customMethodWith String
method Options
opts = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (String -> IO (Response ByteString))
-> String
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options -> String -> IO (Response ByteString)
W.customMethodWith String
method Options
opts

-- | Lifted `W.customHistoriedMethod`
customHistoriedMethod :: Wreq :> es => String -> String -> Eff es (W.HistoriedResponse L.ByteString)
customHistoriedMethod :: forall (es :: [Effect]).
(Wreq :> es) =>
String -> String -> Eff es (HistoriedResponse ByteString)
customHistoriedMethod String
method = IO (HistoriedResponse ByteString)
-> Eff es (HistoriedResponse ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (HistoriedResponse ByteString)
 -> Eff es (HistoriedResponse ByteString))
-> (String -> IO (HistoriedResponse ByteString))
-> String
-> Eff es (HistoriedResponse ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO (HistoriedResponse ByteString)
W.customHistoriedMethod String
method

-- | Lifted `W.customHistoriedMethodWith`
customHistoriedMethodWith :: Wreq :> es => String -> W.Options -> String -> Eff es (W.HistoriedResponse L.ByteString)
customHistoriedMethodWith :: forall (es :: [Effect]).
(Wreq :> es) =>
String
-> Options -> String -> Eff es (HistoriedResponse ByteString)
customHistoriedMethodWith String
method Options
opts = IO (HistoriedResponse ByteString)
-> Eff es (HistoriedResponse ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (HistoriedResponse ByteString)
 -> Eff es (HistoriedResponse ByteString))
-> (String -> IO (HistoriedResponse ByteString))
-> String
-> Eff es (HistoriedResponse ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options -> String -> IO (HistoriedResponse ByteString)
W.customHistoriedMethodWith String
method Options
opts

-- | Lifted `W.customPayloadMethod`
customPayloadMethod :: Wreq :> es => WT.Postable a => String -> String -> a -> Eff es (W.Response L.ByteString)
customPayloadMethod :: forall (es :: [Effect]) a.
(Wreq :> es, Postable a) =>
String -> String -> a -> Eff es (Response ByteString)
customPayloadMethod String
method String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> a -> IO (Response ByteString)
forall a.
Postable a =>
String -> String -> a -> IO (Response ByteString)
W.customPayloadMethod String
method String
url

-- | Lifted `W.customPayloadMethodWith`
customPayloadMethodWith :: Wreq :> es => WT.Postable a => String -> W.Options -> String -> a -> Eff es (W.Response L.ByteString)
customPayloadMethodWith :: forall (es :: [Effect]) a.
(Wreq :> es, Postable a) =>
String -> Options -> String -> a -> Eff es (Response ByteString)
customPayloadMethodWith String
method Options
opts String
url = IO (Response ByteString) -> Eff es (Response ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Response ByteString) -> Eff es (Response ByteString))
-> (a -> IO (Response ByteString))
-> a
-> Eff es (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Options -> String -> a -> IO (Response ByteString)
forall a.
Postable a =>
String -> Options -> String -> a -> IO (Response ByteString)
W.customPayloadMethodWith String
method Options
opts String
url

-- | Lifted `W.customHistoriedPayloadMethod`
customHistoriedPayloadMethod :: Wreq :> es => WT.Postable a => String -> String -> a -> Eff es (W.HistoriedResponse L.ByteString)
customHistoriedPayloadMethod :: forall (es :: [Effect]) a.
(Wreq :> es, Postable a) =>
String -> String -> a -> Eff es (HistoriedResponse ByteString)
customHistoriedPayloadMethod String
method String
url = IO (HistoriedResponse ByteString)
-> Eff es (HistoriedResponse ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (HistoriedResponse ByteString)
 -> Eff es (HistoriedResponse ByteString))
-> (a -> IO (HistoriedResponse ByteString))
-> a
-> Eff es (HistoriedResponse ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> a -> IO (HistoriedResponse ByteString)
forall a.
Postable a =>
String -> String -> a -> IO (HistoriedResponse ByteString)
W.customHistoriedPayloadMethod String
method String
url

-- | Lifted `W.customHistoriedPayloadMethodWith`
customHistoriedPayloadMethodWith :: Wreq :> es => WT.Postable a => String -> W.Options -> String -> a -> Eff es (W.HistoriedResponse L.ByteString)
customHistoriedPayloadMethodWith :: forall (es :: [Effect]) a.
(Wreq :> es, Postable a) =>
String
-> Options -> String -> a -> Eff es (HistoriedResponse ByteString)
customHistoriedPayloadMethodWith String
method Options
opts String
url = IO (HistoriedResponse ByteString)
-> Eff es (HistoriedResponse ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (HistoriedResponse ByteString)
 -> Eff es (HistoriedResponse ByteString))
-> (a -> IO (HistoriedResponse ByteString))
-> a
-> Eff es (HistoriedResponse ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Options -> String -> a -> IO (HistoriedResponse ByteString)
forall a.
Postable a =>
String
-> Options -> String -> a -> IO (HistoriedResponse ByteString)
W.customHistoriedPayloadMethodWith String
method Options
opts String
url