{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-
   Generative Language API

   The Gemini API allows developers to build generative AI applications using Gemini models. Gemini is our most capable model, built from the ground up to be multimodal. It can generalize and seamlessly understand, operate across, and combine different types of information including language, images, audio, video, and code. You can use the Gemini API for use cases like reasoning across text and images, content generation, dialogue agents, summarization and classification systems, and more.

   OpenAPI Version: 3.0.3
   Generative Language API API version: v1beta
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

{- |
Module : GenAI.Client.Client
-}
module GenAI.Client.Client where

import GenAI.Client.Core
import GenAI.Client.Logging
import GenAI.Client.MimeTypes

import Control.Exception.Safe qualified as E
import Control.Monad qualified as P
import Control.Monad.IO.Class qualified as P
import Data.Aeson.Types qualified as A
import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as BC
import Data.ByteString.Lazy qualified as BL
import Data.ByteString.Lazy.Char8 qualified as BCL
import Data.Proxy qualified as P (Proxy (..))
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Network.HTTP.Client qualified as NH
import Network.HTTP.Client.MultipartFormData qualified as NH
import Network.HTTP.Types qualified as NH
import Web.FormUrlEncoded qualified as WH
import Web.HttpApiData qualified as WH

import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import GHC.Exts (IsString (..))

-- * Dispatch

-- ** Lbs

-- | send a request returning the raw http response
dispatchLbs ::
  (Produces req accept, MimeType contentType) =>
  -- | http-client Connection manager
  NH.Manager ->
  -- | config
  GenAIClientConfig ->
  -- | request
  ClientRequest req contentType res accept ->
  -- | response
  IO (NH.Response BCL.ByteString)
dispatchLbs :: forall {k} {k2} (req :: k) accept contentType (res :: k2).
(Produces req accept, MimeType contentType) =>
Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager GenAIClientConfig
config ClientRequest req contentType res accept
request = do
  InitRequest req contentType res accept
initReq <- GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall {k} {k} accept contentType (req :: k) (res :: k).
(MimeType accept, MimeType contentType) =>
GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest GenAIClientConfig
config ClientRequest req contentType res accept
request
  Manager
-> GenAIClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
Manager
-> GenAIClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager GenAIClientConfig
config InitRequest req contentType res accept
initReq

-- ** Mime

-- | pair of decoded http body and http response
data MimeResult res
  = MimeResult
  { forall res. MimeResult res -> Either MimeError res
mimeResult :: Either MimeError res
  -- ^ decoded http body
  , forall res. MimeResult res -> Response ByteString
mimeResultResponse :: NH.Response BCL.ByteString
  -- ^ http response
  }
  deriving (Int -> MimeResult res -> ShowS
[MimeResult res] -> ShowS
MimeResult res -> String
(Int -> MimeResult res -> ShowS)
-> (MimeResult res -> String)
-> ([MimeResult res] -> ShowS)
-> Show (MimeResult res)
forall res. Show res => Int -> MimeResult res -> ShowS
forall res. Show res => [MimeResult res] -> ShowS
forall res. Show res => MimeResult res -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall res. Show res => Int -> MimeResult res -> ShowS
showsPrec :: Int -> MimeResult res -> ShowS
$cshow :: forall res. Show res => MimeResult res -> String
show :: MimeResult res -> String
$cshowList :: forall res. Show res => [MimeResult res] -> ShowS
showList :: [MimeResult res] -> ShowS
Show, (forall a b. (a -> b) -> MimeResult a -> MimeResult b)
-> (forall a b. a -> MimeResult b -> MimeResult a)
-> Functor MimeResult
forall a b. a -> MimeResult b -> MimeResult a
forall a b. (a -> b) -> MimeResult a -> MimeResult b
forall (f :: * -> *).
(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) -> MimeResult a -> MimeResult b
fmap :: forall a b. (a -> b) -> MimeResult a -> MimeResult b
$c<$ :: forall a b. a -> MimeResult b -> MimeResult a
<$ :: forall a b. a -> MimeResult b -> MimeResult a
Functor, (forall m. Monoid m => MimeResult m -> m)
-> (forall m a. Monoid m => (a -> m) -> MimeResult a -> m)
-> (forall m a. Monoid m => (a -> m) -> MimeResult a -> m)
-> (forall a b. (a -> b -> b) -> b -> MimeResult a -> b)
-> (forall a b. (a -> b -> b) -> b -> MimeResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> MimeResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> MimeResult a -> b)
-> (forall a. (a -> a -> a) -> MimeResult a -> a)
-> (forall a. (a -> a -> a) -> MimeResult a -> a)
-> (forall a. MimeResult a -> [a])
-> (forall a. MimeResult a -> Bool)
-> (forall a. MimeResult a -> Int)
-> (forall a. Eq a => a -> MimeResult a -> Bool)
-> (forall a. Ord a => MimeResult a -> a)
-> (forall a. Ord a => MimeResult a -> a)
-> (forall a. Num a => MimeResult a -> a)
-> (forall a. Num a => MimeResult a -> a)
-> Foldable MimeResult
forall a. Eq a => a -> MimeResult a -> Bool
forall a. Num a => MimeResult a -> a
forall a. Ord a => MimeResult a -> a
forall m. Monoid m => MimeResult m -> m
forall a. MimeResult a -> Bool
forall a. MimeResult a -> Int
forall a. MimeResult a -> [a]
forall a. (a -> a -> a) -> MimeResult a -> a
forall m a. Monoid m => (a -> m) -> MimeResult a -> m
forall b a. (b -> a -> b) -> b -> MimeResult a -> b
forall a b. (a -> b -> b) -> b -> MimeResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => MimeResult m -> m
fold :: forall m. Monoid m => MimeResult m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
$ctoList :: forall a. MimeResult a -> [a]
toList :: forall a. MimeResult a -> [a]
$cnull :: forall a. MimeResult a -> Bool
null :: forall a. MimeResult a -> Bool
$clength :: forall a. MimeResult a -> Int
length :: forall a. MimeResult a -> Int
$celem :: forall a. Eq a => a -> MimeResult a -> Bool
elem :: forall a. Eq a => a -> MimeResult a -> Bool
$cmaximum :: forall a. Ord a => MimeResult a -> a
maximum :: forall a. Ord a => MimeResult a -> a
$cminimum :: forall a. Ord a => MimeResult a -> a
minimum :: forall a. Ord a => MimeResult a -> a
$csum :: forall a. Num a => MimeResult a -> a
sum :: forall a. Num a => MimeResult a -> a
$cproduct :: forall a. Num a => MimeResult a -> a
product :: forall a. Num a => MimeResult a -> a
Foldable, Functor MimeResult
Foldable MimeResult
(Functor MimeResult, Foldable MimeResult) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> MimeResult a -> f (MimeResult b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MimeResult (f a) -> f (MimeResult a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MimeResult a -> m (MimeResult b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MimeResult (m a) -> m (MimeResult a))
-> Traversable MimeResult
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
sequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
Traversable)

-- | pair of unrender/parser error and http response
data MimeError
  = MimeError
  { MimeError -> String
mimeError :: String
  -- ^ unrender/parser error
  , MimeError -> Response ByteString
mimeErrorResponse :: NH.Response BCL.ByteString
  -- ^ http response
  }
  deriving (Int -> MimeError -> ShowS
[MimeError] -> ShowS
MimeError -> String
(Int -> MimeError -> ShowS)
-> (MimeError -> String)
-> ([MimeError] -> ShowS)
-> Show MimeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MimeError -> ShowS
showsPrec :: Int -> MimeError -> ShowS
$cshow :: MimeError -> String
show :: MimeError -> String
$cshowList :: [MimeError] -> ShowS
showList :: [MimeError] -> ShowS
Show)

-- | send a request returning the 'MimeResult'
dispatchMime ::
  forall req contentType res accept.
  (Produces req accept, MimeUnrender accept res, MimeType contentType) =>
  -- | http-client Connection manager
  NH.Manager ->
  -- | config
  GenAIClientConfig ->
  -- | request
  ClientRequest req contentType res accept ->
  -- | response
  IO (MimeResult res)
dispatchMime :: forall {k} (req :: k) contentType res accept.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager GenAIClientConfig
config ClientRequest req contentType res accept
request = do
  Response ByteString
httpResponse <- Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (Response ByteString)
forall {k} {k2} (req :: k) accept contentType (res :: k2).
(Produces req accept, MimeType contentType) =>
Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager GenAIClientConfig
config ClientRequest req contentType res accept
request
  let statusCode :: Int
statusCode = Status -> Int
NH.statusCode (Status -> Int)
-> (Response ByteString -> Status) -> Response ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> Status
forall body. Response body -> Status
NH.responseStatus (Response ByteString -> Int) -> Response ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString
httpResponse
  Either MimeError res
parsedResult <-
    Text -> GenAIClientConfig -> LogExec IO (Either MimeError res)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> GenAIClientConfig -> LogExec m a
runConfigLogWithExceptions Text
"Client" GenAIClientConfig
config LogExec IO (Either MimeError res)
-> LogExec IO (Either MimeError res)
forall a b. (a -> b) -> a -> b
$
      do
        if (Int
statusCode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
statusCode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
600)
          then do
            let s :: String
s = String
"error statusCode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
statusCode
            Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
            Either MimeError res -> LoggingT IO (Either MimeError res)
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MimeError -> Either MimeError res
forall a b. a -> Either a b
Left (String -> Response ByteString -> MimeError
MimeError String
s Response ByteString
httpResponse))
          else case Proxy accept -> ByteString -> Either String res
forall mtype o.
MimeUnrender mtype o =>
Proxy mtype -> ByteString -> Either String o
mimeUnrender (Proxy accept
forall {k} (t :: k). Proxy t
P.Proxy :: P.Proxy accept) (Response ByteString -> ByteString
forall body. Response body -> body
NH.responseBody Response ByteString
httpResponse) of
            Left String
s -> do
              Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
              Either MimeError res -> LoggingT IO (Either MimeError res)
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MimeError -> Either MimeError res
forall a b. a -> Either a b
Left (String -> Response ByteString -> MimeError
MimeError String
s Response ByteString
httpResponse))
            Right res
r -> Either MimeError res -> LoggingT IO (Either MimeError res)
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (res -> Either MimeError res
forall a b. b -> Either a b
Right res
r)
  MimeResult res -> IO (MimeResult res)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MimeError res -> Response ByteString -> MimeResult res
forall res.
Either MimeError res -> Response ByteString -> MimeResult res
MimeResult Either MimeError res
parsedResult Response ByteString
httpResponse)

