{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

-- | Typed parameter and schema metadata shared by server registration and
-- OpenAPI generation. Schemas describe JSON encodings; custom schemas should
-- match the application's ToJSON/FromJSON instances.
module Web.Spock.Api.Document
  ( Schema, schemaObject, schemaValue, textSchema, intSchema, integerSchema,
    boolSchema, doubleSchema, arraySchema, nullableSchema,
    ParameterInfo (..), parameterInfo, PathParameters (..), Parameter (..), Parameters (..),
    BodySchema (..), OperationInfo (..), operationInfo,
    DocumentedEndpoint (..), SomeEndpoint (..), OpenApiError (..),
    validateEndpoint, openApiDocument, openApiDocumentWith,
  ) where

import Control.Monad (foldM, forM_, unless, when)
import Data.Aeson (Value (..), object, (.=))
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import Data.Kind (Type)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Types.URI (urlEncode)
import Web.HttpApiData (FromHttpApiData, ToHttpApiData)
import Web.Routing.Combinators (PathState (Open), normalizePath, joinWithDot)
import Web.Spock.Api

newtype Schema a = Schema { forall a. Schema a -> Value
schemaValue :: Value }

-- | Construct a custom JSON Schema object (OpenAPI 3.1 / JSON Schema 2020-12).
-- The caller is responsible for its validity and correspondence to the codec.
schemaObject :: [(Text, Value)] -> Schema a
schemaObject :: forall a. [(Text, Value)] -> Schema a
schemaObject [(Text, Value)]
fields = Value -> Schema a
forall a. Value -> Schema a
Schema (Value -> Schema a) -> Value -> Schema a
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Text -> Key
Key.fromText Text
key, Value
value) | (Text
key, Value
value) <- [(Text, Value)]
fields]

textSchema :: Schema Text
textSchema :: Schema Text
textSchema = [(Text, Value)] -> Schema Text
forall a. [(Text, Value)] -> Schema a
schemaObject [(Text
"type", Text -> Value
String Text
"string")]
intSchema :: Schema Int
intSchema :: Schema Int
intSchema = [(Text, Value)] -> Schema Int
forall a. [(Text, Value)] -> Schema a
schemaObject [(Text
"type", Text -> Value
String Text
"integer")]
integerSchema :: Schema Integer
integerSchema :: Schema Integer
integerSchema = [(Text, Value)] -> Schema Integer
forall a. [(Text, Value)] -> Schema a
schemaObject [(Text
"type", Text -> Value
String Text
"integer")]
boolSchema :: Schema Bool
boolSchema :: Schema Bool
boolSchema = [(Text, Value)] -> Schema Bool
forall a. [(Text, Value)] -> Schema a
schemaObject [(Text
"type", Text -> Value
String Text
"boolean")]
doubleSchema :: Schema Double
doubleSchema :: Schema Double
doubleSchema = [(Text, Value)] -> Schema Double
forall a. [(Text, Value)] -> Schema a
schemaObject [(Text
"type", Text -> Value
String Text
"number"), (Text
"format", Text -> Value
String Text
"double")]
arraySchema :: Schema a -> Schema [a]
arraySchema :: forall a. Schema a -> Schema [a]
arraySchema Schema a
item = [(Text, Value)] -> Schema [a]
forall a. [(Text, Value)] -> Schema a
schemaObject [(Text
"type", Text -> Value
String Text
"array"), (Text
"items", Schema a -> Value
forall a. Schema a -> Value
schemaValue Schema a
item)]
nullableSchema :: Schema a -> Schema (Maybe a)
nullableSchema :: forall a. Schema a -> Schema (Maybe a)
nullableSchema Schema a
value = Value -> Schema (Maybe a)
forall a. Value -> Schema a
Schema (Value -> Schema (Maybe a)) -> Value -> Schema (Maybe a)
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Value
object [Key
"anyOf" Key -> [Value] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Schema a -> Value
forall a. Schema a -> Value
schemaValue Schema a
value, [(Key, Value)] -> Value
object [Key
"type" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"null" :: Text)]]]

data ParameterInfo a = ParameterInfo
  { forall a. ParameterInfo a -> Text
pi_name :: Text, forall a. ParameterInfo a -> Text
pi_description :: Text, forall a. ParameterInfo a -> Schema a
pi_schema :: Schema a }

