{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Middleware.Validation.Internal where
import Control.Lens (at, (^.), (^?), _Just)
import Data.Aeson (Value, decode)
import qualified Data.ByteString.Lazy as L
import Data.HashMap.Strict.InsOrd (InsOrdHashMap, keys)
import qualified Data.Map.Strict as M
import Data.OpenApi (HttpStatusCode, OpenApi, Operation, PathItem,
Referenced, Schema, components, content, default_,
paths, requestBodies, requestBody, responses,
schema, schemas, validateJSON, _pathItemDelete,
_pathItemGet, _pathItemPatch, _pathItemPost,
_pathItemPut)
import Data.OpenApi.Schema.Generator (dereference)
import qualified Data.Text as T
import Network.HTTP.Types (StdMethod (DELETE, GET, PATCH, POST, PUT))
import System.FilePath (splitDirectories)
data TemplatedPathComponent = Exact FilePath | ParameterValue deriving (Int -> TemplatedPathComponent -> ShowS
[TemplatedPathComponent] -> ShowS
TemplatedPathComponent -> String
(Int -> TemplatedPathComponent -> ShowS)
-> (TemplatedPathComponent -> String)
-> ([TemplatedPathComponent] -> ShowS)
-> Show TemplatedPathComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplatedPathComponent] -> ShowS
$cshowList :: [TemplatedPathComponent] -> ShowS
show :: TemplatedPathComponent -> String
$cshow :: TemplatedPathComponent -> String
showsPrec :: Int -> TemplatedPathComponent -> ShowS
$cshowsPrec :: Int -> TemplatedPathComponent -> ShowS
Show)
instance Eq TemplatedPathComponent where
Exact String
l == :: TemplatedPathComponent -> TemplatedPathComponent -> Bool
== Exact String
r = String
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
r
TemplatedPathComponent
_ == TemplatedPathComponent
_ = Bool
True
instance Ord TemplatedPathComponent where
compare :: TemplatedPathComponent -> TemplatedPathComponent -> Ordering
compare (Exact String
l) (Exact String
r) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
l String
r
compare TemplatedPathComponent
_ TemplatedPathComponent
_ = Ordering
EQ
toTemplatedPathComponent :: FilePath -> TemplatedPathComponent
toTemplatedPathComponent :: String -> TemplatedPathComponent
toTemplatedPathComponent String
s
| Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}' = TemplatedPathComponent
ParameterValue
| Bool
otherwise = String -> TemplatedPathComponent
Exact String
s
type TemplatedPath = [TemplatedPathComponent]
toTemplatedPath :: FilePath -> TemplatedPath
toTemplatedPath :: String -> [TemplatedPathComponent]
toTemplatedPath String
p = (String -> TemplatedPathComponent)
-> [String] -> [TemplatedPathComponent]
forall a b. (a -> b) -> [a] -> [b]
map String -> TemplatedPathComponent
toTemplatedPathComponent ([String] -> [TemplatedPathComponent])
-> [String] -> [TemplatedPathComponent]
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDirectories String
p
type PathMap = M.Map TemplatedPath FilePath
makePathMap :: [FilePath] -> PathMap
makePathMap :: [String] -> PathMap
makePathMap [String]
ps = [([TemplatedPathComponent], String)] -> PathMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([TemplatedPathComponent], String)] -> PathMap)
-> [([TemplatedPathComponent], String)] -> PathMap
forall a b. (a -> b) -> a -> b
$ [[TemplatedPathComponent]]
-> [String] -> [([TemplatedPathComponent], String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((String -> [TemplatedPathComponent])
-> [String] -> [[TemplatedPathComponent]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [TemplatedPathComponent]
toTemplatedPath [String]
ps) [String]
ps
lookupDefinedPath :: FilePath -> PathMap -> Maybe FilePath
lookupDefinedPath :: String -> PathMap -> Maybe String
lookupDefinedPath String
realPath = [TemplatedPathComponent] -> PathMap -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> [TemplatedPathComponent]
toTemplatedPath String
realPath)
data ApiDefinition = ApiDefinition
{ ApiDefinition -> OpenApi
getOpenApi :: OpenApi
, ApiDefinition -> PathMap
getPathMap :: PathMap
} deriving (ApiDefinition -> ApiDefinition -> Bool
(ApiDefinition -> ApiDefinition -> Bool)
-> (ApiDefinition -> ApiDefinition -> Bool) -> Eq ApiDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiDefinition -> ApiDefinition -> Bool
$c/= :: ApiDefinition -> ApiDefinition -> Bool
== :: ApiDefinition -> ApiDefinition -> Bool
$c== :: ApiDefinition -> ApiDefinition -> Bool
Eq, Int -> ApiDefinition -> ShowS
[ApiDefinition] -> ShowS
ApiDefinition -> String
(Int -> ApiDefinition -> ShowS)
-> (ApiDefinition -> String)
-> ([ApiDefinition] -> ShowS)
-> Show ApiDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiDefinition] -> ShowS
$cshowList :: [ApiDefinition] -> ShowS
show :: ApiDefinition -> String
$cshow :: ApiDefinition -> String
showsPrec :: Int -> ApiDefinition -> ShowS
$cshowsPrec :: Int -> ApiDefinition -> ShowS
Show)
toApiDefinition :: L.ByteString -> Maybe ApiDefinition
toApiDefinition :: ByteString -> Maybe ApiDefinition
toApiDefinition ByteString
openApiJson = OpenApi -> PathMap -> ApiDefinition
ApiDefinition (OpenApi -> PathMap -> ApiDefinition)
-> Maybe OpenApi -> Maybe (PathMap -> ApiDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OpenApi
mOpenApi Maybe (PathMap -> ApiDefinition)
-> Maybe PathMap -> Maybe ApiDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe PathMap
mPathMap
where
mOpenApi :: Maybe OpenApi
mOpenApi = ByteString -> Maybe OpenApi
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
openApiJson :: Maybe OpenApi
mKeys :: Maybe [String]
mKeys = InsOrdHashMap String PathItem -> [String]
forall k v. InsOrdHashMap k v -> [k]
keys (InsOrdHashMap String PathItem -> [String])
-> Maybe (InsOrdHashMap String PathItem) -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe OpenApi
mOpenApi Maybe OpenApi
-> Getting
(First (InsOrdHashMap String PathItem))
(Maybe OpenApi)
(InsOrdHashMap String PathItem)
-> Maybe (InsOrdHashMap String PathItem)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (OpenApi -> Const (First (InsOrdHashMap String PathItem)) OpenApi)
-> Maybe OpenApi
-> Const (First (InsOrdHashMap String PathItem)) (Maybe OpenApi)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((OpenApi -> Const (First (InsOrdHashMap String PathItem)) OpenApi)
-> Maybe OpenApi
-> Const (First (InsOrdHashMap String PathItem)) (Maybe OpenApi))
-> ((InsOrdHashMap String PathItem
-> Const
(First (InsOrdHashMap String PathItem))
(InsOrdHashMap String PathItem))
-> OpenApi
-> Const (First (InsOrdHashMap String PathItem)) OpenApi)
-> Getting
(First (InsOrdHashMap String PathItem))
(Maybe OpenApi)
(InsOrdHashMap String PathItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap String PathItem
-> Const
(First (InsOrdHashMap String PathItem))
(InsOrdHashMap String PathItem))
-> OpenApi -> Const (First (InsOrdHashMap String PathItem)) OpenApi
forall s a. HasPaths s a => Lens' s a
paths)
mPathMap :: Maybe PathMap
mPathMap = case Maybe [String]
mKeys of
Just [] -> Maybe PathMap
forall a. Maybe a
Nothing
Maybe [String]
_ -> [String] -> PathMap
makePathMap ([String] -> PathMap) -> Maybe [String] -> Maybe PathMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [String]
mKeys
newtype BodySchema = BodySchema { BodySchema -> Referenced Schema
toReferencedSchema :: Referenced Schema } deriving (BodySchema -> BodySchema -> Bool
(BodySchema -> BodySchema -> Bool)
-> (BodySchema -> BodySchema -> Bool) -> Eq BodySchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BodySchema -> BodySchema -> Bool
$c/= :: BodySchema -> BodySchema -> Bool
== :: BodySchema -> BodySchema -> Bool
$c== :: BodySchema -> BodySchema -> Bool
Eq, Int -> BodySchema -> ShowS
[BodySchema] -> ShowS
BodySchema -> String
(Int -> BodySchema -> ShowS)
-> (BodySchema -> String)
-> ([BodySchema] -> ShowS)
-> Show BodySchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodySchema] -> ShowS
$cshowList :: [BodySchema] -> ShowS
show :: BodySchema -> String
$cshow :: BodySchema -> String
showsPrec :: Int -> BodySchema -> ShowS
$cshowsPrec :: Int -> BodySchema -> ShowS
Show)
getRequestBodySchema :: ApiDefinition -> StdMethod -> FilePath -> Maybe BodySchema
getRequestBodySchema :: ApiDefinition -> StdMethod -> String -> Maybe BodySchema
getRequestBodySchema ApiDefinition
a StdMethod
DELETE String
p = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Maybe (Referenced Schema)
getRequestBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemDelete String
p
getRequestBodySchema ApiDefinition
a StdMethod
GET String
p = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Maybe (Referenced Schema)
getRequestBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemGet String
p
getRequestBodySchema ApiDefinition
a StdMethod
PATCH String
p = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Maybe (Referenced Schema)
getRequestBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemPatch String
p
getRequestBodySchema ApiDefinition
a StdMethod
POST String
p = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Maybe (Referenced Schema)
getRequestBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemPost String
p
getRequestBodySchema ApiDefinition
a StdMethod
PUT String
p = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Maybe (Referenced Schema)
getRequestBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemPut String
p
getRequestBodySchema ApiDefinition
_ StdMethod
_ String
_ = Maybe BodySchema
forall a. Maybe a
Nothing
getRequestBodyReferencedSchema :: ApiDefinition -> (PathItem -> Maybe Operation) -> FilePath -> Maybe (Referenced Schema)
getRequestBodyReferencedSchema :: ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Maybe (Referenced Schema)
getRequestBodyReferencedSchema ApiDefinition
apiDef PathItem -> Maybe Operation
pathItemMethod String
realPath =
let
openApi :: OpenApi
openApi = ApiDefinition -> OpenApi
getOpenApi ApiDefinition
apiDef
mDefinitionsRequestBody :: Maybe (Definitions RequestBody)
mDefinitionsRequestBody = OpenApi
openApi OpenApi
-> Getting
(First (Definitions RequestBody)) OpenApi (Definitions RequestBody)
-> Maybe (Definitions RequestBody)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Components -> Const (First (Definitions RequestBody)) Components)
-> OpenApi -> Const (First (Definitions RequestBody)) OpenApi
forall s a. HasComponents s a => Lens' s a
components ((Components -> Const (First (Definitions RequestBody)) Components)
-> OpenApi -> Const (First (Definitions RequestBody)) OpenApi)
-> ((Definitions RequestBody
-> Const
(First (Definitions RequestBody)) (Definitions RequestBody))
-> Components
-> Const (First (Definitions RequestBody)) Components)
-> Getting
(First (Definitions RequestBody)) OpenApi (Definitions RequestBody)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Definitions RequestBody
-> Const
(First (Definitions RequestBody)) (Definitions RequestBody))
-> Components -> Const (First (Definitions RequestBody)) Components
forall s a. HasRequestBodies s a => Lens' s a
requestBodies
mOperation :: Maybe Operation
mOperation = ApiDefinition -> String -> Maybe PathItem
getPathItem ApiDefinition
apiDef String
realPath Maybe PathItem -> (PathItem -> Maybe Operation) -> Maybe Operation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PathItem -> Maybe Operation
pathItemMethod
mReferencedRequestBody :: Maybe (Referenced RequestBody)
mReferencedRequestBody = Maybe Operation
mOperation Maybe Operation
-> Getting
(First (Referenced RequestBody))
(Maybe Operation)
(Referenced RequestBody)
-> Maybe (Referenced RequestBody)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Operation -> Const (First (Referenced RequestBody)) Operation)
-> Maybe Operation
-> Const (First (Referenced RequestBody)) (Maybe Operation)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Operation -> Const (First (Referenced RequestBody)) Operation)
-> Maybe Operation
-> Const (First (Referenced RequestBody)) (Maybe Operation))
-> ((Referenced RequestBody
-> Const (First (Referenced RequestBody)) (Referenced RequestBody))
-> Operation -> Const (First (Referenced RequestBody)) Operation)
-> Getting
(First (Referenced RequestBody))
(Maybe Operation)
(Referenced RequestBody)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Referenced RequestBody)
-> Const
(First (Referenced RequestBody)) (Maybe (Referenced RequestBody)))
-> Operation -> Const (First (Referenced RequestBody)) Operation
forall s a. HasRequestBody s a => Lens' s a
requestBody ((Maybe (Referenced RequestBody)
-> Const
(First (Referenced RequestBody)) (Maybe (Referenced RequestBody)))
-> Operation -> Const (First (Referenced RequestBody)) Operation)
-> ((Referenced RequestBody
-> Const (First (Referenced RequestBody)) (Referenced RequestBody))
-> Maybe (Referenced RequestBody)
-> Const
(First (Referenced RequestBody)) (Maybe (Referenced RequestBody)))
-> (Referenced RequestBody
-> Const (First (Referenced RequestBody)) (Referenced RequestBody))
-> Operation
-> Const (First (Referenced RequestBody)) Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referenced RequestBody
-> Const (First (Referenced RequestBody)) (Referenced RequestBody))
-> Maybe (Referenced RequestBody)
-> Const
(First (Referenced RequestBody)) (Maybe (Referenced RequestBody))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
mRequestBody :: Maybe RequestBody
mRequestBody = Definitions RequestBody -> Referenced RequestBody -> RequestBody
forall a. Definitions a -> Referenced a -> a
dereference (Definitions RequestBody -> Referenced RequestBody -> RequestBody)
-> Maybe (Definitions RequestBody)
-> Maybe (Referenced RequestBody -> RequestBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Definitions RequestBody)
mDefinitionsRequestBody Maybe (Referenced RequestBody -> RequestBody)
-> Maybe (Referenced RequestBody) -> Maybe RequestBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Referenced RequestBody)
mReferencedRequestBody
mReferencedSchema :: Maybe (Referenced Schema)
mReferencedSchema = Maybe RequestBody
mRequestBody Maybe RequestBody
-> Getting
(First (Referenced Schema)) (Maybe RequestBody) (Referenced Schema)
-> Maybe (Referenced Schema)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (RequestBody -> Const (First (Referenced Schema)) RequestBody)
-> Maybe RequestBody
-> Const (First (Referenced Schema)) (Maybe RequestBody)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((RequestBody -> Const (First (Referenced Schema)) RequestBody)
-> Maybe RequestBody
-> Const (First (Referenced Schema)) (Maybe RequestBody))
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> RequestBody -> Const (First (Referenced Schema)) RequestBody)
-> Getting
(First (Referenced Schema)) (Maybe RequestBody) (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> RequestBody -> Const (First (Referenced Schema)) RequestBody
forall s a. HasContent s a => Lens' s a
content ((InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> RequestBody -> Const (First (Referenced Schema)) RequestBody)
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> RequestBody
-> Const (First (Referenced Schema)) RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap MediaType MediaTypeObject)
-> Lens'
(InsOrdHashMap MediaType MediaTypeObject)
(Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap MediaType MediaTypeObject)
"application/json" ((Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject))
-> InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject))
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject))
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema)))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema)))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema)))
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
in
Maybe (Referenced Schema)
mReferencedSchema
getResponseBodySchema :: ApiDefinition -> StdMethod -> FilePath -> Int -> Maybe BodySchema
getResponseBodySchema :: ApiDefinition -> StdMethod -> String -> Int -> Maybe BodySchema
getResponseBodySchema ApiDefinition
a StdMethod
DELETE String
p Int
s = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Int
-> Maybe (Referenced Schema)
getResponseBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemDelete String
p Int
s
getResponseBodySchema ApiDefinition
a StdMethod
GET String
p Int
s = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Int
-> Maybe (Referenced Schema)
getResponseBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemGet String
p Int
s
getResponseBodySchema ApiDefinition
a StdMethod
PATCH String
p Int
s = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Int
-> Maybe (Referenced Schema)
getResponseBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemPatch String
p Int
s
getResponseBodySchema ApiDefinition
a StdMethod
POST String
p Int
s = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Int
-> Maybe (Referenced Schema)
getResponseBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemPost String
p Int
s
getResponseBodySchema ApiDefinition
a StdMethod
PUT String
p Int
s = Referenced Schema -> BodySchema
BodySchema (Referenced Schema -> BodySchema)
-> Maybe (Referenced Schema) -> Maybe BodySchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Int
-> Maybe (Referenced Schema)
getResponseBodyReferencedSchema ApiDefinition
a PathItem -> Maybe Operation
_pathItemPut String
p Int
s
getResponseBodySchema ApiDefinition
_ StdMethod
_ String
_ Int
_ = Maybe BodySchema
forall a. Maybe a
Nothing
getResponseBodyReferencedSchema :: ApiDefinition -> (PathItem -> Maybe Operation) -> FilePath -> Int -> Maybe (Referenced Schema)
getResponseBodyReferencedSchema :: ApiDefinition
-> (PathItem -> Maybe Operation)
-> String
-> Int
-> Maybe (Referenced Schema)
getResponseBodyReferencedSchema ApiDefinition
apiDef PathItem -> Maybe Operation
pathItemMethod String
realPath Int
statusCode =
let
openApi :: OpenApi
openApi = ApiDefinition -> OpenApi
getOpenApi ApiDefinition
apiDef
mDefinitionsResponse :: Maybe (Definitions Response)
mDefinitionsResponse = OpenApi
openApi OpenApi
-> Getting
(First (Definitions Response)) OpenApi (Definitions Response)
-> Maybe (Definitions Response)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Components -> Const (First (Definitions Response)) Components)
-> OpenApi -> Const (First (Definitions Response)) OpenApi
forall s a. HasComponents s a => Lens' s a
components ((Components -> Const (First (Definitions Response)) Components)
-> OpenApi -> Const (First (Definitions Response)) OpenApi)
-> ((Definitions Response
-> Const (First (Definitions Response)) (Definitions Response))
-> Components -> Const (First (Definitions Response)) Components)
-> Getting
(First (Definitions Response)) OpenApi (Definitions Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Definitions Response
-> Const (First (Definitions Response)) (Definitions Response))
-> Components -> Const (First (Definitions Response)) Components
forall s a. HasResponses s a => Lens' s a
responses
mOperation :: Maybe Operation
mOperation = ApiDefinition -> String -> Maybe PathItem
getPathItem ApiDefinition
apiDef String
realPath Maybe PathItem -> (PathItem -> Maybe Operation) -> Maybe Operation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PathItem -> Maybe Operation
pathItemMethod
mResponses :: Maybe Responses
mResponses = Maybe Operation
mOperation Maybe Operation
-> Getting (First Responses) (Maybe Operation) Responses
-> Maybe Responses
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Operation -> Const (First Responses) Operation)
-> Maybe Operation -> Const (First Responses) (Maybe Operation)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Operation -> Const (First Responses) Operation)
-> Maybe Operation -> Const (First Responses) (Maybe Operation))
-> ((Responses -> Const (First Responses) Responses)
-> Operation -> Const (First Responses) Operation)
-> Getting (First Responses) (Maybe Operation) Responses
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Responses -> Const (First Responses) Responses)
-> Operation -> Const (First Responses) Operation
forall s a. HasResponses s a => Lens' s a
responses
mReferencedResponse :: Maybe (Referenced Response)
mReferencedResponse = case Maybe Responses
mResponses Maybe Responses
-> Getting
(First (Referenced Response))
(Maybe Responses)
(Referenced Response)
-> Maybe (Referenced Response)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Responses -> Const (First (Referenced Response)) Responses)
-> Maybe Responses
-> Const (First (Referenced Response)) (Maybe Responses)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Responses -> Const (First (Referenced Response)) Responses)
-> Maybe Responses
-> Const (First (Referenced Response)) (Maybe Responses))
-> ((Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Responses -> Const (First (Referenced Response)) Responses)
-> Getting
(First (Referenced Response))
(Maybe Responses)
(Referenced Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Responses -> Lens' Responses (Maybe (IxValue Responses))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index Responses
statusCode ((Maybe (Referenced Response)
-> Const
(First (Referenced Response)) (Maybe (Referenced Response)))
-> Responses -> Const (First (Referenced Response)) Responses)
-> ((Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Maybe (Referenced Response)
-> Const
(First (Referenced Response)) (Maybe (Referenced Response)))
-> (Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Responses
-> Const (First (Referenced Response)) Responses
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Maybe (Referenced Response)
-> Const
(First (Referenced Response)) (Maybe (Referenced Response))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just of
Just Referenced Response
rr -> Referenced Response -> Maybe (Referenced Response)
forall a. a -> Maybe a
Just Referenced Response
rr
Maybe (Referenced Response)
Nothing -> Maybe Responses
mResponses Maybe Responses
-> Getting
(First (Referenced Response))
(Maybe Responses)
(Referenced Response)
-> Maybe (Referenced Response)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Responses -> Const (First (Referenced Response)) Responses)
-> Maybe Responses
-> Const (First (Referenced Response)) (Maybe Responses)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Responses -> Const (First (Referenced Response)) Responses)
-> Maybe Responses
-> Const (First (Referenced Response)) (Maybe Responses))
-> ((Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Responses -> Const (First (Referenced Response)) Responses)
-> Getting
(First (Referenced Response))
(Maybe Responses)
(Referenced Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Referenced Response)
-> Const
(First (Referenced Response)) (Maybe (Referenced Response)))
-> Responses -> Const (First (Referenced Response)) Responses
forall s a. HasDefault s a => Lens' s a
default_ ((Maybe (Referenced Response)
-> Const
(First (Referenced Response)) (Maybe (Referenced Response)))
-> Responses -> Const (First (Referenced Response)) Responses)
-> ((Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Maybe (Referenced Response)
-> Const
(First (Referenced Response)) (Maybe (Referenced Response)))
-> (Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Responses
-> Const (First (Referenced Response)) Responses
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referenced Response
-> Const (First (Referenced Response)) (Referenced Response))
-> Maybe (Referenced Response)
-> Const
(First (Referenced Response)) (Maybe (Referenced Response))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
mResponse :: Maybe Response
mResponse = Definitions Response -> Referenced Response -> Response
forall a. Definitions a -> Referenced a -> a
dereference (Definitions Response -> Referenced Response -> Response)
-> Maybe (Definitions Response)
-> Maybe (Referenced Response -> Response)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Definitions Response)
mDefinitionsResponse Maybe (Referenced Response -> Response)
-> Maybe (Referenced Response) -> Maybe Response
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Referenced Response)
mReferencedResponse
mReferencedSchema :: Maybe (Referenced Schema)
mReferencedSchema = Maybe Response
mResponse Maybe Response
-> Getting
(First (Referenced Schema)) (Maybe Response) (Referenced Schema)
-> Maybe (Referenced Schema)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Response -> Const (First (Referenced Schema)) Response)
-> Maybe Response
-> Const (First (Referenced Schema)) (Maybe Response)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Response -> Const (First (Referenced Schema)) Response)
-> Maybe Response
-> Const (First (Referenced Schema)) (Maybe Response))
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Response -> Const (First (Referenced Schema)) Response)
-> Getting
(First (Referenced Schema)) (Maybe Response) (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Const (First (Referenced Schema)) Response
forall s a. HasContent s a => Lens' s a
content ((InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Const (First (Referenced Schema)) Response)
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Response
-> Const (First (Referenced Schema)) Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap MediaType MediaTypeObject)
-> Lens'
(InsOrdHashMap MediaType MediaTypeObject)
(Maybe (IxValue (InsOrdHashMap MediaType MediaTypeObject)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap MediaType MediaTypeObject)
"application/json" ((Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject))
-> InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject))
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject))
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> InsOrdHashMap MediaType MediaTypeObject
-> Const
(First (Referenced Schema))
(InsOrdHashMap MediaType MediaTypeObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject))
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe MediaTypeObject
-> Const (First (Referenced Schema)) (Maybe MediaTypeObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema)))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject
forall s a. HasSchema s a => Lens' s a
schema ((Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema)))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject)
-> ((Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema)))
-> (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> MediaTypeObject
-> Const (First (Referenced Schema)) MediaTypeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referenced Schema
-> Const (First (Referenced Schema)) (Referenced Schema))
-> Maybe (Referenced Schema)
-> Const (First (Referenced Schema)) (Maybe (Referenced Schema))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
in
Maybe (Referenced Schema)
mReferencedSchema
getPathItem :: ApiDefinition -> FilePath -> Maybe PathItem
getPathItem :: ApiDefinition -> String -> Maybe PathItem
getPathItem ApiDefinition
apiDef String
realPath = Maybe String
mPath Maybe String -> (String -> Maybe PathItem) -> Maybe PathItem
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
definedPath -> OpenApi
openApi OpenApi
-> Getting (First PathItem) OpenApi PathItem -> Maybe PathItem
forall s a. s -> Getting (First a) s a -> Maybe a
^? (InsOrdHashMap String PathItem
-> Const (First PathItem) (InsOrdHashMap String PathItem))
-> OpenApi -> Const (First PathItem) OpenApi
forall s a. HasPaths s a => Lens' s a
paths ((InsOrdHashMap String PathItem
-> Const (First PathItem) (InsOrdHashMap String PathItem))
-> OpenApi -> Const (First PathItem) OpenApi)
-> ((PathItem -> Const (First PathItem) PathItem)
-> InsOrdHashMap String PathItem
-> Const (First PathItem) (InsOrdHashMap String PathItem))
-> Getting (First PathItem) OpenApi PathItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap String PathItem)
-> Lens'
(InsOrdHashMap String PathItem)
(Maybe (IxValue (InsOrdHashMap String PathItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at String
Index (InsOrdHashMap String PathItem)
definedPath ((Maybe PathItem -> Const (First PathItem) (Maybe PathItem))
-> InsOrdHashMap String PathItem
-> Const (First PathItem) (InsOrdHashMap String PathItem))
-> ((PathItem -> Const (First PathItem) PathItem)
-> Maybe PathItem -> Const (First PathItem) (Maybe PathItem))
-> (PathItem -> Const (First PathItem) PathItem)
-> InsOrdHashMap String PathItem
-> Const (First PathItem) (InsOrdHashMap String PathItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathItem -> Const (First PathItem) PathItem)
-> Maybe PathItem -> Const (First PathItem) (Maybe PathItem)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
where
openApi :: OpenApi
openApi = ApiDefinition -> OpenApi
getOpenApi ApiDefinition
apiDef
mPath :: Maybe String
mPath = String -> PathMap -> Maybe String
lookupDefinedPath String
realPath (PathMap -> Maybe String) -> PathMap -> Maybe String
forall a b. (a -> b) -> a -> b
$ ApiDefinition -> PathMap
getPathMap ApiDefinition
apiDef
validateJsonDocument :: ApiDefinition -> BodySchema -> L.ByteString -> Either String [String]
validateJsonDocument :: ApiDefinition -> BodySchema -> ByteString -> Either String [String]
validateJsonDocument ApiDefinition
apiDef BodySchema
bodySchema ByteString
dataJson = case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
dataJson :: Maybe Value of
Maybe Value
Nothing -> String -> Either String [String]
forall a b. a -> Either a b
Left String
"The document is not JSON."
Just Value
val -> case Maybe (Definitions Schema)
definitionsSchema' of
Maybe (Definitions Schema)
Nothing -> String -> Either String [String]
forall a b. a -> Either a b
Left String
"Schema objects are not defined in the OpenAPI document."
Just Definitions Schema
ds -> case Maybe Schema
schema' of
Maybe Schema
Nothing -> String -> Either String [String]
forall a b. a -> Either a b
Left String
"The schema for the data is not defined in the OpenAPI document."
Just Schema
s -> [String] -> Either String [String]
forall a b. b -> Either a b
Right ([String] -> Either String [String])
-> [String] -> Either String [String]
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
fixValidationError ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Definitions Schema -> Schema -> Value -> [String]
validateJSON Definitions Schema
ds Schema
s Value
val
where
openApi :: OpenApi
openApi = ApiDefinition -> OpenApi
getOpenApi ApiDefinition
apiDef
definitionsSchema' :: Maybe (Definitions Schema)
definitionsSchema' = OpenApi
openApi OpenApi
-> Getting
(First (Definitions Schema)) OpenApi (Definitions Schema)
-> Maybe (Definitions Schema)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Components -> Const (First (Definitions Schema)) Components)
-> OpenApi -> Const (First (Definitions Schema)) OpenApi
forall s a. HasComponents s a => Lens' s a
components ((Components -> Const (First (Definitions Schema)) Components)
-> OpenApi -> Const (First (Definitions Schema)) OpenApi)
-> ((Definitions Schema
-> Const (First (Definitions Schema)) (Definitions Schema))
-> Components -> Const (First (Definitions Schema)) Components)
-> Getting
(First (Definitions Schema)) OpenApi (Definitions Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Definitions Schema
-> Const (First (Definitions Schema)) (Definitions Schema))
-> Components -> Const (First (Definitions Schema)) Components
forall s a. HasSchemas s a => Lens' s a
schemas
referencedSchema' :: Referenced Schema
referencedSchema' = BodySchema -> Referenced Schema
toReferencedSchema BodySchema
bodySchema
schema' :: Maybe Schema
schema' = (Definitions Schema -> Referenced Schema -> Schema
forall a. Definitions a -> Referenced a -> a
`dereference` Referenced Schema
referencedSchema') (Definitions Schema -> Schema)
-> Maybe (Definitions Schema) -> Maybe Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Definitions Schema)
definitionsSchema'
fixValidationError :: String -> String
fixValidationError :: ShowS
fixValidationError String
msg = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text -> Text) -> Text -> [(Text, Text)] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Text) -> Text -> Text
replace' (String -> Text
T.pack String
msg) [(Text, Text)]
replacements
where
replace' :: (Text, Text) -> Text -> Text
replace' (Text
needle, Text
replacement) = Text -> Text -> Text -> Text
T.replace Text
needle Text
replacement
replacements :: [(Text, Text)]
replacements =
[ (Text
"OpenApiString", Text
"string")
, (Text
"OpenApiNumber", Text
"number")
, (Text
"OpenApiInteger", Text
"integer")
, (Text
"OpenApiBoolean", Text
"boolean")
]