-- | like 'dispatchMime', but only returns the decoded http body
dispatchMime' ::
  (Produces req accept, MimeUnrender accept res, MimeType contentType) =>
  -- | http-client Connection manager
  NH.Manager ->
  -- | config
  GenAIClientConfig ->
  -- | request
  ClientRequest req contentType res accept ->
  -- | response
  IO (Either MimeError res)
dispatchMime' :: forall {k} (req :: k) accept res contentType.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (Either MimeError res)
dispatchMime' Manager
manager GenAIClientConfig
config ClientRequest req contentType res accept
request = do
  MimeResult Either MimeError res
parsedResult Response ByteString
_ <- Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (MimeResult res)
forall {k} (req :: k) contentType res accept.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager GenAIClientConfig
config ClientRequest req contentType res accept
request
  Either MimeError res -> IO (Either MimeError res)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either MimeError res
parsedResult

-- ** Unsafe

-- | like 'dispatchReqLbs', but does not validate the operation is a 'Producer' of the "accept" 'MimeType'.  (Useful if the server's response is undocumented)
dispatchLbsUnsafe ::
  (MimeType accept, MimeType contentType) =>
  -- | http-client Connection manager
  NH.Manager ->
  -- | config
  GenAIClientConfig ->
  -- | request
  ClientRequest req contentType res accept ->
  -- | response
  IO (NH.Response BCL.ByteString)
dispatchLbsUnsafe :: forall {k} {k2} accept contentType (req :: k) (res :: k2).
(MimeType accept, MimeType contentType) =>
Manager
-> GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbsUnsafe Manager
manager GenAIClientConfig
config ClientRequest req contentType res accept
request = do
  InitRequest req contentType res accept
initReq <- GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall {k} {k} accept contentType (req :: k) (res :: k).
(MimeType accept, MimeType contentType) =>
GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest GenAIClientConfig
config ClientRequest req contentType res accept
request
  Manager
-> GenAIClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
Manager
-> GenAIClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager GenAIClientConfig
config InitRequest req contentType res accept
initReq

-- | dispatch an InitRequest
dispatchInitUnsafe ::
  -- | http-client Connection manager
  NH.Manager ->
  -- | config
  GenAIClientConfig ->
  -- | init request
  InitRequest req contentType res accept ->
  -- | response
  IO (NH.Response BCL.ByteString)
dispatchInitUnsafe :: forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
Manager
-> GenAIClientConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager GenAIClientConfig
config (InitRequest Request
req) = do
  Text -> GenAIClientConfig -> LogExec IO (Response ByteString)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> GenAIClientConfig -> LogExec m a
runConfigLogWithExceptions Text
src GenAIClientConfig
config LogExec IO (Response ByteString)
-> LogExec IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$
    do
      Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo Text
requestLogMsg
      Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug Text
requestDbgLogMsg
      Response ByteString
res <- IO (Response ByteString) -> LoggingT IO (Response ByteString)
forall a. IO a -> LoggingT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO (Response ByteString) -> LoggingT IO (Response ByteString))
-> IO (Response ByteString) -> LoggingT IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
NH.httpLbs Request
req Manager
manager
      Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo (Response ByteString -> Text
forall {body}. Response body -> Text
responseLogMsg Response ByteString
res)
      Text -> LogLevel -> Text -> LoggingT IO ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug ((String -> Text
T.pack (String -> Text)
-> (Response ByteString -> String) -> Response ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> String
forall a. Show a => a -> String
show) Response ByteString
res)
      Response ByteString -> LoggingT IO (Response ByteString)
