{-# LANGUAGE UndecidableInstances #-}

module Mensam.Client.Application.HttpClient where

import Mensam.Client.Application.HttpClient.Class

import Control.Monad.Logger.CallStack
import Control.Monad.Trans
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Identity
import Control.Monad.Trans.Reader
import Data.Kind
import Network.HTTP.Client qualified as Network
import Network.HTTP.Client.TLS qualified as Network

type HttpClientT :: (Type -> Type) -> Type -> Type
newtype HttpClientT m a = MkHttpClientT {forall (m :: * -> *) a. HttpClientT m a -> ReaderT Manager m a
unHttpClientT :: ReaderT Network.Manager m a}
  deriving newtype (Functor (HttpClientT m)
Functor (HttpClientT m) =>
(forall a. a -> HttpClientT m a)
-> (forall a b.
    HttpClientT m (a -> b) -> HttpClientT m a -> HttpClientT m b)
-> (forall a b c.
    (a -> b -> c)
    -> HttpClientT m a -> HttpClientT m b -> HttpClientT m c)
-> (forall a b.
    HttpClientT m a -> HttpClientT m b -> HttpClientT m b)
-> (forall a b.
    HttpClientT m a -> HttpClientT m b -> HttpClientT m a)
-> Applicative (HttpClientT m)
forall a. a -> HttpClientT m a
forall a b. HttpClientT m a -> HttpClientT m b -> HttpClientT m a
forall a b. HttpClientT m a -> HttpClientT m b -> HttpClientT m b
forall a b.
HttpClientT m (a -> b) -> HttpClientT m a -> HttpClientT m b
forall a b c.
(a -> b -> c)
-> HttpClientT m a -> HttpClientT m b -> HttpClientT m c
forall (f :: * -> *).
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 :: * -> *). Applicative m => Functor (HttpClientT m)
forall (m :: * -> *) a. Applicative m => a -> HttpClientT m a
forall (m :: * -> *) a b.
Applicative m =>
HttpClientT m a -> HttpClientT m b -> HttpClientT m a
forall (m :: * -> *) a b.
Applicative m =>
HttpClientT m a -> HttpClientT m b -> HttpClientT m b
forall (m :: * -> *) a b.
Applicative m =>
HttpClientT m (a -> b) -> HttpClientT m a -> HttpClientT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> HttpClientT m a -> HttpClientT m b -> HttpClientT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> HttpClientT m a
pure :: forall a. a -> HttpClientT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
HttpClientT m (a -> b) -> HttpClientT m a -> HttpClientT m b
<*> :: forall a b.
HttpClientT m (a -> b) -> HttpClientT m a -> HttpClientT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> HttpClientT m a -> HttpClientT m b -> HttpClientT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> HttpClientT m a -> HttpClientT m b -> HttpClientT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
HttpClientT m a -> HttpClientT m b -> HttpClientT m b
*> :: forall a b. HttpClientT m a -> HttpClientT m b -> HttpClientT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
HttpClientT m a -> HttpClientT m b -> HttpClientT m a
<* :: forall a b. HttpClientT m a -> HttpClientT m b -> HttpClientT m a
Applicative, (forall a b. (a -> b) -> HttpClientT m a -> HttpClientT m b)
-> (forall a b. a -> HttpClientT m b -> HttpClientT m a)
-> Functor (HttpClientT m)
forall a b. a -> HttpClientT m b -> HttpClientT m a
forall a b. (a -> b) -> HttpClientT m a -> HttpClientT m b
forall (m :: * -> *) a b.
Functor m =>
a -> HttpClientT m b -> HttpClientT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HttpClientT m a -> HttpClientT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HttpClientT m a -> HttpClientT m b
fmap :: forall a b. (a -> b) -> HttpClientT m a -> HttpClientT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> HttpClientT m b -> HttpClientT m a
<$ :: forall a b. a -> HttpClientT m b -> HttpClientT m a
Functor, Applicative (HttpClientT m)
Applicative (HttpClientT m) =>
(forall a b.
 HttpClientT m a -> (a -> HttpClientT m b) -> HttpClientT m b)
-> (forall a b.
    HttpClientT m a -> HttpClientT m b -> HttpClientT m b)
-> (forall a. a -> HttpClientT m a)
-> Monad (HttpClientT m)
forall a. a -> HttpClientT m a
forall a b. HttpClientT m a -> HttpClientT m b -> HttpClientT m b
forall a b.
HttpClientT m a -> (a -> HttpClientT m b) -> HttpClientT m b
forall (m :: * -> *). Monad m => Applicative (HttpClientT m)
forall (m :: * -> *) a. Monad m => a -> HttpClientT m a
forall (m :: * -> *) a b.
Monad m =>
HttpClientT m a -> HttpClientT m b -> HttpClientT m b
forall (m :: * -> *) a b.
Monad m =>
HttpClientT m a -> (a -> HttpClientT m b) -> HttpClientT m b
forall (m :: * -> *).
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 (m :: * -> *) a b.
Monad m =>
HttpClientT m a -> (a -> HttpClientT m b) -> HttpClientT m b
>>= :: forall a b.
HttpClientT m a -> (a -> HttpClientT m b) -> HttpClientT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
HttpClientT m a -> HttpClientT m b -> HttpClientT m b
>> :: forall a b. HttpClientT m a -> HttpClientT m b -> HttpClientT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> HttpClientT m a
return :: forall a. a -> HttpClientT m a
Monad)
  deriving newtype ((forall (m :: * -> *). Monad m => Monad (HttpClientT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> HttpClientT m a)
-> MonadTrans HttpClientT
forall (m :: * -> *). Monad m => Monad (HttpClientT m)
forall (m :: * -> *) a. Monad m => m a -> HttpClientT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> HttpClientT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> HttpClientT m a
MonadTrans, MonadTrans HttpClientT
MonadTrans HttpClientT =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run HttpClientT -> m a) -> HttpClientT m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT HttpClientT a) -> HttpClientT m a)
-> MonadTransControl HttpClientT
forall (m :: * -> *) a.
Monad m =>
m (StT HttpClientT a) -> HttpClientT m a
forall (m :: * -> *) a.
Monad m =>
(Run HttpClientT -> m a) -> HttpClientT m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run HttpClientT -> m a) -> HttpClientT m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run HttpClientT -> m a) -> HttpClientT m a
$crestoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT HttpClientT a) -> HttpClientT m a
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT HttpClientT a) -> HttpClientT m a
MonadTransControl, MonadTransControl HttpClientT
MonadTransControl HttpClientT =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. HttpClientT m x -> m x) -> m a) -> HttpClientT m a)
-> MonadTransControlIdentity HttpClientT
forall (m :: * -> *) a.
Monad m =>
((forall x. HttpClientT m x -> m x) -> m a) -> HttpClientT m a
forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. t m x -> m x) -> m a) -> t m a)
-> MonadTransControlIdentity t
$cliftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. HttpClientT m x -> m x) -> m a) -> HttpClientT m a
liftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. HttpClientT m x -> m x) -> m a) -> HttpClientT m a
MonadTransControlIdentity)

