{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Effectful.HTTP.Client.Static
  ( -- * Effect
    Network,

    -- ** Handlers
    runNetwork,

    -- * Manager
    newManager,

    -- ** TLS
    newTlsManager,
    newTlsManagerWith,
    applyDigestAuth,

    -- * Queries
    BodyReader,
    withResponse,
    withResponseHistory,

    -- * Consumers
    brRead,
    brReadSome,
    brConsume,

    -- * Helpers
    readResponseJson,
    readResponseUtf8,
    readResponse,

    -- * Exceptions
    NetworkStatusE (..),
    NetworkReadBodyE (..),
    NetworkDecodeUtf8E (..),
    NetworkDecodeJsonE (..),

    -- * Re-exports
    ManagerSettings,
    Manager,
    Request,
    Response,
  )
where

import Control.Monad.Catch (MonadThrow)
import Data.Aeson (FromJSON)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (LazyByteString)
import Data.Text (Text)
import Effectful
  ( Dispatch (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    seqUnliftIO,
    unsafeEff,
    unsafeEff_,
  )
import Effectful.HTTP.Client.Internal
  ( NetworkDecodeJsonE (MkNetworkDecodeJsonE),
    NetworkDecodeUtf8E (MkNetworkDecodeUtf8E),
    NetworkReadBodyE (MkNetworkReadBodyE),
    NetworkStatusE (MkNetworkStatusE),
  )
import Effectful.HTTP.Client.Internal qualified as Internal
import Network.HTTP.Client
  ( HistoriedResponse,
    Manager,
    ManagerSettings,
    Request,
    Response,
  )
import Network.HTTP.Client qualified as HttpClient
import Network.HTTP.Client.TLS qualified as TLS

-- | Static network effect.
--
-- @since 0.1
data Network :: Effect

-- | @since 0.1
type instance DispatchOf Network = Static WithSideEffects

-- | @since 0.1
data instance StaticRep Network = MkNetwork

-- | @since 0.1
type BodyReader m = m ByteString

-- | Runs 'Network' in 'IOE'.
--
-- @since 0.1
runNetwork ::
  forall a es.
  ( HasCallStack,
    IOE :> es
  ) =>
  -- | .
  Eff (Network : es) a ->
  Eff es a
runNetwork :: forall a (es :: [Effect]).
(HasCallStack, IOE :> es) =>
Eff (Network : es) a -> Eff es a
runNetwork = StaticRep Network -> Eff (Network : 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 Network
MkNetwork

-- | @since 0.1
newManager ::
  forall es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  ManagerSettings ->
  Eff es Manager
newManager :: forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
ManagerSettings -> Eff es Manager
newManager = IO Manager -> Eff es Manager
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Manager -> Eff es Manager)
-> (ManagerSettings -> IO Manager)
-> ManagerSettings
-> Eff es Manager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagerSettings -> IO Manager
HttpClient.newManager

-- | @since 0.1
newTlsManager ::
  forall es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  Eff es Manager
newTlsManager :: forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
Eff es Manager
newTlsManager = IO Manager -> Eff es Manager
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO Manager
forall (m :: * -> *). MonadIO m => m Manager
TLS.newTlsManager

-- | @since 0.1
newTlsManagerWith ::
  forall es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  ManagerSettings ->
  Eff es Manager
newTlsManagerWith :: forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
ManagerSettings -> Eff es Manager
newTlsManagerWith = IO Manager -> Eff es Manager
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Manager -> Eff es Manager)
-> (ManagerSettings -> IO Manager)
-> ManagerSettings
-> Eff es Manager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagerSettings -> IO Manager
forall (m :: * -> *). MonadIO m => ManagerSettings -> m Manager
TLS.newTlsManagerWith

-- | @since 0.1
applyDigestAuth ::
  forall n es.
  ( HasCallStack,
    MonadThrow n,
    Network :> es
  ) =>
  -- | .
  ByteString ->
  ByteString ->
  Request ->
  Manager ->
  Eff es (n Request)
applyDigestAuth :: forall (n :: * -> *) (es :: [Effect]).
(HasCallStack, MonadThrow n, Network :> es) =>
ByteString
-> ByteString -> Request -> Manager -> Eff es (n Request)
applyDigestAuth ByteString
b1 ByteString
b2 Request
r = IO (n Request) -> Eff es (n Request)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (n Request) -> Eff es (n Request))
-> (Manager -> IO (n Request)) -> Manager -> Eff es (n Request)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Request -> Manager -> IO (n Request)
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadThrow n) =>
ByteString -> ByteString -> Request -> Manager -> m (n Request)
TLS.applyDigestAuth ByteString
b1 ByteString
b2 Request
r

