{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}

module Web.Exhentai.Types.CookieT where

import Conduit
import Control.Concurrent
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Time
import Control.Monad.Trans.Control
import Control.Retry
import Data.ByteString (ByteString)
import Data.Function ((&))
import GHC.Generics
import Network.HTTP.Client.Conduit
import Network.HTTP.Client.MultipartFormData
import Network.HTTP.Client.TLS

newtype Policy = Policy RetryPolicy

class (Monad m, MonadCatch m, MonadThrow m) => MonadHttp m where
  getRetryPolicy :: m Policy
  formRequest :: String -> m Request
  attachFormData :: [Part] -> Request -> m Request
  respOpen :: MonadIO n => Request -> m (Response (ConduitT i ByteString n ()))
  respClose :: Response body -> m ()
  reqNoBody :: Request -> m (Response ())

class (MonadMask m, MonadTime m, MonadHttp m, MonadIO m) => MonadHttpState m where
  takeCookieJar :: m CookieJar
  readCookieJar :: m CookieJar
  putCookieJar :: CookieJar -> m ()

modifyingJar :: MonadHttpState m => Request -> m ()
modifyingJar :: Request -> m ()
modifyingJar Request
req =
  m CookieJar -> (CookieJar -> m ()) -> (CookieJar -> m ()) -> m ()
forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError
    m CookieJar
forall (m :: Type -> Type). MonadHttpState m => m CookieJar
takeCookieJar
    CookieJar -> m ()