forall a. a -> LoggingT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Response ByteString
res
  where
    src :: Text
src = Text
"Client"
    endpoint :: Text
endpoint =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        ByteString -> String
BC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
          Request -> ByteString
NH.method Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.host Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.path Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.queryString Request
req
    requestLogMsg :: Text
requestLogMsg = Text
"REQ:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endpoint
    requestDbgLogMsg :: Text
requestDbgLogMsg =
      Text
"Headers="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text)
-> (RequestHeaders -> String) -> RequestHeaders -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> String
forall a. Show a => a -> String
show) (Request -> RequestHeaders
NH.requestHeaders Request
req)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Body="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( case Request -> RequestBody
NH.requestBody Request
req of
              NH.RequestBodyLBS ByteString
xs -> ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
BL.toStrict ByteString
xs)
              RequestBody
_ -> Text
"<RequestBody>"
           )
    responseStatusCode :: Response body -> Text
responseStatusCode = (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) (Int -> Text) -> (Response body -> Int) -> Response body -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
NH.statusCode (Status -> Int)
-> (Response body -> Status) -> Response body -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response body -> Status
forall body. Response body -> Status
NH.responseStatus
    responseLogMsg :: Response body -> Text
responseLogMsg Response body
res =
      Text
"RES:statusCode=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response body -> Text
forall {body}. Response body -> Text
responseStatusCode Response body
res Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endpoint Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- * InitRequest