-- | @since 0.1
withResponse ::
  forall a es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  Request ->
  Manager ->
  (Response (BodyReader (Eff es)) -> Eff es a) ->
  Eff es a
withResponse :: forall a (es :: [Effect]).
(HasCallStack, Network :> es) =>
Request
-> Manager
-> (Response (BodyReader (Eff es)) -> Eff es a)
-> Eff es a
withResponse Request
req Manager
manager Response (BodyReader (Eff es)) -> Eff es a
onResponse =
  (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
unlift ->
      Request -> Manager -> (Response BodyReader -> IO a) -> IO a
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
HttpClient.withResponse
        Request
req
        Manager
manager
        (Eff es a -> IO a
forall r. Eff es r -> IO r
unlift (Eff es a -> IO a)
-> (Response BodyReader -> Eff es a) -> Response BodyReader -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (BodyReader (Eff es)) -> Eff es a
onResponse (Response (BodyReader (Eff es)) -> Eff es a)
-> (Response BodyReader -> Response (BodyReader (Eff es)))
-> Response BodyReader
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyReader -> BodyReader (Eff es))
-> Response BodyReader -> Response (BodyReader (Eff es))
forall a b. (a -> b) -> Response a -> Response b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BodyReader -> BodyReader (Eff es)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_)

-- | @since 0.1
withResponseHistory ::
  forall a es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  Request ->
  Manager ->
  (HistoriedResponse (BodyReader (Eff es)) -> Eff es a) ->
  Eff es a
withResponseHistory :: forall a (es :: [Effect]).
(HasCallStack, Network :> es) =>
Request
-> Manager
-> (HistoriedResponse (BodyReader (Eff es)) -> Eff es a)
-> Eff es a
withResponseHistory Request
req Manager
manager HistoriedResponse (BodyReader (Eff es)) -> Eff es a
onResponse =
  (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
unlift ->
      Request
-> Manager -> (HistoriedResponse BodyReader -> IO a) -> IO a
forall a.
Request
-> Manager -> (HistoriedResponse BodyReader -> IO a) -> IO a
HttpClient.withResponseHistory
        Request
req
        Manager
manager
        (Eff es a -> IO a
forall r. Eff es r -> IO r
unlift (Eff es a -> IO a)
-> (HistoriedResponse BodyReader -> Eff es a)
-> HistoriedResponse BodyReader
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistoriedResponse (BodyReader (Eff es)) -> Eff es a
onResponse (HistoriedResponse (BodyReader (Eff es)) -> Eff es a)
-> (HistoriedResponse BodyReader
    -> HistoriedResponse (BodyReader (Eff es)))
-> HistoriedResponse BodyReader
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyReader -> BodyReader (Eff es))
-> HistoriedResponse BodyReader
-> HistoriedResponse (BodyReader (Eff es))
forall a b. (a -> b) -> HistoriedResponse a -> HistoriedResponse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BodyReader -> BodyReader (Eff es)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_)

-- | @since 0.1
brRead ::
  forall es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  BodyReader (Eff es) ->
  Eff es ByteString
brRead :: forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
BodyReader (Eff es) -> BodyReader (Eff es)
brRead BodyReader (Eff es)
br = (Env es -> BodyReader) -> BodyReader (Eff es)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> BodyReader) -> BodyReader (Eff es))
-> (Env es -> BodyReader) -> BodyReader (Eff es)
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es
-> ((forall r. Eff es r -> IO r) -> BodyReader) -> BodyReader
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> BodyReader) -> BodyReader)
-> ((forall r. Eff es r -> IO r) -> BodyReader) -> BodyReader
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift ->
  BodyReader -> BodyReader
HttpClient.brRead (BodyReader (Eff es) -> BodyReader
forall r. Eff es r -> IO r
unlift BodyReader (Eff es)
br)

-- | @since 0.1
brReadSome ::
  forall es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  BodyReader (Eff es) ->
  Int ->
  Eff es LazyByteString
brReadSome :: forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
BodyReader (Eff es) -> Int -> Eff es LazyByteString
brReadSome BodyReader (Eff es)
br Int
n = (Env es -> IO LazyByteString) -> Eff es LazyByteString
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO LazyByteString) -> Eff es LazyByteString)
-> (Env es -> IO LazyByteString) -> Eff es LazyByteString
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es
-> ((forall r. Eff es r -> IO r) -> IO LazyByteString)
-> IO LazyByteString
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO LazyByteString)
 -> IO LazyByteString)
-> ((forall r. Eff es r -> IO r) -> IO LazyByteString)
-> IO LazyByteString
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift ->
  BodyReader -> Int -> IO LazyByteString