forall (m :: Type -> Type). MonadHttpState m => CookieJar -> m ()
putCookieJar
    ((CookieJar -> m ()) -> m ()) -> (CookieJar -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \CookieJar
jar -> do
      let req' :: Request
req' = Request
req {cookieJar :: Maybe CookieJar
cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just CookieJar
jar}
      Response ()
resp <- m (Response ()) -> m (Response ())
forall (m :: Type -> Type) a. MonadHttpState m => m a -> m a
retryWhenTimeout (m (Response ()) -> m (Response ()))
-> m (Response ()) -> m (Response ())
forall a b. (a -> b) -> a -> b
$ Request -> m (Response ())
forall (m :: Type -> Type).
MonadHttp m =>
Request -> m (Response ())
reqNoBody Request
req'
      CookieJar -> m ()
forall (m :: Type -> Type). MonadHttpState m => CookieJar -> m ()
putCookieJar (CookieJar -> m ()) -> CookieJar -> m ()
forall a b. (a -> b) -> a -> b
$ Response () -> CookieJar
forall body. Response body -> CookieJar
responseCookieJar Response ()
resp
      () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

openWithJar :: (MonadHttpState m, MonadIO n) => Request -> m (Response (ConduitT i ByteString n ()))
openWithJar :: Request -> m (Response (ConduitT i ByteString n ()))
openWithJar Request
req = do
  CookieJar
jar <- m CookieJar
forall (m :: Type -> Type). MonadHttpState m => m CookieJar
readCookieJar
  let req' :: Request
req' = Request
req {cookieJar :: Maybe CookieJar
cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just CookieJar
jar}
  Request -> m (Response (ConduitT i ByteString n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttp m, MonadIO n) =>
Request -> m (Response (ConduitT i ByteString n ()))
respOpen Request
req'

withJar :: (MonadHttpState m, MonadIO n) => Request -> (ConduitT i ByteString n () -> m a) -> m a
withJar :: Request -> (ConduitT i ByteString n () -> m a) -> m a
withJar Request
req ConduitT i ByteString n () -> m a
k = do
  CookieJar
jar <- m CookieJar
forall (m :: Type -> Type). MonadHttpState m => m CookieJar
readCookieJar
  let req' :: Request
req' = Request
req {cookieJar :: Maybe CookieJar
cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just CookieJar
jar}
  m (Response (ConduitT i ByteString n ()))
-> (Response (ConduitT i ByteString n ()) -> m ())
-> (Response (ConduitT i ByteString n ()) -> m a)
-> m a
forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket
    (Request -> m (Response (ConduitT i ByteString n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttp m, MonadIO n) =>
Request -> m (Response (ConduitT i ByteString n ()))
respOpen Request
req')
    Response (ConduitT i ByteString n ()) -> m ()
forall (m :: Type -> Type) body.
MonadHttp m =>
Response body -> m ()
respClose
    (ConduitT i ByteString n () -> m a
k (ConduitT i ByteString n () -> m a)
-> (Response (ConduitT i ByteString n ())
    -> ConduitT i ByteString n ())
-> Response (ConduitT i ByteString n ())
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (ConduitT i ByteString n ()) -> ConduitT i ByteString n ()
forall body. Response body -> body
responseBody)

data CookieEnv = CookieEnv
  { CookieEnv -> Policy
policy :: Policy,
    CookieEnv -> MVar CookieJar
jarRef :: MVar CookieJar,
    CookieEnv -> Manager
manager :: {-# UNPACK #-} !Manager
  }
  deriving ((forall x. CookieEnv -> Rep CookieEnv x)
-> (forall x. Rep CookieEnv x -> CookieEnv) -> Generic CookieEnv
forall x. Rep CookieEnv x -> CookieEnv
forall x. CookieEnv -> Rep CookieEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CookieEnv x -> CookieEnv
$cfrom :: forall x. CookieEnv -> Rep CookieEnv x
Generic)

instance HasHttpManager CookieEnv where
  getHttpManager :: CookieEnv -> Manager
getHttpManager = CookieEnv -> Manager
manager

newtype CookieT m a = CookieT {CookieT m a -> ReaderT CookieEnv m a
unCookieT :: ReaderT CookieEnv m a}
  deriving newtype
    ( a -> CookieT m b -> CookieT m a
(a -> b) -> CookieT m a -> CookieT m b
(forall a b. (a -> b) -> CookieT m a -> CookieT m b)
-> (forall a b. a -> CookieT m b -> CookieT m a)
-> Functor (CookieT m)
forall a b. a -> CookieT m b -> CookieT m a
forall a b. (a -> b) -> CookieT m a -> CookieT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> CookieT m b -> CookieT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> CookieT m a -> CookieT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CookieT m b -> CookieT m a
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> CookieT m b -> CookieT m a
fmap :: (a -> b) -> CookieT m a -> CookieT m b
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> CookieT m a -> CookieT m b
Functor,
      Functor (CookieT m)
a -> CookieT m a
Functor (CookieT m)
-> (forall a. a -> CookieT m a)
-> (forall a b. CookieT m (a -> b) -> CookieT m a -> CookieT m b)
-> (forall a b c.
    (a -> b -> c) -> CookieT m a -> CookieT m b -> CookieT m c)
-> (forall a b. CookieT m a -> CookieT m b -> CookieT m b)
-> (forall a b. CookieT m a -> CookieT m b -> CookieT m a)
-> Applicative (CookieT m)
CookieT m a -> CookieT m b -> CookieT m b
CookieT m a -> CookieT m b -> CookieT m a
CookieT m (a -> b) -> CookieT m a -> CookieT m b
(a -> b -> c) -> CookieT m a -> CookieT m b -> CookieT m c
forall a. a -> CookieT m a
forall a b. CookieT m a -> CookieT m b -> CookieT m a
forall a b. CookieT m a -> CookieT m b -> CookieT m b
forall a b. CookieT m (a -> b) -> CookieT m a -> CookieT m b
forall a b c.
(a -> b -> c) -> CookieT m a -> CookieT m b -> CookieT m c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: Type -> Type). Applicative m => Functor (CookieT m)
forall (m :: Type -> Type) a. Applicative m => a -> CookieT m a
forall (m :: Type -> Type) a b.
Applicative m =>
CookieT m a -> CookieT m b -> CookieT m a
forall (m :: Type -> Type) a b.
Applicative m =>
CookieT m a -> CookieT m b -> CookieT m b
forall (m :: Type -> Type) a b.
Applicative m =>
CookieT m (a -> b) -> CookieT m a -> CookieT m b
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c) -> CookieT m a -> CookieT m b -> CookieT m c
<* :: CookieT m a -> CookieT m b -> CookieT m a
$c<* :: forall (m :: Type -> Type) a b.
Applicative m =>
CookieT m a -> CookieT m b -> CookieT m a
*> :: CookieT m a -> CookieT m b -> CookieT m b
$c*> :: forall (m :: Type -> Type) a b.
Applicative m =>
CookieT m a -> CookieT m b -> CookieT m b
liftA2 :: (a -> b -> c) -> CookieT m a -> CookieT m b -> CookieT m c
$cliftA2 :: forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c) -> CookieT m a -> CookieT m b -> CookieT m c
<*> :: CookieT m (a -> b) -> CookieT m a -> CookieT m b
$c<*> :: forall (m :: Type -> Type) a b.
Applicative m =>
CookieT m (a -> b) -> CookieT m a -> CookieT m b
pure :: a -> CookieT m a
$cpure :: forall (m :: Type -> Type) a. Applicative m => a -> CookieT m a
$cp1Applicative :: forall (m :: Type -> Type). Applicative m => Functor (CookieT m)
Applicative,
      Applicative (CookieT m)
a -> CookieT m a
Applicative (CookieT m)
-> (forall a b. CookieT m a -> (a -> CookieT m b) -> CookieT m b)
-> (forall a b. CookieT m a -> CookieT m b -> CookieT m b)
-> (forall a. a -> CookieT m a)
-> Monad (CookieT m)
CookieT m a -> (a -> CookieT m b) -> CookieT m b
CookieT m a -> CookieT m b -> CookieT m b
forall a. a -> CookieT m a
forall a b. CookieT m a -> CookieT m b -> CookieT m b
forall a b. CookieT m a -> (a -> CookieT m b) -> CookieT m b
forall (m :: Type -> Type). Monad m => Applicative (CookieT m)
forall (m :: Type -> Type) a. Monad m => a -> CookieT m a
forall (m :: Type -> Type) a b.
Monad m =>
CookieT m a -> CookieT m b -> CookieT m b
forall (m :: Type -> Type) a b.
Monad m =>
CookieT m a -> (a -> CookieT m b) -> CookieT m b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CookieT m a
$creturn :: forall (m :: Type -> Type) a. Monad m => a -> CookieT m a
>> :: CookieT m a -> CookieT m b -> CookieT m b
$c>> :: forall (m :: Type -> Type) a b.
Monad m =>
CookieT m a -> CookieT m b -> CookieT m b
>>= :: CookieT m a -> (a -> CookieT m b) -> CookieT m b
$c>>= :: forall (m :: Type -> Type) a b.
Monad m =>
CookieT m a -> (a -> CookieT m b) -> CookieT m b
$cp1Monad :: forall (m :: Type -> Type). Monad m => Applicative (CookieT m)
Monad,
      MonadReader CookieEnv,
      Monad (CookieT m)
e -> CookieT m a
Monad (CookieT m)
-> (forall e a. Exception e => e -> CookieT m a)
-> MonadThrow (CookieT m)
forall e a. Exception e => e -> CookieT m a
forall (m :: Type -> Type).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: Type -> Type). MonadThrow m => Monad (CookieT m)
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> CookieT m a
throwM :: e -> CookieT m a
$cthrowM :: forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> CookieT m a
$cp1MonadThrow :: forall (m :: Type -> Type). MonadThrow m => Monad (CookieT m)
MonadThrow,
      MonadThrow (CookieT m)
MonadThrow (CookieT m)
-> (forall e a.
    Exception e =>
    CookieT m a -> (e -> CookieT m a) -> CookieT m a)
-> MonadCatch (CookieT m)
CookieT m a -> (e -> CookieT m a) -> CookieT m a
forall e a.
Exception e =>
CookieT m a -> (e -> CookieT m a) -> CookieT m a
forall (m :: Type -> Type).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: Type -> Type). MonadCatch m => MonadThrow (CookieT m)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
CookieT m a -> (e -> CookieT m a) -> CookieT m a
catch :: CookieT m a -> (e -> CookieT m a) -> CookieT m a
$ccatch :: forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
CookieT m a -> (e -> CookieT m a) -> CookieT m a
$cp1MonadCatch :: forall (m :: Type -> Type). MonadCatch m => MonadThrow (CookieT m)
MonadCatch,
      MonadCatch (CookieT m)
MonadCatch (CookieT m)
-> (forall b.
    ((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
    -> CookieT m b)
-> (forall b.
    ((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
    -> CookieT m b)
-> (forall a b c.
    CookieT m a
    -> (a -> ExitCase b -> CookieT m c)
    -> (a -> CookieT m b)
    -> CookieT m (b, c))
-> MonadMask (CookieT m)
CookieT m a
-> (a -> ExitCase b -> CookieT m c)
-> (a -> CookieT m b)
-> CookieT m (b, c)
((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
forall b.
((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
forall a b c.
CookieT m a
-> (a -> ExitCase b -> CookieT m c)
-> (a -> CookieT m b)
-> CookieT m (b, c)
forall (m :: Type -> Type).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: Type -> Type). MonadMask m => MonadCatch (CookieT m)
forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
forall (m :: Type -> Type) a b c.
MonadMask m =>
CookieT m a
-> (a -> ExitCase b -> CookieT m c)
-> (a -> CookieT m b)
-> CookieT m (b, c)
generalBracket :: CookieT m a
-> (a -> ExitCase b -> CookieT m c)
-> (a -> CookieT m b)
-> CookieT m (b, c)
$cgeneralBracket :: forall (m :: Type -> Type) a b c.
MonadMask m =>
CookieT m a
-> (a -> ExitCase b -> CookieT m c)
-> (a -> CookieT m b)
-> CookieT m (b, c)
uninterruptibleMask :: ((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
$cuninterruptibleMask :: forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
mask :: ((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
$cmask :: forall (m :: Type -> Type) b.
MonadMask m =>
((forall a. CookieT m a -> CookieT m a) -> CookieT m b)
-> CookieT m b
$cp1MonadMask :: forall (m :: Type -> Type). MonadMask m => MonadCatch (CookieT m)
MonadMask,
      Monad (CookieT m)
Monad (CookieT m)
-> (forall a. IO a -> CookieT m a) -> MonadIO (CookieT m)
IO a -> CookieT m a
forall a. IO a -> CookieT m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: Type -> Type). MonadIO m => Monad (CookieT m)
forall (m :: Type -> Type) a. MonadIO m => IO a -> CookieT m a
liftIO :: IO a -> CookieT m a
$cliftIO :: forall (m :: Type -> Type) a. MonadIO m => IO a -> CookieT m a
$cp1MonadIO :: forall (m :: Type -> Type). MonadIO m => Monad (CookieT m)
MonadIO,
      MonadIO (CookieT m)
MonadIO (CookieT m)
-> (forall a. ResourceT IO a -> CookieT m a)
-> MonadResource (CookieT m)
ResourceT IO a -> CookieT m a
forall a. ResourceT IO a -> CookieT m a
forall (m :: Type -> Type).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
forall (m :: Type -> Type). MonadResource m => MonadIO (CookieT m)
forall (m :: Type -> Type) a.
MonadResource m =>
ResourceT IO a -> CookieT m a
liftResourceT :: ResourceT IO a -> CookieT m a
$cliftResourceT :: forall (m :: Type -> Type) a.
MonadResource m =>
ResourceT IO a -> CookieT m a
$cp1MonadResource :: forall (m :: Type -> Type). MonadResource m => MonadIO (CookieT m)
MonadResource,
      MonadIO (CookieT m)
MonadIO (CookieT m)
-> (forall b.
    ((forall a. CookieT m a -> IO a) -> IO b) -> CookieT m b)
-> MonadUnliftIO (CookieT m)
((forall a. CookieT m a -> IO a) -> IO b) -> CookieT m b
forall b. ((forall a. CookieT m a -> IO a) -> IO b) -> CookieT m b
forall (m :: Type -> Type).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
forall (m :: Type -> Type). MonadUnliftIO m => MonadIO (CookieT m)
forall (m :: Type -> Type) b.
MonadUnliftIO m =>
((forall a. CookieT m a -> IO a) -> IO b) -> CookieT m b
withRunInIO :: ((forall a. CookieT m a -> IO a) -> IO b) -> CookieT m b
$cwithRunInIO :: forall (m :: Type -> Type) b.
MonadUnliftIO m =>
((forall a. CookieT m a -> IO a) -> IO b) -> CookieT m b
$cp1MonadUnliftIO :: forall (m :: Type -> Type). MonadUnliftIO m => MonadIO (CookieT m)
MonadUnliftIO,
      MonadError e,
      MonadBase b,
      MonadBaseControl b,
      Monad (CookieT m)
CookieT m UTCTime
Monad (CookieT m) -> CookieT m UTCTime -> MonadTime (CookieT m)
forall (m :: Type -> Type). Monad m -> m UTCTime -> MonadTime m
forall (m :: Type -> Type). MonadTime m => Monad (CookieT m)
forall (m :: Type -> Type). MonadTime m => CookieT m UTCTime
currentTime :: CookieT m UTCTime
$ccurrentTime :: forall (m :: Type -> Type). MonadTime m => CookieT m UTCTime
$cp1MonadTime :: forall (m :: Type -> Type). MonadTime m => Monad (CookieT m)
MonadTime
    )

runCookieT :: MonadIO m => RetryPolicy -> CookieT m a -> m a
runCookieT :: RetryPolicy -> CookieT m a -> m a
runCookieT (RetryPolicy -> Policy
Policy -> Policy
policy) CookieT m a
m = do
  Manager
manager <- IO Manager -> m Manager
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO Manager
forall (m :: Type -> Type). MonadIO m => m Manager
newTlsManager
  MVar CookieJar
jarRef <- IO (MVar CookieJar) -> m (MVar CookieJar)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar CookieJar) -> m (MVar CookieJar))
-> IO (MVar CookieJar) -> m (MVar CookieJar)
forall a b. (a -> b) -> a -> b
$ CookieJar -> IO (MVar CookieJar)
forall a. a -> IO (MVar a)
newMVar CookieJar
forall a. Monoid a => a
mempty
  CookieT m a
m
    CookieT m a
-> (CookieT m a -> ReaderT CookieEnv m a) -> ReaderT CookieEnv m a
forall a b. a -> (a -> b) -> b
& CookieT m a -> ReaderT CookieEnv m a
forall (m :: Type -> Type) a. CookieT m a -> ReaderT CookieEnv m a
unCookieT
    ReaderT CookieEnv m a -> (ReaderT CookieEnv m a -> m a) -> m a
forall a b. a -> (a -> b) -> b
& (ReaderT CookieEnv m a -> CookieEnv -> m a)
-> CookieEnv -> ReaderT CookieEnv m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT CookieEnv m a -> CookieEnv -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT CookieEnv :: Policy -> MVar CookieJar -> Manager -> CookieEnv
CookieEnv {MVar CookieJar
Manager
Policy
jarRef :: MVar CookieJar
manager :: Manager
policy :: Policy
$sel:manager:CookieEnv :: Manager
$sel:jarRef:CookieEnv :: MVar CookieJar
$sel:policy:CookieEnv :: Policy
..}

instance MonadTrans CookieT where
  lift :: m a -> CookieT m a
lift = ReaderT CookieEnv m a -> CookieT m a
forall (m :: Type -> Type) a. ReaderT CookieEnv m a -> CookieT m a
CookieT (ReaderT CookieEnv m a -> CookieT m a)
-> (m a -> ReaderT CookieEnv m a) -> m a -> CookieT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT CookieEnv m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance
  ( MonadIO m,
    MonadUnliftIO m,
    MonadCatch m,
    MonadThrow m
  ) =>
  MonadHttp (CookieT m)
  where
  getRetryPolicy :: CookieT m Policy
getRetryPolicy = (CookieEnv -> Policy) -> CookieT m Policy
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks CookieEnv -> Policy
policy
  formRequest :: String -> CookieT m Request
formRequest = String -> CookieT m Request
forall (m :: Type -> Type). MonadThrow m => String -> m Request
parseRequest
  attachFormData :: [Part] -> Request -> CookieT m Request
attachFormData = [Part] -> Request -> CookieT m Request
forall (m :: Type -> Type).
MonadIO m =>
[Part] -> Request -> m Request
formDataBody
  respOpen :: Request -> CookieT m (Response (ConduitT i ByteString n ()))
respOpen = Request -> CookieT m (Response (ConduitT i ByteString n ()))
forall (m :: Type -> Type) (n :: Type -> Type) env i.
(MonadIO m, MonadIO n, MonadReader env m, HasHttpManager env) =>
Request -> m (Response (ConduitM i ByteString n ()))
responseOpen
  respClose :: Response body -> CookieT m ()
respClose = Response body -> CookieT m ()
forall (m :: Type -> Type) body. MonadIO m => Response body -> m ()
responseClose
  reqNoBody :: Request -> CookieT m (Response ())
reqNoBody = Request -> CookieT m (Response ())
forall (m :: Type -> Type) env.
(MonadIO m, HasHttpManager env, MonadReader env m) =>
Request -> m (Response ())
httpNoBody

instance
  {-# OVERLAPPABLE #-}
  ( MonadHttp m,
    MonadTrans f,
    Monad (f m),
    MonadCatch (f m),
    MonadThrow (f m)
  ) =>
  MonadHttp (f m)
  where
  getRetryPolicy :: f m Policy
getRetryPolicy = m Policy -> f m Policy
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Policy
forall (m :: Type -> Type). MonadHttp m => m Policy
getRetryPolicy
  formRequest :: String -> f m Request
formRequest = m Request -> f m Request
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Request -> f m Request)
-> (String -> m Request) -> String -> f m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Request
forall (m :: Type -> Type). MonadHttp m => String -> m Request
formRequest
  attachFormData :: [Part] -> Request -> f m Request
attachFormData [Part]
p = m Request -> f m Request
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Request -> f m Request)
-> (Request -> m Request) -> Request -> f m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Part] -> Request -> m Request
forall (m :: Type -> Type).
MonadHttp m =>
[Part] -> Request -> m Request
attachFormData [Part]
p
  respOpen :: Request -> f m (Response (ConduitT i ByteString n ()))
respOpen = m (Response (ConduitT i ByteString n ()))
-> f m (Response (ConduitT i ByteString n ()))
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Response (ConduitT i ByteString n ()))
 -> f m (Response (ConduitT i ByteString n ())))
-> (Request -> m (Response (ConduitT i ByteString n ())))
-> Request
-> f m (Response (ConduitT i ByteString n ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response (ConduitT i ByteString n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttp m, MonadIO n) =>
Request -> m (Response (ConduitT i ByteString n ()))
respOpen
  respClose :: Response body -> f m ()
respClose = m () -> f m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> f m ())
-> (Response body -> m ()) -> Response body -> f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response body -> m ()
forall (m :: Type -> Type) body.
MonadHttp m =>
Response body -> m ()
respClose
  reqNoBody :: Request -> f m (Response ())
reqNoBody = m (Response ()) -> f m (Response ())
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Response ()) -> f m (Response ()))
-> (Request -> m (Response ())) -> Request -> f m (Response ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response ())
forall (m :: Type -> Type).
MonadHttp m =>
Request -> m (Response ())
reqNoBody

retryWhenTimeout :: MonadHttpState m => m a -> m a
retryWhenTimeout :: m a -> m a
retryWhenTimeout m a
action = do
  Policy RetryPolicy
policy <- m Policy
forall (m :: Type -> Type). MonadHttp m => m Policy
getRetryPolicy
  RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
forall (m :: Type -> Type) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering RetryPolicyM m
RetryPolicy
policy [RetryStatus -> Handler m Bool]
handlers (m a -> RetryStatus -> m a
forall a b. a -> b -> a
const m a
action)
  where
    handlers :: [RetryStatus -> Handler m Bool]
handlers =
      [RetryStatus -> Handler m Bool]
forall (m :: Type -> Type).
MonadIO m =>
[RetryStatus -> Handler m Bool]
skipAsyncExceptions
        [RetryStatus -> Handler m Bool]
-> [RetryStatus -> Handler m Bool]
-> [RetryStatus -> Handler m Bool]
forall a. [a] -> [a] -> [a]
++ [ Handler m Bool -> RetryStatus -> Handler m Bool
forall a b. a -> b -> a
const ((HttpException -> m Bool) -> Handler m Bool
forall (m :: Type -> Type) a e.
Exception e =>
(e -> m a) -> Handler m a
Handler (Bool -> m Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> m Bool)
-> (HttpException -> Bool) -> HttpException -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> Bool
judge))
           ]
    judge :: HttpException -> Bool
judge (HttpExceptionRequest Request
_ HttpExceptionContent
c)
      | HttpExceptionContent
ResponseTimeout <- HttpExceptionContent
c = Bool
True
      | HttpExceptionContent
ConnectionTimeout <- HttpExceptionContent
c = Bool
True
    judge HttpException
_ = Bool
False

instance
  ( MonadMask m,
    MonadUnliftIO m,
    MonadTime m
  ) =>
  MonadHttpState (CookieT m)
  where
  takeCookieJar :: CookieT m CookieJar
takeCookieJar = do
    MVar CookieJar
ref <- (CookieEnv -> MVar CookieJar) -> CookieT m (MVar CookieJar)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks CookieEnv -> MVar CookieJar
jarRef
    IO CookieJar -> CookieT m CookieJar
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CookieJar -> CookieT m CookieJar)
-> IO CookieJar -> CookieT m CookieJar
forall a b. (a -> b) -> a -> b
$ MVar CookieJar -> IO CookieJar
forall a. MVar a -> IO a
takeMVar MVar CookieJar
ref
  putCookieJar :: CookieJar -> CookieT m ()
putCookieJar CookieJar
jar = do
    MVar CookieJar
ref <- (CookieEnv -> MVar CookieJar) -> CookieT m (MVar CookieJar)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks CookieEnv -> MVar CookieJar
jarRef
    IO () -> CookieT m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> CookieT m ()) -> IO () -> CookieT m ()
