Many resources are needed to download a project. Please understand that we have to compensate our server costs. Thank you in advance. Project price only 1 $
You can buy this project and download/modify it how often you want.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC
-fno-warn-unused-binds -fno-warn-unused-imports -freduction-depth=328 #-}
module {{title}}.API
-- * Client and Server
( Config(..)
, {{title}}Backend(..)
, create{{title}}Client
, run{{title}}Server
, run{{title}}Client
, run{{title}}ClientWithManager
, call{{title}}
, {{title}}Client
, {{title}}ClientError(..)
-- ** Servant
, {{title}}API
) where
import {{title}}.Types
import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT (..))
import Data.Aeson (Value)
import Data.Coerce (coerce)
import Data.Data (Data)
import Data.Function ((&))
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.UUID (UUID)
import GHC.Exts (IsString (..))
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types.Method (methodOptions)
import qualified Network.Wai.Handler.Warp as Warp
import Servant (ServantErr, serve)
import Servant.API
import Servant.API.Verbs (StdMethod (..), Verb)
import Servant.Client (ClientEnv, Scheme (Http), ServantError, client,
mkClientEnv, parseBaseUrl)
import Servant.Client.Core (baseUrlPort, baseUrlHost)
import Servant.Client.Internal.HttpClient (ClientM (..))
import Servant.Server (Handler (..))
import Web.FormUrlEncoded
import Web.HttpApiData
{{#apiInfo}}{{#apis}}{{#operations}}{{#operation}}{{#hasFormParams}}
data {{vendorExtensions.x-formName}} = {{vendorExtensions.x-formName}}
{ {{#formParams}}{{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} :: {{dataType}}{{#hasMore}}
, {{/hasMore}}{{/formParams}}
} deriving (Show, Eq, Generic, Data)
instance FromForm {{vendorExtensions.x-formName}}
instance ToForm {{vendorExtensions.x-formName}}
{{/hasFormParams}}{{/operation}}{{/operations}}{{/apis}}{{/apiInfo}}
-- | List of elements parsed from a query.
newtype QueryList (p :: CollectionFormat) a = QueryList
{ fromQueryList :: [a]
} deriving (Functor, Applicative, Monad, Foldable, Traversable)
-- | Formats in which a list can be encoded into a HTTP path.
data CollectionFormat
= CommaSeparated -- ^ CSV format for multiple parameters.
| SpaceSeparated -- ^ Also called "SSV"
| TabSeparated -- ^ Also called "TSV"
| PipeSeparated -- ^ `value1|value2|value2`
| MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params.
instance FromHttpApiData a => FromHttpApiData (QueryList 'CommaSeparated a) where
parseQueryParam = parseSeparatedQueryList ','
instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where
parseQueryParam = parseSeparatedQueryList '\t'
instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where
parseQueryParam = parseSeparatedQueryList ' '
instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where
parseQueryParam = parseSeparatedQueryList '|'
instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where
parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format"
parseSeparatedQueryList :: FromHttpApiData a => Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList char = fmap QueryList . mapM parseQueryParam . T.split (== char)
instance ToHttpApiData a => ToHttpApiData (QueryList 'CommaSeparated a) where
toQueryParam = formatSeparatedQueryList ','
instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where
toQueryParam = formatSeparatedQueryList '\t'
instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where
toQueryParam = formatSeparatedQueryList ' '
instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where
toQueryParam = formatSeparatedQueryList '|'
instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format"
formatSeparatedQueryList :: ToHttpApiData a => Char -> QueryList p a -> Text
formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryParam . fromQueryList
{{#apiInfo}}
-- | Servant type-level API, generated from the OpenAPI spec for {{title}}.
type {{title}}API
= {{#apis}}{{#operations}}{{#operation}}{{& vendorExtensions.x-routeType}} -- '{{operationId}}' route{{#hasMore}}
:<|> {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}}
:<|> {{/hasMore}}{{/apis}}
{{/apiInfo}}
-- | Server or client configuration, specifying the host and port to query or serve on.
data Config = Config
{ configUrl :: String -- ^ scheme://hostname:port/path, e.g. "http://localhost:8080/"
} deriving (Eq, Ord, Show, Read)
-- | Custom exception type for our errors.
newtype {{title}}ClientError = {{title}}ClientError ServantError
deriving (Show, Exception)
-- | Configuration, specifying the full url of the service.
{{#apiInfo}}
-- | Backend for {{title}}.
-- The backend can be used both for the client and the server. The client generated from the {{title}} OpenAPI spec
-- is a backend that executes actions by sending HTTP requests (see @create{{title}}Client@). Alternatively, provided
-- a backend, the API can be served using @run{{title}}Server@.
data {{title}}Backend m = {{title}}Backend
{ {{#apis}}{{#operations}}{{#operation}}{{operationId}} :: {{& vendorExtensions.x-clientType}}{- ^ {{& notes}} -}{{#hasMore}}
, {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}}
, {{/hasMore}}{{/apis}}
}
newtype {{title}}Client a = {{title}}Client
{ runClient :: ClientEnv -> ExceptT ServantError IO a
} deriving Functor
instance Applicative {{title}}Client where
pure x = {{title}}Client (\_ -> pure x)
({{title}}Client f) <*> ({{title}}Client x) =
{{title}}Client (\env -> f env <*> x env)
instance Monad {{title}}Client where
({{title}}Client a) >>= f =
{{title}}Client (\env -> do
value <- a env
runClient (f value) env)
instance MonadIO {{title}}Client where
liftIO io = {{title}}Client (\_ -> liftIO io)
{{/apiInfo}}
{{#apiInfo}}
create{{title}}Client :: {{title}}Backend {{title}}Client
create{{title}}Client = {{title}}Backend{..}
where
({{#apis}}{{#operations}}{{#operation}}(coerce -> {{operationId}}){{#hasMore}} :<|>
{{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}} :<|>
{{/hasMore}}{{/apis}}) = client (Proxy :: Proxy {{title}}API)
-- | Run requests in the {{title}}Client monad.
run{{title}}Client :: Config -> {{title}}Client a -> ExceptT ServantError IO a
run{{title}}Client clientConfig cl = do
manager <- liftIO $ newManager tlsManagerSettings
run{{title}}ClientWithManager manager clientConfig cl
-- | Run requests in the {{title}}Client monad using a custom manager.
run{{title}}ClientWithManager :: Manager -> Config -> {{title}}Client a -> ExceptT ServantError IO a
run{{title}}ClientWithManager manager Config{..} cl = do
url <- parseBaseUrl configUrl
runClient cl $ mkClientEnv manager url
-- | Like @runClient@, but returns the response or throws
-- a {{title}}ClientError
call{{title}}
:: (MonadIO m, MonadThrow m)
=> ClientEnv -> {{title}}Client a -> m a
call{{title}} env f = do
res <- liftIO $ runExceptT $ runClient f env
case res of
Left err -> throwM ({{title}}ClientError err)
Right response -> pure response
{{/apiInfo}}
{{#apiInfo}}
-- | Run the {{title}} server at the provided host and port.
run{{title}}Server
:: (MonadIO m, MonadThrow m)
=> Config -> {{title}}Backend (ExceptT ServantErr IO) -> m ()
run{{title}}Server Config{..} backend = do
url <- parseBaseUrl configUrl
let warpSettings = Warp.defaultSettings
& Warp.setPort (baseUrlPort url)
& Warp.setHost (fromString $ baseUrlHost url)
liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend)
where
serverFromBackend {{title}}Backend{..} =
({{#apis}}{{#operations}}{{#operation}}coerce {{operationId}}{{#hasMore}} :<|>
{{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}} :<|>
{{/hasMore}}{{/apis}})
{{/apiInfo}}