parameterInfo :: Text -> Schema a -> ParameterInfo a
parameterInfo :: forall a. Text -> Schema a -> ParameterInfo a
parameterInfo Text
name = Text -> Text -> Schema a -> ParameterInfo a
forall a. Text -> Text -> Schema a -> ParameterInfo a
ParameterInfo Text
name Text
""

-- | Exactly one name and schema for each captured path value, in path order.
data PathParameters (p :: [Type]) where
  NoPathParameters :: PathParameters '[]
  PathParameter :: ParameterInfo a -> PathParameters p -> PathParameters (a ': p)

data Parameter a where
  QueryParam :: (FromHttpApiData a, ToHttpApiData a) => ParameterInfo a -> Parameter a
  OptionalQueryParam :: (FromHttpApiData a, ToHttpApiData a) => ParameterInfo a -> Parameter (Maybe a)
  -- | Repeated @?name=one&name=two@ values, preserving order. Missing means [].
  QueryList :: (FromHttpApiData a, ToHttpApiData a) => ParameterInfo a -> Parameter [a]
  HeaderParam :: (FromHttpApiData a, ToHttpApiData a) => ParameterInfo a -> Parameter a
  OptionalHeaderParam :: (FromHttpApiData a, ToHttpApiData a) => ParameterInfo a -> Parameter (Maybe a)

data Parameters (q :: [Type]) where
  NoParameters :: Parameters '[]
  (:>) :: Parameter a -> Parameters q -> Parameters (a ': q)
infixr 5 :>

data BodySchema (i :: Maybe Type) where
  NoBody :: BodySchema 'Nothing
  JsonBody :: Schema a -> BodySchema ('Just a)

data OperationInfo = OperationInfo
  { OperationInfo -> Text
oi_operationId :: Text, OperationInfo -> Text
oi_summary :: Text, OperationInfo -> Text
oi_description :: Text,
    OperationInfo -> [Text]
oi_tags :: [Text], OperationInfo -> Bool
oi_deprecated :: Bool }

operationInfo :: Text -> OperationInfo
operationInfo :: Text -> OperationInfo
operationInfo Text
name = Text -> Text -> Text -> [Text] -> Bool -> OperationInfo
OperationInfo Text
name Text
"" Text
"" [] Bool
False

data DocumentedEndpoint p q i o = DocumentedEndpoint
  { forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Endpoint p i o
de_endpoint :: Endpoint p i o,
    forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> OperationInfo
de_operation :: OperationInfo,
    forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> PathParameters p
de_pathParameters :: PathParameters p,
    forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Parameters q
de_parameters :: Parameters q,
    forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> BodySchema i
de_body :: BodySchema i,
    forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Schema o
de_response :: Schema o }

data SomeEndpoint where
  SomeEndpoint :: DocumentedEndpoint p q i o -> SomeEndpoint

newtype OpenApiError = OpenApiError Text deriving (OpenApiError -> OpenApiError -> Bool
(OpenApiError -> OpenApiError -> Bool)
-> (OpenApiError -> OpenApiError -> Bool) -> Eq OpenApiError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenApiError -> OpenApiError -> Bool
== :: OpenApiError -> OpenApiError -> Bool
$c/= :: OpenApiError -> OpenApiError -> Bool
/= :: OpenApiError -> OpenApiError -> Bool
Eq, Int -> OpenApiError -> ShowS
[OpenApiError] -> ShowS
OpenApiError -> String
(Int -> OpenApiError -> ShowS)
-> (OpenApiError -> String)
-> ([OpenApiError] -> ShowS)
-> Show OpenApiError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenApiError -> ShowS
showsPrec :: Int -> OpenApiError -> ShowS
$cshow :: OpenApiError -> String
show :: OpenApiError -> String
$cshowList :: [OpenApiError] -> ShowS
showList :: [OpenApiError] -> ShowS
Show)

validateEndpoint :: DocumentedEndpoint p q i o -> Either OpenApiError ()
validateEndpoint :: forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Either OpenApiError ()
validateEndpoint DocumentedEndpoint p q i o
endpoint = do
  Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ OperationInfo -> Text
oi_operationId (OperationInfo -> Text) -> OperationInfo -> Text
forall a b. (a -> b) -> a -> b
$ DocumentedEndpoint p q i o -> OperationInfo
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> OperationInfo
de_operation DocumentedEndpoint p q i o
endpoint) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$
    OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError Text
"Operation ID must not be empty"
  let pathNames :: [Text]
pathNames = PathParameters p -> [Text]
forall (p :: [*]). PathParameters p -> [Text]
pathParameterNames (PathParameters p -> [Text]) -> PathParameters p -> [Text]
forall a b. (a -> b) -> a -> b
$ DocumentedEndpoint p q i o -> PathParameters p
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> PathParameters p
de_pathParameters DocumentedEndpoint p q i o
endpoint
      parameters :: [(Text, Text)]
parameters = Parameters q -> [(Text, Text)]
forall (q :: [*]). Parameters q -> [(Text, Text)]
parameterNames (Parameters q -> [(Text, Text)]) -> Parameters q -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ DocumentedEndpoint p q i o -> Parameters q
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Parameters q
de_parameters DocumentedEndpoint p q i o
endpoint
  [Text]
-> (Text -> Either OpenApiError ()) -> Either OpenApiError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
pathNames ((Text -> Either OpenApiError ()) -> Either OpenApiError ())
-> (Text -> Either OpenApiError ()) -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ \Text
name -> Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
validPathName Text
name) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$
    OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError Text
"Path parameter names must contain only ASCII letters, digits, underscores, dots, or hyphens"
  Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall a. Ord a => [a] -> Bool
unique [Text]
pathNames) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError Text
"Duplicate path parameter name"
  [(Text, Text)]
