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 #-}
{-# 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 -fcontext-stack=328 #-}

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 Control.Monad.Except (ExceptT)
import Control.Monad.IO.Class
import Data.Aeson (Value)
import Data.Coerce (coerce)
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 GHC.Exts (IsString(..))
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
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 (Scheme(Http), ServantError, client)
import Servant.Common.BaseUrl (BaseUrl(..))
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)

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 String b
lookupEither key assocs =
  case lookup key assocs of
    Nothing -> Left $ "Could not find parameter " <> (T.unpack key) <> " in form data"
    Just value ->
      case parseQueryParam value of
        Left result -> Left $ T.unpack result
        Right result -> Right $ result

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