forall a b. (a -> b) -> a -> b
$ MVar CookieJar -> CookieJar -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar CookieJar
ref CookieJar
jar
  readCookieJar :: CookieT m CookieJar
readCookieJar = do
    MVar CookieJar
ref <- (CookieEnv -> MVar CookieJar) -> CookieT m (MVar CookieJar)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks CookieEnv -> MVar CookieJar
jarRef
    IO CookieJar -> CookieT m CookieJar
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CookieJar -> CookieT m CookieJar)
-> IO CookieJar -> CookieT m CookieJar
forall a b. (a -> b) -> a -> b
$ MVar CookieJar -> IO CookieJar
forall a. MVar a -> IO a
readMVar MVar CookieJar
ref

instance
  {-# OVERLAPPABLE #-}
  ( MonadHttpState m,
    MonadTrans f,
    MonadMask (f m),
    MonadTime (f m),
    MonadHttp (f m),
    MonadIO (f m)
  ) =>
  MonadHttpState (f m)
  where
  takeCookieJar :: f m CookieJar
takeCookieJar = m CookieJar -> f m CookieJar
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CookieJar
forall (m :: Type -> Type). MonadHttpState m => m CookieJar
takeCookieJar
  putCookieJar :: CookieJar -> f m ()
putCookieJar = m () -> f m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> f m ()) -> (CookieJar -> m ()) -> CookieJar -> f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CookieJar -> m ()
forall (m :: Type -> Type). MonadHttpState m => CookieJar -> m ()
putCookieJar
  readCookieJar :: f m CookieJar
readCookieJar = m CookieJar -> f m CookieJar
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CookieJar
forall (m :: Type -> Type). MonadHttpState m => m CookieJar
readCookieJar