-- | wraps an http-client 'Request' with request/response type parameters
newtype InitRequest req contentType res accept = InitRequest
  { forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
InitRequest req contentType res accept -> Request
unInitRequest :: NH.Request
  }
  deriving (Int -> InitRequest req contentType res accept -> ShowS
[InitRequest req contentType res accept] -> ShowS
InitRequest req contentType res accept -> String
(Int -> InitRequest req contentType res accept -> ShowS)
-> (InitRequest req contentType res accept -> String)
-> ([InitRequest req contentType res accept] -> ShowS)
-> Show (InitRequest req contentType res accept)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (req :: k) k (contentType :: k) k (res :: k) k
       (accept :: k).
Int -> InitRequest req contentType res accept -> ShowS
forall k (req :: k) k (contentType :: k) k (res :: k) k
       (accept :: k).
[InitRequest req contentType res accept] -> ShowS
forall k (req :: k) k (contentType :: k) k (res :: k) k
       (accept :: k).
InitRequest req contentType res accept -> String
$cshowsPrec :: forall k (req :: k) k (contentType :: k) k (res :: k) k
       (accept :: k).
Int -> InitRequest req contentType res accept -> ShowS
showsPrec :: Int -> InitRequest req contentType res accept -> ShowS
$cshow :: forall k (req :: k) k (contentType :: k) k (res :: k) k
       (accept :: k).
InitRequest req contentType res accept -> String
show :: InitRequest req contentType res accept -> String
$cshowList :: forall k (req :: k) k (contentType :: k) k (res :: k) k
       (accept :: k).
[InitRequest req contentType res accept] -> ShowS
showList :: [InitRequest req contentType res accept] -> ShowS
Show)