-> ((Text, Text) -> Either OpenApiError ())
-> Either OpenApiError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Text)]
parameters (((Text, Text) -> Either OpenApiError ())
 -> Either OpenApiError ())
-> ((Text, Text) -> Either OpenApiError ())
-> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ \(Text
location, Text
name) -> do
    Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
name) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError Text
"Parameter name must not be empty"
    Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
location Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"header" Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
validHeaderName Text
name)) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$
      OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError Text
"Invalid header parameter name"
    Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
location Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"header" Bool -> Bool -> Bool
&& Text -> Text
T.toCaseFold Text
name Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"accept", Text
"content-type", Text
"authorization"]) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$
      OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError Text
"OpenAPI reserves Accept, Content-Type, and Authorization headers; use content or security metadata instead"
  Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Text, Text)] -> Bool
forall a. Ord a => [a] -> Bool
unique [(Text
location, if Text
location Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"header" then Text -> Text
T.toCaseFold Text
name else Text
name) | (Text
location, Text
name) <- [(Text, Text)]
parameters]) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$
    OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError Text
"Duplicate query or header parameter"
  where
    unique :: Ord a => [a] -> Bool
    unique :: forall a. Ord a => [a] -> Bool
unique [a]
values = Set a -> Int
forall a. Set a -> Int
Set.size ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
values) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
values

-- | Generate OpenAPI 3.1.1 with JSON request/response schemas and typed path,
-- query, and header parameters. Conflicting operation IDs, duplicate methods,
-- and equivalent templates using different path names are rejected.
openApiDocument :: Text -> Text -> [SomeEndpoint] -> Either OpenApiError Value
openApiDocument :: Text -> Text -> [SomeEndpoint] -> Either OpenApiError Value
openApiDocument = SlashPolicy
-> Text -> Text -> [SomeEndpoint] -> Either OpenApiError Value
openApiDocumentWith SlashPolicy
IgnoreSlashes

-- | Generate paths with the application's slash policy. Strict and redirect
-- policies retain trailing and repeated literal slashes in the specification.
openApiDocumentWith :: SlashPolicy -> Text -> Text -> [SomeEndpoint] -> Either OpenApiError Value
openApiDocumentWith :: SlashPolicy
-> Text -> Text -> [SomeEndpoint] -> Either OpenApiError Value
openApiDocumentWith SlashPolicy
policy Text
title Text
version [SomeEndpoint]
endpoints = do
  (paths, _, _) <- ((Map Text (Map Text Value), Set Text, Map Text Text)
 -> SomeEndpoint
 -> Either
      OpenApiError (Map Text (Map Text Value), Set Text, Map Text Text))
-> (Map Text (Map Text Value), Set Text, Map Text Text)
-> [SomeEndpoint]
-> Either
     OpenApiError (Map Text (Map Text Value), Set Text, Map Text Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Map Text (Map Text Value), Set Text, Map Text Text)
-> SomeEndpoint
-> Either
     OpenApiError (Map Text (Map Text Value), Set Text, Map Text Text)