HttpClient.brReadSome (BodyReader (Eff es) -> BodyReader
forall r. Eff es r -> IO r
unlift BodyReader (Eff es)
br) Int
n

-- | @since 0.1
brConsume ::
  forall es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | .
  BodyReader (Eff es) ->
  Eff es [ByteString]
brConsume :: forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
BodyReader (Eff es) -> Eff es [ByteString]
brConsume BodyReader (Eff es)
br = (Env es -> IO [ByteString]) -> Eff es [ByteString]
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO [ByteString]) -> Eff es [ByteString])
-> (Env es -> IO [ByteString]) -> Eff es [ByteString]
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es
-> ((forall r. Eff es r -> IO r) -> IO [ByteString])
-> IO [ByteString]
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO [ByteString])
 -> IO [ByteString])
-> ((forall r. Eff es r -> IO r) -> IO [ByteString])
-> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift ->
  BodyReader -> IO [ByteString]
HttpClient.brConsume (BodyReader (Eff es) -> BodyReader
forall r. Eff es r -> IO r
unlift BodyReader (Eff es)
br)

-- | Helper for reading a response, checking for status 200 and exceptions
-- thrown by the consumer.
--
-- @since 0.1
readResponse ::
  forall a es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | String url.
  String ->
  -- | Response.
  Response (BodyReader (Eff es)) ->
  -- | Consumer.
  (BodyReader (Eff es) -> Eff es a) ->
  Eff es a
readResponse :: forall a (es :: [Effect]).
(HasCallStack, Network :> es) =>
String
-> Response (BodyReader (Eff es))
-> (BodyReader (Eff es) -> Eff es a)
-> Eff es a
readResponse = String
-> Response (BodyReader (Eff es))
-> (BodyReader (Eff es) -> Eff es a)
-> Eff es a
forall br (es :: [Effect]) a.
HasCallStack =>
String -> Response br -> (br -> Eff es a) -> Eff es a
Internal.readResponse

-- | Helper for reading a response, decoding to UTF-8.
--
-- @since 0.1
readResponseUtf8 ::
  forall es.
  ( HasCallStack,
    Network :> es
  ) =>
  -- | String url.
  String ->
  -- | Response.
  Response (BodyReader (Eff es)) ->
  Eff es Text
readResponseUtf8 :: forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
String -> Response (BodyReader (Eff es)) -> Eff es Text
readResponseUtf8 String
url Response (BodyReader (Eff es))
res =
  String
-> Response (BodyReader (Eff es))
-> (BodyReader (Eff es) -> Eff es [ByteString])
-> Eff es [ByteString]
forall a (es :: [Effect]).
(HasCallStack, Network :> es) =>
String
-> Response (BodyReader (Eff es))
-> (BodyReader (Eff es) -> Eff es a)
-> Eff es a
readResponse String
url Response (BodyReader (Eff es))
res BodyReader (Eff es) -> Eff es [ByteString]
forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
BodyReader (Eff es) -> Eff es [ByteString]
brConsume Eff es [ByteString] -> ([ByteString] -> Eff es Text) -> Eff es Text
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> Eff es Text
forall (es :: [Effect]).
HasCallStack =>
[ByteString] -> Eff es Text
Internal.decodeUtf8

-- | Helper for reading a response, decoding JSON.
readResponseJson ::
  forall a es.
  ( FromJSON a,
    HasCallStack,
    Network :> es
  ) =>
  -- | String url.
  String ->
  -- | Response.
  Response (BodyReader (Eff es)) ->
  Eff es a
readResponseJson :: forall a (es :: [Effect]).
(FromJSON a, HasCallStack, Network :> es) =>
String -> Response (BodyReader (Eff es)) -> Eff es a
readResponseJson String
url Response (BodyReader (Eff es))
res =
  String
-> Response (BodyReader (Eff es))
-> (BodyReader (Eff es) -> Eff es [ByteString])
-> Eff es [ByteString]
forall a (es :: [Effect]).
(HasCallStack, Network :> es) =>
String
-> Response (BodyReader (Eff es))
-> (BodyReader (Eff es) -> Eff es a)
-> Eff es a
readResponse String
url Response (BodyReader (Eff es))
res BodyReader (Eff es) -> Eff es [ByteString]
forall (es :: [Effect]).
(HasCallStack, Network :> es) =>
BodyReader (Eff es) -> Eff es [ByteString]
brConsume Eff es [ByteString] -> ([ByteString] -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> Eff es a
forall a (es :: [Effect]).
(FromJSON a, HasCallStack) =>
[ByteString] -> Eff es a
Internal.decodeJson