generate initial commit

Generate haskell-http-client from running g4f v-7.1.4.

Server started like this:

    python -m g4f --port 8080 --debug

Code generated like this:

    openapi-generator-cli generate \
        -i http://localhost:8080/openapi.json \
        -g haskell-http-client \
        --skip-validate-spec \
        -o g4f-client \
        --additional-properties=cabalPackage=g4f-client,cabalVersion=7.1.4,baseModule=G4fApi

1 files changed, 223 insertions, 0 deletions

diff --git a/lib/G4fClient/Client.hs b/lib/G4fClient/Client.hs
new file mode 100644
index 0000000..0fed516
--- /dev/null
+++ b/lib/G4fClient/Client.hs
@@ -0,0 +1,223 @@
+{-
+   FastAPI
+
+   No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)
+
+   OpenAPI Version: 3.1.0
+   FastAPI API version: 0.1.0
+   Generated by OpenAPI Generator (https://openapi-generator.tech)
+-}
+
+{-|
+Module : G4fClient.Client
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
+
+module G4fClient.Client where
+
+import G4fClient.Core
+import G4fClient.Logging
+import G4fClient.MimeTypes
+
+import qualified Control.Exception.Safe as E
+import qualified Control.Monad.IO.Class as P
+import qualified Control.Monad as P
+import qualified Data.Aeson.Types as A
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BCL
+import qualified Data.Proxy as P (Proxy(..))
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Network.HTTP.Client as NH
+import qualified Network.HTTP.Client.MultipartFormData as NH
+import qualified Network.HTTP.Types as NH
+import qualified Web.FormUrlEncoded as WH
+import qualified Web.HttpApiData 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)
+  => NH.Manager -- ^ http-client Connection manager
+  -> G4fClientConfig -- ^ config
+  -> G4fClientRequest req contentType res accept -- ^ request
+  -> IO (NH.Response BCL.ByteString) -- ^ response
+dispatchLbs manager config request  = do
+  initReq <- _toInitRequest config request
+  dispatchInitUnsafe manager config initReq
+
+-- ** Mime
+
+-- | pair of decoded http body and http response
+data MimeResult res =
+  MimeResult { mimeResult :: Either MimeError res -- ^ decoded http body
+             , mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response
+             }
+  deriving (Show, Functor, Foldable, Traversable)
+
+-- | pair of unrender/parser error and http response
+data MimeError =
+  MimeError {
+    mimeError :: String -- ^ unrender/parser error
+  , mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response
+  } deriving (Show)
+
+-- | send a request returning the 'MimeResult'
+dispatchMime
+  :: forall req contentType res accept. (Produces req accept, MimeUnrender accept res, MimeType contentType)
+  => NH.Manager -- ^ http-client Connection manager
+  -> G4fClientConfig -- ^ config
+  -> G4fClientRequest req contentType res accept -- ^ request
+  -> IO (MimeResult res) -- ^ response
+dispatchMime manager config request = do
+  httpResponse <- dispatchLbs manager config request
+  let statusCode = NH.statusCode . NH.responseStatus $ httpResponse
+  parsedResult <-
+    runConfigLogWithExceptions "Client" config $
+    do if (statusCode >= 400 && statusCode < 600)
+         then do
+           let s = "error statusCode: " ++ show statusCode
+           _log "Client" levelError (T.pack s)
+           pure (Left (MimeError s httpResponse))
+         else case mimeUnrender (P.Proxy :: P.Proxy accept) (NH.responseBody httpResponse) of
+           Left s -> do
+             _log "Client" levelError (T.pack s)
+             pure (Left (MimeError s httpResponse))
+           Right r -> pure (Right r)
+  return (MimeResult parsedResult httpResponse)
+
+-- | like 'dispatchMime', but only returns the decoded http body
+dispatchMime'
+  :: (Produces req accept, MimeUnrender accept res, MimeType contentType)
+  => NH.Manager -- ^ http-client Connection manager
+  -> G4fClientConfig -- ^ config
+  -> G4fClientRequest req contentType res accept -- ^ request
+  -> IO (Either MimeError res) -- ^ response
+dispatchMime' manager config request  = do
+    MimeResult parsedResult _ <- dispatchMime manager config request
+    return 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)
+  => NH.Manager -- ^ http-client Connection manager
+  -> G4fClientConfig -- ^ config
+  -> G4fClientRequest req contentType res accept -- ^ request
+  -> IO (NH.Response BCL.ByteString) -- ^ response
+dispatchLbsUnsafe manager config request  = do
+  initReq <- _toInitRequest config request
+  dispatchInitUnsafe manager config initReq
+
+-- | dispatch an InitRequest
+dispatchInitUnsafe
+  :: NH.Manager -- ^ http-client Connection manager
+  -> G4fClientConfig -- ^ config
+  -> InitRequest req contentType res accept -- ^ init request
+  -> IO (NH.Response BCL.ByteString) -- ^ response
+dispatchInitUnsafe manager config (InitRequest req) = do
+  runConfigLogWithExceptions src config $
+    do _log src levelInfo requestLogMsg
+       _log src levelDebug requestDbgLogMsg
+       res <- P.liftIO $ NH.httpLbs req manager
+       _log src levelInfo (responseLogMsg res)
+       _log src levelDebug ((T.pack . show) res)
+       return res
+  where
+    src = "Client"
+    endpoint =
+      T.pack $
+      BC.unpack $
+      NH.method req <> " " <> NH.host req <> NH.path req <> NH.queryString req
+    requestLogMsg = "REQ:" <> endpoint
+    requestDbgLogMsg =
+      "Headers=" <> (T.pack . show) (NH.requestHeaders req) <> " Body=" <>
+      (case NH.requestBody req of
+         NH.RequestBodyLBS xs -> T.decodeUtf8 (BL.toStrict xs)
+         _ -> "<RequestBody>")
+    responseStatusCode = (T.pack . show) . NH.statusCode . NH.responseStatus
+    responseLogMsg res =
+      "RES:statusCode=" <> responseStatusCode res <> " (" <> endpoint <> ")"
+
+-- * InitRequest
+
+-- | wraps an http-client 'Request' with request/response type parameters
+newtype InitRequest req contentType res accept = InitRequest
+  { unInitRequest :: NH.Request
+  } deriving (Show)
+
+-- |  Build an http-client 'Request' record from the supplied config and request
+_toInitRequest
+  :: (MimeType accept, MimeType contentType)
+  => G4fClientConfig -- ^ config
+  -> G4fClientRequest req contentType res accept -- ^ request
+  -> IO (InitRequest req contentType res accept) -- ^ initialized request
+_toInitRequest config req0  =
+  runConfigLogWithExceptions "Client" config $ do
+    parsedReq <- P.liftIO $ NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (rUrlPath req0))
+    req1 <- P.liftIO $ _applyAuthMethods req0 config
+    P.when
+        (configValidateAuthMethods config && (not . null . rAuthTypes) req1)
+        (E.throw $ AuthMethodException $ "AuthMethod not configured: " <> (show . head . rAuthTypes) req1)
+    let req2 = req1 & _setContentTypeHeader & _setAcceptHeader
+        params = rParams req2
+        reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders params
+        reqQuery = let query = paramsQuery params
+                       queryExtraUnreserved = configQueryExtraUnreserved config
+                   in if B.null queryExtraUnreserved
+                        then NH.renderQuery True query
+                        else NH.renderQueryPartialEscape True (toPartialEscapeQuery queryExtraUnreserved query)
+        pReq = parsedReq { NH.method = rMethod req2
+                        , NH.requestHeaders = reqHeaders
+                        , NH.queryString = reqQuery
+                        }
+    outReq <- case paramsBody params of
+        ParamBodyNone -> pure (pReq { NH.requestBody = mempty })
+        ParamBodyB bs -> pure (pReq { NH.requestBody = NH.RequestBodyBS bs })
+        ParamBodyBL bl -> pure (pReq { NH.requestBody = NH.RequestBodyLBS bl })
+        ParamBodyFormUrlEncoded form -> pure (pReq { NH.requestBody = NH.RequestBodyLBS (WH.urlEncodeForm form) })
+        ParamBodyMultipartFormData parts -> NH.formDataBody parts pReq
+
+    pure (InitRequest outReq)
+
+-- | modify the underlying Request
+modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept
+modifyInitRequest (InitRequest req) f = InitRequest (f 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 (InitRequest req) f = fmap InitRequest (f req)
+
+-- ** Logging
+
+-- | Run a block using the configured logger instance
+runConfigLog
+  :: P.MonadIO m
+  => G4fClientConfig -> LogExec m a
+runConfigLog config = configLogExecWithContext config (configLogContext config)
+
+-- | Run a block using the configured logger instance (logs exceptions)
+runConfigLogWithExceptions
+  :: (E.MonadCatch m, P.MonadIO m)
+  => T.Text -> G4fClientConfig -> LogExec m a
+runConfigLogWithExceptions src config = runConfigLog config . logExceptions src