add (Map Text (Map Text Value)
forall k a. Map k a
Map.empty, Set Text
forall a. Set a
Set.empty, Map Text Text
forall k a. Map k a
Map.empty) [SomeEndpoint]
endpoints
  pure $ object ["openapi" .= ("3.1.1" :: Text), "info" .= object ["title" .= title, "version" .= version],
    "paths" .= Object (KM.fromList [(Key.fromText path, Object $ KM.fromList [(Key.fromText method, value) | (method, value) <- Map.toList methods])
                                  | (path, methods) <- Map.toList paths])]
  where
    add :: (Map Text (Map Text Value), Set Text, Map Text Text)
-> SomeEndpoint
-> Either
     OpenApiError (Map Text (Map Text Value), Set Text, Map Text Text)
add (Map Text (Map Text Value)
paths, Set Text
operations, Map Text Text
templates) (SomeEndpoint DocumentedEndpoint p q i o
endpoint) = do
      DocumentedEndpoint p q i o -> Either OpenApiError ()
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Either OpenApiError ()
validateEndpoint DocumentedEndpoint p q i o
endpoint
      let info :: OperationInfo
info = DocumentedEndpoint p q i o -> OperationInfo
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> OperationInfo
de_operation DocumentedEndpoint p q i o
endpoint
          opId :: Text