-- |  Build an http-client 'Request' record from the supplied config and request
_toInitRequest ::
  (MimeType accept, MimeType contentType) =>
  -- | config
  GenAIClientConfig ->
  -- | request
  ClientRequest req contentType res accept ->
  -- | initialized request
  IO (InitRequest req contentType res accept)
_toInitRequest :: forall {k} {k} accept contentType (req :: k) (res :: k).
(MimeType accept, MimeType contentType) =>
GenAIClientConfig
-> ClientRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest GenAIClientConfig
config ClientRequest req contentType res accept
req0 =
  Text
-> GenAIClientConfig
-> LogExec IO (InitRequest req contentType res accept)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> GenAIClientConfig -> LogExec m a
runConfigLogWithExceptions Text
"Client" GenAIClientConfig
config LogExec IO (InitRequest req contentType res accept)
-> LogExec IO (InitRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$ do
    Request
parsedReq <- IO Request -> LoggingT IO Request
forall a. IO a -> LoggingT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO Request -> LoggingT IO Request)
-> IO Request -> LoggingT IO Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
NH.parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BCL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BCL.append (GenAIClientConfig -> ByteString
configHost GenAIClientConfig
config) ([ByteString] -> ByteString
BCL.concat (ClientRequest req contentType res accept -> [ByteString]
forall {k1} {k2} {k3} {k4} (req :: k1) (contentType :: k2)
       (res :: k3) (accept :: k4).
ClientRequest req contentType res accept -> [ByteString]
rUrlPath ClientRequest req contentType res accept
req0))
    ClientRequest req contentType res accept
req1 <- IO (ClientRequest req contentType res accept)
-> LoggingT IO (ClientRequest req contentType res accept)
forall a. IO a -> LoggingT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO (ClientRequest req contentType res accept)
 -> LoggingT IO (ClientRequest req contentType res accept))
