    {-# LANGUAGE CPP                        #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE RankNTypes                 #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    {-# LANGUAGE TypeFamilies               #-}
    module Servant.Client.Internal.HttpClient.Streaming (
        module Servant.Client.Internal.HttpClient.Streaming,
        ClientEnv (..),
        mkClientEnv,
        clientResponseToResponse,
        defaultMakeClientRequest,
        catchConnectionError,
        ) where

    import           Prelude ()
    import           Prelude.Compat

    import           Control.Concurrent.STM.TVar
    import           Control.DeepSeq
                     (NFData, force)
    import           Control.Exception
                     (evaluate, throwIO)
    import           Control.Monad
                     (unless)
    import           Control.Monad.Base
                     (MonadBase (..))
    import           Control.Monad.Codensity
                     (Codensity (..))
    import           Control.Monad.Error.Class
                     (MonadError (..))
    import           Control.Monad.IO.Class (MonadIO(..))
    import           Control.Monad.Reader (MonadReader(..), ReaderT(..))
    import           Control.Monad.STM
                     (atomically)
    import           Control.Monad.Trans.Except
    import qualified Data.ByteString                    as BS
    import qualified Data.ByteString.Lazy               as BSL
    import           Data.Foldable
                     (for_)
    import           Data.Functor.Alt
                     (Alt (..))
    import           Data.Proxy
                     (Proxy (..))
    import           Data.Time.Clock
                     (getCurrentTime)
    import           GHC.Generics
    import           Network.HTTP.Types
                     (Status, statusIsSuccessful)

    import qualified Network.HTTP.Client                as Client

    import           Servant.Client.Core
    import           Servant.Client.Internal.HttpClient
                     (ClientEnv (..), catchConnectionError,
                     clientResponseToResponse, mkClientEnv, mkFailureResponse,
                     defaultMakeClientRequest)
    import qualified Servant.Types.SourceT              as S
    import Control.Monad.Trans.Class (MonadTrans(..))

    -- | Generates a set of client functions for an API.
    --
    -- Example:
    --
    -- > type API = Capture "no" Int :> Get '[JSON] Int
    -- >        :<|> Get '[JSON] [Bool]
    -- >
    -- > api :: Proxy API
    -- > api = Proxy
    -- >
    -- > getInt :: Int -> ClientM Int
    -- > getBools :: ClientM [Bool]
    -- > getInt :<|> getBools = client api
    client :: HasClient ClientM api => Proxy api -> Client ClientM api
    client :: forall api.
    HasClient ClientM api =>
    Proxy api -> Client ClientM api
    client Proxy api
    api = Proxy api
    api Proxy api -> Proxy ClientM -> Client ClientM api
    forall (m :: Type -> Type) api.
    HasClient m api =>
    Proxy api -> Proxy m -> Client m api
    `clientIn` (Proxy ClientM
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ClientM)

    -- | Change the monad the client functions live in, by
    --   supplying a conversion function
    --   (a natural transformation to be precise).
    --
    --   For example, assuming you have some @manager :: 'Manager'@ and
    --   @baseurl :: 'BaseUrl'@ around:
    --
    --   > type API = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
    --   > api :: Proxy API
    --   > api = Proxy
    --   > getInt :: IO Int
    --   > postInt :: Int -> IO Int
    --   > getInt :<|> postInt = hoistClient api (flip runClientM cenv) (client api)
    --   >   where cenv = mkClientEnv manager baseurl
    hoistClient
      :: HasClient ClientM api
      => Proxy api
      -> (forall a. m a -> n a)
      -> Client m api
      -> Client n api
    hoistClient :: forall api (m :: Type -> Type) (n :: Type -> Type).
    HasClient ClientM api =>
    Proxy api -> (forall a. m a -> n a) -> Client m api -> Client n api
    hoistClient = Proxy ClientM
    -> Proxy api
    -> (forall a. m a -> n a)
    -> Client m api
    -> Client n api
    forall (m :: Type -> Type) api (mon :: Type -> Type)
           (mon' :: Type -> Type).
    HasClient m api =>
    Proxy m
    -> Proxy api
    -> (forall x. mon x -> mon' x)
    -> Client mon api
    -> Client mon' api
    forall (mon :: Type -> Type) (mon' :: Type -> Type).
    Proxy ClientM
    -> Proxy api
    -> (forall x. mon x -> mon' x)
    -> Client mon api
    -> Client mon' api
    hoistClientMonad (Proxy ClientM
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ClientM)

    -- | @ClientM@ is the monad in which client functions run. Contains the
    -- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
    newtype ClientM a = ClientM
      { forall a.
    ClientM a
    -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    unClientM :: ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a }
      deriving newtype ( (forall a b. (a -> b) -> ClientM a -> ClientM b)
    -> (forall a b. a -> ClientM b -> ClientM a) -> Functor ClientM
    forall a b. a -> ClientM b -> ClientM a
    forall a b. (a -> b) -> ClientM a -> ClientM b
    forall (f :: Type -> Type).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
    fmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
    $c<$ :: forall a b. a -> ClientM b -> ClientM a
    <$ :: forall a b. a -> ClientM b -> ClientM a
    Functor, Functor ClientM
    Functor ClientM =>
    (forall a. a -> ClientM a)
    -> (forall a b. ClientM (a -> b) -> ClientM a -> ClientM b)
    -> (forall a b c.
        (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c)
    -> (forall a b. ClientM a -> ClientM b -> ClientM b)
    -> (forall a b. ClientM a -> ClientM b -> ClientM a)
    -> Applicative ClientM
    forall a. a -> ClientM a
    forall a b. ClientM a -> ClientM b -> ClientM a
    forall a b. ClientM a -> ClientM b -> ClientM b
    forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
    forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM 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
    $cpure :: forall a. a -> ClientM a
    pure :: forall a. a -> ClientM a
    $c<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
    <*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
    $cliftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
    liftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
    $c*> :: forall a b. ClientM a -> ClientM b -> ClientM b
    *> :: forall a b. ClientM a -> ClientM b -> ClientM b
    $c<* :: forall a b. ClientM a -> ClientM b -> ClientM a
    <* :: forall a b. ClientM a -> ClientM b -> ClientM a
    Applicative, Applicative ClientM
    Applicative ClientM =>
    (forall a b. ClientM a -> (a -> ClientM b) -> ClientM b)
    -> (forall a b. ClientM a -> ClientM b -> ClientM b)
    -> (forall a. a -> ClientM a)
    -> Monad ClientM
    forall a. a -> ClientM a
    forall a b. ClientM a -> ClientM b -> ClientM b
    forall a b. ClientM a -> (a -> ClientM b) -> ClientM 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
    $c>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
    >>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
    $c>> :: forall a b. ClientM a -> ClientM b -> ClientM b
    >> :: forall a b. ClientM a -> ClientM b -> ClientM b
    $creturn :: forall a. a -> ClientM a
    return :: forall a. a -> ClientM a
    Monad, Monad ClientM
    Monad ClientM => (forall a. IO a -> ClientM a) -> MonadIO ClientM
    forall a. IO a -> ClientM a
    forall (m :: Type -> Type).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> ClientM a
    liftIO :: forall a. IO a -> ClientM a
    MonadIO, (forall x. ClientM a -> Rep (ClientM a) x)
    -> (forall x. Rep (ClientM a) x -> ClientM a)
    -> Generic (ClientM a)
    forall x. Rep (ClientM a) x -> ClientM a
    forall x. ClientM a -> Rep (ClientM a) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall a x. Rep (ClientM a) x -> ClientM a
    forall a x. ClientM a -> Rep (ClientM a) x
    $cfrom :: forall a x. ClientM a -> Rep (ClientM a) x
    from :: forall x. ClientM a -> Rep (ClientM a) x
    $cto :: forall a x. Rep (ClientM a) x -> ClientM a
    to :: forall x. Rep (ClientM a) x -> ClientM a
    Generic
               , MonadReader ClientEnv, MonadError ClientError)

    instance MonadBase IO ClientM where
      liftBase :: forall a. IO a -> ClientM a
    liftBase = ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α
    -> ClientM α
    forall a.
    ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    -> ClientM a
    ClientM (ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α
     -> ClientM α)
    -> (IO α
        -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α)
    -> IO α
    -> ClientM α
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO α -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α
    forall a.
    IO a -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO

    -- | Try clients in order, last error is preserved.
    instance Alt ClientM where
      ClientM a
    a <!> :: forall a. ClientM a -> ClientM a -> ClientM a
    <!> ClientM a
    b = ClientM a
    a ClientM a -> (ClientError -> ClientM a) -> ClientM a
    forall a. ClientM a -> (ClientError -> ClientM a) -> ClientM a
    forall e (m :: Type -> Type) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    `catchError` \ClientError
    _ -> ClientM a
    b

    instance RunClient ClientM where
      runRequestAcceptStatus :: Maybe [Status] -> Request -> ClientM Response
    runRequestAcceptStatus = Maybe [Status] -> Request -> ClientM Response
    performRequest
      throwClientError :: forall a. ClientError -> ClientM a
    throwClientError = ClientError -> ClientM a
    forall a. ClientError -> ClientM a
    forall e (m :: Type -> Type) a. MonadError e m => e -> m a
    throwError

    instance RunStreamingClient ClientM where
      withStreamingRequest :: forall a. Request -> (StreamingResponse -> IO a) -> ClientM a
    withStreamingRequest = Request -> (StreamingResponse -> IO a) -> ClientM a
    forall a. Request -> (StreamingResponse -> IO a) -> ClientM a
    performWithStreamingRequest

    withClientM :: ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
    withClientM :: forall a b.
    ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
    withClientM ClientM a
    cm ClientEnv
    env Either ClientError a -> IO b
    k =
        let Codensity forall b. (Either ClientError a -> IO b) -> IO b
    f = ExceptT ClientError (Codensity IO) a
    -> Codensity IO (Either ClientError a)
    forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT ClientError (Codensity IO) a
     -> Codensity IO (Either ClientError a))
    -> ExceptT ClientError (Codensity IO) a
    -> Codensity IO (Either ClientError a)
    forall a b. (a -> b) -> a -> b
    $ (ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
     -> ClientEnv -> ExceptT ClientError (Codensity IO) a)
    -> ClientEnv
    -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    -> ExceptT ClientError (Codensity IO) a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    -> ClientEnv -> ExceptT ClientError (Codensity IO) a
    forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
    runReaderT ClientEnv
    env (ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
     -> ExceptT ClientError (Codensity IO) a)
    -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    -> ExceptT ClientError (Codensity IO) a
    forall a b. (a -> b) -> a -> b
    $ ClientM a
    -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    forall a.
    ClientM a
    -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
    unClientM ClientM a
    cm
        in (Either ClientError a -> IO b) -> IO b
    forall b. (Either ClientError a -> IO b) -> IO b
    f Either ClientError a -> IO b
    k

    -- | A 'runClientM' variant for streaming client.
    --
    -- It allows using this module's 'ClientM' in a direct style.
    -- The 'NFData' constraint however prevents using this function with genuine
    -- streaming response types ('SourceT', 'Conduit', pipes 'Proxy' or 'Machine').
    -- For those you have to use 'withClientM'.
    --
    -- /Note:/ we 'force' the result, so the likelihood of accidentally leaking a
    -- connection is smaller. Use with care.
    --
    runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ClientError a)
    runClientM :: forall a.
    NFData a =>
    ClientM a -> ClientEnv -> IO (Either ClientError a)
    runClientM ClientM a
    cm ClientEnv
    env = ClientM a
    -> ClientEnv
    -> (Either ClientError a -> IO (Either ClientError a))
    -> IO (Either ClientError a)
    forall a b.
    ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
    withClientM ClientM a
    cm ClientEnv
    env (Either ClientError a -> IO (Either ClientError a)
    forall a. a -> IO a
    evaluate (Either ClientError a -> IO (Either ClientError a))
    -> (Either ClientError a -> Either ClientError a)
    -> Either ClientError a
    -> IO (Either ClientError a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either ClientError a -> Either ClientError a
    forall a. NFData a => a -> a
    force)

    performRequest :: Maybe [Status] -> Request -> ClientM Response
    performRequest :: Maybe [Status] -> Request -> ClientM Response
    performRequest Maybe [Status]
    acceptStatus Request
    req = do
        -- TODO: should use Client.withResponse here too
      ClientEnv m burl cookieJar' createClientRequest _ <- ClientM ClientEnv
    forall r (m :: Type -> Type). MonadReader r m => m r
    ask
      clientRequest <- liftIO $ createClientRequest burl req
      request <- case cookieJar' of
        Maybe (TVar CookieJar)
    Nothing -> Request -> ClientM Request
    forall a. a -> ClientM a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Request
    clientRequest
        Just TVar CookieJar
    cj -> IO Request -> ClientM Request
    forall a. IO a -> ClientM a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO Request -> ClientM Request) -> IO Request -> ClientM Request
    forall a b. (a -> b) -> a -> b
    $ do
          now <- IO UTCTime
    getCurrentTime
          atomically $ do
            oldCookieJar <- readTVar cj
            let (newRequest, newCookieJar) =
                  Client.insertCookiesIntoRequest
                    clientRequest
                    oldCookieJar
                    now
            writeTVar cj newCookieJar
            pure newRequest

      eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m
      case eResponse of
        Left ClientError
    err -> ClientError -> ClientM Response
    forall a. ClientError -> ClientM a
    forall e (m :: Type -> Type) a. MonadError e m => e -> m a
    throwError ClientError
    err
        Right Response ByteString
    response -> do
          Maybe (TVar CookieJar)
    -> (TVar CookieJar -> ClientM ()) -> ClientM ()
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe (TVar CookieJar)
    cookieJar' ((TVar CookieJar -> ClientM ()) -> ClientM ())
    -> (TVar CookieJar -> ClientM ()) -> ClientM ()
    forall a b. (a -> b) -> a -> b
    $ \TVar CookieJar
    cj -> IO () -> ClientM ()
    forall a. IO a -> ClientM a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
    forall a b. (a -> b) -> a -> b
    $ do
            now' <- IO UTCTime
    getCurrentTime
            atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
          let status :: Status
    status = Response ByteString -> Status
    forall body. Response body -> Status
    Client.responseStatus Response ByteString
    response
              ourResponse :: Response
    ourResponse = (ByteString -> ByteString) -> Response ByteString -> Response
    forall a b. (a -> b) -> Response a -> ResponseF b
    clientResponseToResponse ByteString -> ByteString
    forall a. a -> a
    id Response ByteString
    response
              goodStatus :: Bool
    goodStatus = case Maybe [Status]
    acceptStatus of
                Maybe [Status]
    Nothing -> Status -> Bool
    statusIsSuccessful Status
    status
                Just [Status]
    good -> Status
    status Status -> [Status] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    `elem` [Status]
    good
          Bool -> ClientM () -> ClientM ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    unless Bool
    goodStatus (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
    forall a b. (a -> b) -> a -> b
    $ do
            ClientError -> ClientM ()
    forall a. ClientError -> ClientM a
    forall e (m :: Type -> Type) a. MonadError e m => e -> m a
    throwError (ClientError -> ClientM ()) -> ClientError -> ClientM ()
    forall a b. (a -> b) -> a -> b
    $ BaseUrl -> Request -> Response -> ClientError
    mkFailureResponse BaseUrl
    burl Request
    req Response
    ourResponse
          Response -> ClientM Response
    forall a. a -> ClientM a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Response
    ourResponse

    -- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
    performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
    performWithStreamingRequest :: forall a. Request -> (StreamingResponse -> IO a) -> ClientM a
    performWithStreamingRequest Request
    req StreamingResponse -> IO a
    k = do
      ClientEnv m burl cookieJar' createClientRequest _ <- ClientM ClientEnv
    forall r (m :: Type -> Type). MonadReader r m => m r
    ask
      clientRequest <- liftIO $ createClientRequest burl req
      request <- case cookieJar' of
        Maybe (TVar CookieJar)
    Nothing -> Request -> ClientM Request
    forall a. a -> ClientM a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure Request
    clientRequest
        Just TVar CookieJar
    cj -> IO Request -> ClientM Request
    forall a. IO a -> ClientM a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO Request -> ClientM Request) -> IO Request -> ClientM Request
    forall a b. (a -> b) -> a -> b
    $ do
          now <- IO UTCTime
    getCurrentTime
          atomically $ do
            oldCookieJar <- readTVar cj
            let (newRequest, newCookieJar) =
                  Client.insertCookiesIntoRequest
                    clientRequest
                    oldCookieJar
                    now
            writeTVar cj newCookieJar
            pure newRequest
      ClientM $ lift $ lift $ Codensity $ \a -> IO b
    k1 ->
          Request -> Manager -> (Response BodyReader -> IO b) -> IO b
    forall a.
    Request -> Manager -> (Response BodyReader -> IO a) -> IO a
    Client.withResponse Request
    request Manager
    m ((Response BodyReader -> IO b) -> IO b)
    -> (Response BodyReader -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \Response BodyReader
    res -> do
              let status :: Status
    status = Response BodyReader -> Status
    forall body. Response body -> Status
    Client.responseStatus Response BodyReader
    res

              -- we throw FailureResponse in IO :(
              Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    unless (Status -> Bool
    statusIsSuccessful Status
    status) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                  b <- [StrictByteString] -> ByteString
    BSL.fromChunks ([StrictByteString] -> ByteString)
    -> IO [StrictByteString] -> IO ByteString
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> BodyReader -> IO [StrictByteString]
    Client.brConsume (Response BodyReader -> BodyReader
    forall body. Response body -> body
    Client.responseBody Response BodyReader
    res)
                  throwIO $ mkFailureResponse burl req (clientResponseToResponse (const b) res)

              x <- StreamingResponse -> IO a
    k ((BodyReader -> SourceIO StrictByteString)
    -> Response BodyReader -> StreamingResponse
    forall a b. (a -> b) -> Response a -> ResponseF b
    clientResponseToResponse ((StrictByteString -> Bool)
    -> BodyReader -> SourceIO StrictByteString
    forall (m :: Type -> Type) a.
    Functor m =>
    (a -> Bool) -> m a -> SourceT m a
    S.fromAction StrictByteString -> Bool
    BS.null) Response BodyReader
    res)
              k1 x