opId = OperationInfo -> Text
oi_operationId OperationInfo
info
          (Text
method, Path p 'Open
path) = Endpoint p i o -> (Text, Path p 'Open)
forall (p :: [*]) (i :: Maybe (*)) o.
Endpoint p i o -> (Text, Path p 'Open)
endpointRoute (Endpoint p i o -> (Text, Path p 'Open))
-> Endpoint p i o -> (Text, Path p 'Open)
forall a b. (a -> b) -> a -> b
$ DocumentedEndpoint p q i o -> Endpoint p i o
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Endpoint p i o
de_endpoint DocumentedEndpoint p q i o
endpoint
          (Text
rendered, Text
template, [Value]
pathParams) = Path p 'Open -> PathParameters p -> (Text, Text, [Value])
forall (p :: [*]).
Path p 'Open -> PathParameters p -> (Text, Text, [Value])
describePath (SlashPolicy -> Path p 'Open -> Path p 'Open
forall (as :: [*]) (ps :: PathState).
SlashPolicy -> Path as ps -> Path as ps
normalizePath SlashPolicy
policy Path p 'Open
path) (DocumentedEndpoint p q i o -> PathParameters p
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> PathParameters p
de_pathParameters DocumentedEndpoint p q i o
endpoint)
          methods :: Map Text Value
methods = Map Text Value
-> Text -> Map Text (Map Text Value) -> Map Text Value
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map Text Value
forall k a. Map k a
Map.empty Text
rendered Map Text (Map Text Value)
paths
      Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
opId Set Text
operations) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError (Text
"Duplicate operation ID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opId)
      Bool -> Either OpenApiError () -> Either OpenApiError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Map Text Value -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Text
method Map Text Value
methods) (Either OpenApiError () -> Either OpenApiError ())
-> Either OpenApiError () -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError (Text
"Duplicate endpoint: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
method Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rendered)
      case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
template Map Text Text
templates of
        Just Text
old | Text
old Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rendered -> OpenApiError -> Either OpenApiError ()
forall a b. a -> Either a b
Left (OpenApiError -> Either OpenApiError ())
-> OpenApiError -> Either OpenApiError ()
forall a b. (a -> b) -> a -> b
$ Text -> OpenApiError
OpenApiError (Text
"Conflicting path templates: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
old Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rendered)
        Maybe Text
_ -> () -> Either OpenApiError ()
forall a. a -> Either OpenApiError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      let operation :: Value
operation = [(Key, Value)] -> Value
object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
            [ Key
"operationId" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
opId, Key
"summary" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OperationInfo -> Text
oi_summary OperationInfo
info, Key
"description" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OperationInfo -> Text
oi_description OperationInfo
info,
              Key
"tags" Key -> [Text] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OperationInfo -> [Text]
oi_tags OperationInfo
info, Key
"deprecated" Key -> Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OperationInfo -> Bool
oi_deprecated OperationInfo
info,
              Key
"parameters" Key -> [Value] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ([Value]
pathParams [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ Parameters q -> [Value]
forall (q :: [*]). Parameters q -> [Value]
describeParameters (DocumentedEndpoint p q i o -> Parameters q
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Parameters q
de_parameters DocumentedEndpoint p q i o
endpoint)),
              Key
"responses" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
                [ Key
"200" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"description" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Successful response" :: Text),
                    Key
"content" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Schema o -> Value
forall a. Schema a -> Value
jsonContent (DocumentedEndpoint p q i o -> Schema o
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> Schema o
de_response DocumentedEndpoint p q i o
endpoint)],
                  Key
"400" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"description" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Invalid query/header parameters or JSON body" :: Text)] ] ]
            [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. [a] -> [a] -> [a]
++ BodySchema i -> [(Key, Value)]
forall (i :: Maybe (*)). BodySchema i -> [(Key, Value)]
describeBody (DocumentedEndpoint p q i o -> BodySchema i
forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o.
DocumentedEndpoint p q i o -> BodySchema i
de_body DocumentedEndpoint p q i o
endpoint)
      (Map Text (Map Text Value), Set Text, Map Text Text)
-> Either
     OpenApiError (Map Text (Map Text Value), Set Text, Map Text Text)
forall a. a -> Either OpenApiError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
-> Map Text Value
-> Map Text (Map Text Value)
-> Map Text (Map Text Value)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
rendered (Text -> Value -> Map Text Value -> Map Text Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
method Value
operation Map Text Value
methods) Map Text (Map Text Value)
paths,
            Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
opId Set Text
operations, Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
template Text
rendered Map Text Text
templates)

endpointRoute :: Endpoint p i o -> (Text, Path p 'Open)
endpointRoute :: forall (p :: [*]) (i :: Maybe (*)) o.
Endpoint p i o -> (Text, Path p 'Open)
endpointRoute (MethodGet Path p 'Open
path) = (Text
"get", Path p 'Open
path)
endpointRoute (MethodPost Proxy (i1 -> o)
_ Path p 'Open
path) = (Text
"post", Path p 'Open
path)
endpointRoute (MethodPut Proxy (i1 -> o)
_ Path p 'Open
path) = (Text
"put", Path p 'Open
path)
endpointRoute (MethodPatch Proxy (i1 -> o)
_ Path p 'Open
path) = (Text
"patch", Path p 'Open
path)
endpointRoute (MethodDelete Path p 'Open
path) = (Text
"delete", Path p 'Open
path)

describePath :: Path p 'Open -> PathParameters p -> (Text, Text, [Value])
describePath :: forall (p :: [*]).
Path p 'Open -> PathParameters p -> (Text, Text, [Value])
describePath Path p 'Open
path PathParameters p
parameters = let ([Text]
pieces, [Text]
template, [Value]
values, [(Text, Value)]
_) = Path p 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path p 'Open
path (PathParameters p -> [(Text, Value)]
forall (as :: [*]). PathParameters as -> [(Text, Value)]
captureInfo PathParameters p
parameters)
  in (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
pieces, Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
template, [Value]
values)
  where
    captureInfo :: PathParameters as -> [(Text, Value)]
    captureInfo :: forall (as :: [*]). PathParameters as -> [(Text, Value)]
captureInfo PathParameters as
NoPathParameters = []
    captureInfo (PathParameter ParameterInfo a
info PathParameters p
rest) =
      (ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info, Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
forall a. Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter Text
"path" Bool
True Text
"simple" Bool
False ParameterInfo a
info) (Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: PathParameters p -> [(Text, Value)]
forall (as :: [*]). PathParameters as -> [(Text, Value)]
captureInfo PathParameters p
rest

    -- Path and PathParameters have the same capture index. Flattening metadata
    -- once lets composite segments consume that order without unsafe coercions.
    go :: Path as 'Open -> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
    go :: forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path as 'Open
Empty [(Text, Value)]
params = ([], [], [], [(Text, Value)]
params)
    go (StaticCons Text
piece Path as 'Open
rest) [(Text, Value)]
params =
      let ([Text]
pieces, [Text]
template, [Value]
values, [(Text, Value)]
remaining) = Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path as 'Open
rest [(Text, Value)]
params
          encoded :: Text
encoded = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
urlEncode Bool
True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
piece
      in (Text
encoded Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
pieces, Text
encoded Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
template, [Value]
values, [(Text, Value)]
remaining)
    go (VarCons Path as1 'Open
rest) ((Text
name, Value
info) : [(Text, Value)]
params) =
      let ([Text]
pieces, [Text]
template, [Value]
values, [(Text, Value)]
remaining) = Path as1 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path as1 'Open
rest [(Text, Value)]
params
      in ((Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
pieces, Text
"{}" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
template, Value
info Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
values, [(Text, Value)]
remaining)
    go (VarCons Path as1 'Open
_) [] = String -> ([Text], [Text], [Value], [(Text, Value)])
forall a. HasCallStack => String -> a
error String
"describePath: internal capture arity mismatch"
    go (WithExtension Path as1 'Open
left Path bs 'Open
right) [(Text, Value)]
params =
      let ([Text]
leftPieces, [Text]
leftTemplate, [Value]
leftValues, [(Text, Value)]
rest) = Path as1 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path as1 'Open
left [(Text, Value)]
params
          ([Text]
rightPieces, [Text]
rightTemplate, [Value]
rightValues, [(Text, Value)]
remaining) = Path bs 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path bs 'Open
right [(Text, Value)]
rest
      in ([Text] -> [Text] -> [Text]
joinWithDot [Text]
leftPieces [Text]
rightPieces, [Text] -> [Text] -> [Text]
joinWithDot [Text]
leftTemplate [Text]
rightTemplate, [Value]
leftValues [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
rightValues, [(Text, Value)]
remaining)
    go (AppendPath Path as1 'Open
left Path bs 'Open
right) [(Text, Value)]
params =
      let ([Text]
leftPieces, [Text]
leftTemplate, [Value]
leftValues, [(Text, Value)]
rest) = Path as1 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path as1 'Open
left [(Text, Value)]
params
          ([Text]
rightPieces, [Text]
rightTemplate, [Value]
rightValues, [(Text, Value)]
remaining) = Path bs 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
forall (as :: [*]).
Path as 'Open
-> [(Text, Value)] -> ([Text], [Text], [Value], [(Text, Value)])
go Path bs 'Open
right [(Text, Value)]
rest
      in ([Text]
leftPieces [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
rightPieces, [Text]
leftTemplate [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
rightTemplate, [Value]
leftValues [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
rightValues, [(Text, Value)]
remaining)

describeParameters :: Parameters q -> [Value]
describeParameters :: forall (q :: [*]). Parameters q -> [Value]
describeParameters Parameters q
NoParameters = []
describeParameters (Parameter a
parameter :> Parameters q
rest) = Parameter a -> Value
forall a. Parameter a -> Value
describe Parameter a
parameter Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: Parameters q -> [Value]
forall (q :: [*]). Parameters q -> [Value]
describeParameters Parameters q
rest
  where
    describe :: Parameter a -> Value
    describe :: forall a. Parameter a -> Value
describe (QueryParam ParameterInfo a
info) = Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
forall a. Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter Text
"query" Bool
True Text
"form" Bool
True ParameterInfo a
info
    describe (OptionalQueryParam ParameterInfo a
info) = Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
forall a. Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter Text
"query" Bool
False Text
"form" Bool
True ParameterInfo a
info
    describe (QueryList ParameterInfo a
info) = Text -> Bool -> Text -> Bool -> ParameterInfo [a] -> Value
forall a. Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter Text
"query" Bool
False Text
"form" Bool
True
      (Text -> Text -> Schema [a] -> ParameterInfo [a]
forall a. Text -> Text -> Schema a -> ParameterInfo a
ParameterInfo (ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info) (ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_description ParameterInfo a
info) (Schema [a] -> ParameterInfo [a])
-> Schema [a] -> ParameterInfo [a]
forall a b. (a -> b) -> a -> b
$ Schema a -> Schema [a]
forall a. Schema a -> Schema [a]
arraySchema (Schema a -> Schema [a]) -> Schema a -> Schema [a]
forall a b. (a -> b) -> a -> b
$ ParameterInfo a -> Schema a
forall a. ParameterInfo a -> Schema a
pi_schema ParameterInfo a
info)
    describe (HeaderParam ParameterInfo a
info) = Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
forall a. Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter Text
"header" Bool
True Text
"simple" Bool
False ParameterInfo a
info
    describe (OptionalHeaderParam ParameterInfo a
info) = Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
forall a. Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter Text
"header" Bool
False Text
"simple" Bool
False ParameterInfo a
info

describeParameter :: Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter :: forall a. Text -> Bool -> Text -> Bool -> ParameterInfo a -> Value
describeParameter Text
location Bool
required Text
style Bool
explode ParameterInfo a
info = [(Key, Value)] -> Value
object
  [Key
"name" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info, Key
"in" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
location, Key
"required" Key -> Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
required,
   Key
"description" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_description ParameterInfo a
info, Key
"schema" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Schema a -> Value
forall a. Schema a -> Value
schemaValue (ParameterInfo a -> Schema a
forall a. ParameterInfo a -> Schema a
pi_schema ParameterInfo a
info),
   Key
"style" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
style, Key
"explode" Key -> Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
explode]

describeBody :: BodySchema i -> [(Key.Key, Value)]
describeBody :: forall (i :: Maybe (*)). BodySchema i -> [(Key, Value)]
describeBody BodySchema i
NoBody = []
describeBody (JsonBody Schema a
schema) = [Key
"requestBody" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"required" Key -> Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True, Key
"content" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Schema a -> Value
forall a. Schema a -> Value
jsonContent Schema a
schema]]

jsonContent :: Schema a -> Value
jsonContent :: forall a. Schema a -> Value
jsonContent Schema a
schema = [(Key, Value)] -> Value
object [Key
"application/json" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"schema" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Schema a -> Value
forall a. Schema a -> Value
schemaValue Schema a
schema]]

pathParameterNames :: PathParameters p -> [Text]
pathParameterNames :: forall (p :: [*]). PathParameters p -> [Text]
pathParameterNames PathParameters p
NoPathParameters = []
pathParameterNames (PathParameter ParameterInfo a
info PathParameters p
rest) = ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: PathParameters p -> [Text]
forall (p :: [*]). PathParameters p -> [Text]
pathParameterNames PathParameters p
rest

parameterNames :: Parameters q -> [(Text, Text)]
parameterNames :: forall (q :: [*]). Parameters q -> [(Text, Text)]
parameterNames Parameters q
NoParameters = []
parameterNames (Parameter a
parameter :> Parameters q
rest) = Parameter a -> (Text, Text)
forall a. Parameter a -> (Text, Text)
name Parameter a
parameter (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Parameters q -> [(Text, Text)]
forall (q :: [*]). Parameters q -> [(Text, Text)]
parameterNames Parameters q
rest
  where
    name :: Parameter a -> (Text, Text)
    name :: forall a. Parameter a -> (Text, Text)
name (QueryParam ParameterInfo a
info) = (Text
"query", ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info)
    name (OptionalQueryParam ParameterInfo a
info) = (Text
"query", ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info)
    name (QueryList ParameterInfo a
info) = (Text
"query", ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info)
    name (HeaderParam ParameterInfo a
info) = (Text
"header", ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info)
    name (OptionalHeaderParam ParameterInfo a
info) = (Text
"header", ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info)

validPathName :: Text -> Bool
validPathName :: Text -> Bool
validPathName Text
name = Bool -> Bool
not (Text -> Bool
T.null Text
name) Bool -> Bool -> Bool
&& (Word8 -> Bool) -> ByteString -> Bool
BS.all
  (\Word8
c -> Word8 -> Bool
forall a. (Ord a, Num a) => a -> Bool
asciiAlphaNum Word8
c Bool -> Bool -> Bool
|| Word8
c Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
45, Word8
46, Word8
95]) (Text -> ByteString
T.encodeUtf8 Text
name)

validHeaderName :: Text -> Bool
validHeaderName :: Text -> Bool
validHeaderName Text
name = Bool -> Bool
not (Text -> Bool
T.null Text
name) Bool -> Bool -> Bool
&& (Word8 -> Bool) -> ByteString -> Bool
BS.all
  (\Word8
c -> Word8 -> Bool
forall a. (Ord a, Num a) => a -> Bool
asciiAlphaNum Word8
c Bool -> Bool -> Bool
|| Word8
c Word8 -> ByteString -> Bool
`BS.elem` ByteString
"!#$%&'*+-.^_`|~") (Text -> ByteString
T.encodeUtf8 Text
name)

asciiAlphaNum :: (Ord a, Num a) => a -> Bool
asciiAlphaNum :: forall a. (Ord a, Num a) => a -> Bool
asciiAlphaNum a
c = (a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
65 Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
90) Bool -> Bool -> Bool
|| (a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
97 Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
122) Bool -> Bool -> Bool
|| (a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
57)