haskell-servant.API.mustache Maven / Gradle / Ivy

Go to download
Show more of this group Show more artifacts with this name
Show all versions of swagger-codegen Show documentation
There is a newer version: 3.0.0-rc1
{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, FlexibleInstances, OverloadedStrings, ViewPatterns #-}
{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, DeriveTraversable, FlexibleContexts, DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack={{contextStackLimit}} #-}
module {{title}}.API (
  -- * Client and Server
  ServerConfig(..),
  {{title}}Backend,
  create{{title}}Client,
  run{{title}}Server,
  run{{title}}Client,
  run{{title}}ClientWithManager,
  {{title}}Client,
  -- ** Servant
  {{title}}API,
  ) where

import {{title}}.Types

import Data.Aeson (Value)
import Data.Coerce (coerce)
import Servant.API
import Servant (serve, ServantErr)
import Web.HttpApiData
import qualified Network.Wai.Handler.Warp as Warp
import qualified Data.Text as T
import Data.Text (Text)
import Servant.Common.BaseUrl(BaseUrl(..))
import Servant.Client (ServantError, client, Scheme(Http))
import Data.Proxy (Proxy(..))
import Control.Monad.IO.Class
import Data.Function ((&))
import GHC.Exts (IsString(..))
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Data.Monoid ((<>))
import Servant.API.Verbs (Verb, StdMethod(..))
import Control.Monad.Except (ExceptT)
import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
import Network.HTTP.Types.Method (methodOptions)

instance ReflectMethod 'OPTIONS where
  reflectMethod _ = methodOptions


{{#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)

instance FromFormUrlEncoded {{vendorExtensions.x-formName}} where
    fromFormUrlEncoded inputs = {{vendorExtensions.x-formName}} <$> {{#formParams}} lookupEither "{{baseName}}" inputs{{#hasMore}} <*> {{/hasMore}}{{/formParams}}
instance ToFormUrlEncoded {{vendorExtensions.x-formName}} where
    toFormUrlEncoded value = [{{#formParams}}("{{baseName}}", toQueryParam $ {{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} value){{#hasMore}}, {{/hasMore}}{{/formParams}}]
{{/hasFormParams}}{{/operation}}{{/operations}}{{/apis}}{{/apiInfo}}

-- For the form data code generation.
lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either Text b
lookupEither key assocs =
  case lookup key assocs of
    Nothing -> Left $ "Could not find parameter " <> key <> " in form data"
    Just value -> parseQueryParam value

{{#apiInfo}}
-- | Servant type-level API, generated from the Swagger 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 ServerConfig = ServerConfig {
    configHost :: String,  -- ^ Hostname to serve on, e.g. "127.0.0.1"
    configPort :: Int      -- ^ Port to serve on, e.g. 8080
  } deriving (Eq, Ord, Show, Read)

-- | 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}}
-- | Backend for {{title}}.
-- The backend can be used both for the client and the server. The client generated from the {{title}} Swagger 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 :: Manager -> BaseUrl -> 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 (\manager url -> f manager url <*> x manager url)

instance Monad {{title}}Client where
    ({{title}}Client a) >>= f = {{title}}Client (\manager url -> do
        value <- a manager url
        runClient (f value) manager url)

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 :: ServerConfig -> {{title}}Client a -> ExceptT ServantError IO a
run{{title}}Client clientConfig cl = do
  manager <- liftIO $ newManager defaultManagerSettings
  run{{title}}ClientWithManager manager clientConfig cl

-- | Run requests in the {{title}}Client monad using a custom manager.
run{{title}}ClientWithManager :: Manager -> ServerConfig -> {{title}}Client a -> ExceptT ServantError IO a
run{{title}}ClientWithManager manager clientConfig cl =
  runClient cl manager $ BaseUrl Http (configHost clientConfig) (configPort clientConfig) ""
{{/apiInfo}}

{{#apiInfo}}
-- | Run the {{title}} server at the provided host and port.
run{{title}}Server :: MonadIO m => ServerConfig -> {{title}}Backend (ExceptT ServantErr IO)  -> m ()
run{{title}}Server ServerConfig{..} backend =
  liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend)

  where
    warpSettings = Warp.defaultSettings & Warp.setPort configPort & Warp.setHost (fromString configHost)
    serverFromBackend {{title}}Backend{..} =
      ({{#apis}}{{#operations}}{{#operation}}coerce {{operationId}}{{#hasMore}} :<|>
       {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}} :<|>
       {{/hasMore}}{{/apis}})
{{/apiInfo}}