-> IO (ClientRequest req contentType res accept)
-> LoggingT IO (ClientRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$ ClientRequest req contentType res accept
-> GenAIClientConfig
-> IO (ClientRequest req contentType res accept)
forall {k1} {k2} {k3} {k4} (req :: k1) (contentType :: k2)
       (res :: k3) (accept :: k4).
ClientRequest req contentType res accept
-> GenAIClientConfig
-> IO (ClientRequest req contentType res accept)
_applyAuthMethods ClientRequest req contentType res accept
req0 GenAIClientConfig
config
    Bool -> LoggingT IO () -> LoggingT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
P.when
      (GenAIClientConfig -> Bool
configValidateAuthMethods GenAIClientConfig
config Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> (ClientRequest req contentType res accept -> Bool)
-> ClientRequest req contentType res accept
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeRep] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TypeRep] -> Bool)
-> (ClientRequest req contentType res accept -> [TypeRep])
-> ClientRequest req contentType res accept
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientRequest req contentType res accept -> [TypeRep]
forall {k1} {k2} {k3} {k4} (req :: k1) (contentType :: k2)
       (res :: k3) (accept :: k4).
ClientRequest req contentType res accept -> [TypeRep]
rAuthTypes) ClientRequest req contentType res accept
req1)
      (AuthMethodException -> LoggingT IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
E.throw (AuthMethodException -> LoggingT IO ())
-> AuthMethodException -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ String -> AuthMethodException
AuthMethodException (String -> AuthMethodException) -> String -> AuthMethodException
forall a b. (a -> b) -> a -> b
$ String
"AuthMethod not configured: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String)
-> (ClientRequest req contentType res accept -> TypeRep)
-> ClientRequest req contentType res accept
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeRep] -> TypeRep
forall a. HasCallStack => [a] -> a
head ([TypeRep] -> TypeRep)
-> (ClientRequest req contentType res accept -> [TypeRep])
-> ClientRequest req contentType res accept
-> TypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientRequest req contentType res accept -> [TypeRep]
forall {k1} {k2} {k3} {k4} (req :: k1) (contentType :: k2)
       (res :: k3) (accept :: k4).
ClientRequest req contentType res accept -> [TypeRep]
rAuthTypes) ClientRequest req contentType res accept
req1)
    let req2 :: ClientRequest req contentType res accept
req2 = ClientRequest req contentType res accept
req1 ClientRequest req contentType res accept
-> (ClientRequest req contentType res accept
    -> ClientRequest req contentType res accept)
-> ClientRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ClientRequest req contentType res accept
-> ClientRequest req contentType res accept
forall {k1} {k2} {k3} (req :: k1) contentType (res :: k2)
       (accept :: k3).
MimeType contentType =>
ClientRequest req contentType res accept
-> ClientRequest req contentType res accept
_setContentTypeHeader ClientRequest req contentType res accept
-> (ClientRequest req contentType res accept
    -> ClientRequest req contentType res accept)
-> ClientRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ClientRequest req contentType res accept
-> ClientRequest req contentType res accept
forall {k1} {k2} {k3} (req :: k1) (contentType :: k2) (res :: k3)
       accept.
MimeType accept =>
ClientRequest req contentType res accept
-> ClientRequest req contentType res accept
_setAcceptHeader
        params :: Params
params = ClientRequest req contentType res accept -> Params
forall {k1} {k2} {k3} {k4} (req :: k1) (contentType :: k2)
       (res :: k3) (accept :: k4).
ClientRequest req contentType res accept -> Params
rParams ClientRequest req contentType res accept
req2
        reqHeaders :: RequestHeaders
reqHeaders = (HeaderName
"User-Agent", Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
WH.toHeader (GenAIClientConfig -> Text
configUserAgent GenAIClientConfig
config)) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Params -> RequestHeaders
paramsHeaders Params
params
        reqQuery :: ByteString
reqQuery =
          let query :: Query
query = Params -> Query
paramsQuery Params
params
              queryExtraUnreserved :: ByteString
queryExtraUnreserved = GenAIClientConfig -> ByteString
configQueryExtraUnreserved GenAIClientConfig
config
           in if ByteString -> Bool
B.null ByteString
queryExtraUnreserved
                then Bool -> Query -> ByteString
NH.renderQuery Bool
True Query
query
                else Bool -> PartialEscapeQuery -> ByteString