instance Monad m => MonadHttpClient (HttpClientT m) where
  httpManager :: HttpClientT m Manager
httpManager = ReaderT Manager m Manager -> HttpClientT m Manager
forall (m :: * -> *) a. ReaderT Manager m a -> HttpClientT m a
MkHttpClientT ReaderT Manager m Manager
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

deriving via
  HttpClientT ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
    Monad (t2 m) => MonadHttpClient (ComposeT HttpClientT t2 m)

runHttpClientT :: HttpClientT m a -> Network.Manager -> m a
runHttpClientT :: forall (m :: * -> *) a. HttpClientT m a -> Manager -> m a
runHttpClientT = ReaderT Manager m a -> Manager -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT Manager m a -> Manager -> m a)
-> (HttpClientT m a -> ReaderT Manager m a)
-> HttpClientT m a
-> Manager
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpClientT m a -> ReaderT Manager m a
forall (m :: * -> *) a. HttpClientT m a -> ReaderT Manager m a
unHttpClientT

runAppHttpClientT ::
  (MonadIO m, MonadLogger m) =>
  HttpClientT m a ->
  m a
runAppHttpClientT :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m) =>
HttpClientT m a -> m a
runAppHttpClientT HttpClientT m a
tma = do
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Creating new HTTP manager."
  Manager
manager <- IO Manager -> m Manager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> m Manager) -> IO Manager -> m Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
Network.newManager ManagerSettings
Network.tlsManagerSettings
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created new HTTP manager."
  HttpClientT m a -> Manager -> m a
forall (m :: * -> *) a. HttpClientT m a -> Manager -> m a
runHttpClientT HttpClientT m a
tma Manager
manager