NH.renderQueryPartialEscape Bool
True (ByteString -> Query -> PartialEscapeQuery
toPartialEscapeQuery ByteString
queryExtraUnreserved Query
query)
        pReq :: Request
pReq =
          Request
parsedReq
            { NH.method = rMethod req2
            , NH.requestHeaders = reqHeaders
            , NH.queryString = reqQuery
            }
    Request
outReq <- case Params -> ParamBody
paramsBody Params
params of
      ParamBody
ParamBodyNone -> Request -> LoggingT IO Request
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq {NH.requestBody = mempty})
      ParamBodyB ByteString
bs -> Request -> LoggingT IO Request
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq {NH.requestBody = NH.RequestBodyBS bs})
      ParamBodyBL ByteString
bl -> Request -> LoggingT IO Request
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq {NH.requestBody = NH.RequestBodyLBS bl})
      ParamBodyFormUrlEncoded Form
form -> Request -> LoggingT IO Request
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq {NH.requestBody = NH.RequestBodyLBS (WH.urlEncodeForm form)})
      ParamBodyMultipartFormData [Part]
parts -> [Part] -> Request -> LoggingT IO Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
NH.formDataBody [Part]
parts Request
pReq

    InitRequest req contentType res accept
-> LoggingT IO (InitRequest req contentType res accept)
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> InitRequest req contentType res accept
forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
Request -> InitRequest req contentType res accept
InitRequest Request
outReq)

-- | modify the underlying Request
modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept
modifyInitRequest :: forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
InitRequest req contentType res accept
-> (Request -> Request) -> InitRequest req contentType res accept
modifyInitRequest (InitRequest Request
req) Request -> Request
f = Request -> InitRequest req contentType res accept
forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
Request -> InitRequest req contentType res accept
InitRequest (Request -> Request
f Request
req)

-- | modify the underlying Request (monadic)
modifyInitRequestM :: (Monad m) => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept)
modifyInitRequestM :: forall {k} {k} {k} {k} (m :: * -> *) (req :: k) (contentType :: k)
       (res :: k) (accept :: k).
Monad m =>
InitRequest req contentType res accept
-> (Request -> m Request)
-> m (InitRequest req contentType res accept)
modifyInitRequestM (InitRequest Request
req) Request -> m Request
f = (Request -> InitRequest req contentType res accept)
-> m Request -> m (InitRequest req contentType res accept)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Request -> InitRequest req contentType res accept
forall {k} {k} {k} {k} (req :: k) (contentType :: k) (res :: k)
       (accept :: k).
Request -> InitRequest req contentType res accept
InitRequest (Request -> m Request
f Request
req)

-- ** Logging

-- | Run a block using the configured logger instance
runConfigLog ::
  (P.MonadIO m) =>
  GenAIClientConfig ->
  LogExec m a
runConfigLog :: forall (m :: * -> *) a.
MonadIO m =>
GenAIClientConfig -> LogExec m a
runConfigLog GenAIClientConfig
config = GenAIClientConfig -> LogExecWithContext
configLogExecWithContext GenAIClientConfig
config (GenAIClientConfig -> LogContext
configLogContext GenAIClientConfig
config)

-- | Run a block using the configured logger instance (logs exceptions)
runConfigLogWithExceptions ::
  (E.MonadCatch m, P.MonadIO m) =>
  T.Text ->
  GenAIClientConfig ->
  LogExec m a
runConfigLogWithExceptions :: forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> GenAIClientConfig -> LogExec m a
runConfigLogWithExceptions Text
src GenAIClientConfig
config = GenAIClientConfig -> LogExec m a
forall (m :: * -> *) a.
MonadIO m =>
GenAIClientConfig -> LogExec m a
runConfigLog GenAIClientConfig
config LogExec m a -> (LoggingT m a -> LoggingT m a) -> LogExec m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a.
(MonadLogger m, MonadCatch m, MonadIO m) =>
Text -> m a -> m a
logExceptions Text
src