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

--
-- For reverse look up of path
-- https://swagger.io/specification/#path-templating-matching
--

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

-- | Convert FilePath to TemplatedPathComponent.
--
-- >>> toTemplatedPathComponent "foo"
-- Exact "foo"
-- >>> toTemplatedPathComponent "{foo}"
-- ParameterValue
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]

-- | Convert FilePath to TemplatedPath.
--
-- >>> toTemplatedPath "/foo/{fooId}"
-- [Exact "/",Exact "foo",ParameterValue]
-- >>> toTemplatedPath "/bar/{barId}/baz/{bazId}"
-- [Exact "/",Exact "bar",ParameterValue,Exact "baz",ParameterValue]
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

-- | Convert list of FilePath to PathMap.
--
-- >>> makePathMap ["/foo", "/foo/{fooId}"]
-- fromList [([Exact "/",Exact "foo"],"/foo"),([Exact "/",Exact "foo",ParameterValue],"/foo/{fooId}")]
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

-- | Look up a path (including a templated path) from PathMap.
--
-- >>> lookupDefinedPath "/foo" (makePathMap ["/foo", "/foo/{fooId}"])
-- Just "/foo"
-- >>> lookupDefinedPath "/foo/1" (makePathMap ["/foo", "/foo/{fooId}"])
-- Just "/foo/{fooId}"
-- >>> lookupDefinedPath "/bar" (makePathMap ["/foo", "/foo/{fooId}"])
-- Nothing
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)

-- | Create ApiDefinition instance from API document.
--
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
        -- OpenAPI Object must have `paths`
        -- https://swagger.io/specification/#openapi-object
        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)

-- | Get request body schema.
--
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

-- | Get response body schema.
--
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


-- | Validate JSON document.
--
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'

-- | Fix validation error message.
--
-- >>> fixValidationError "Hello, World!"
-- "Hello, World!"
-- >>> fixValidationError "expected JSON value of type OpenApiString"
-- "expected JSON value of type string"
-- >>> fixValidationError "expected JSON value of type OpenApiNumber"
-- "expected JSON value of type number"
-- >>> fixValidationError "expected JSON value of type OpenApiInteger"
-- "expected JSON value of type integer"
-- >>> fixValidationError "expected JSON value of type OpenApiBoolean"
-- "expected JSON value of type boolean"
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 =
        -- replace internal type name with OpenAPI standard type name
        [ (Text
"OpenApiString",  Text
"string")
        , (Text
"OpenApiNumber",  Text
"number")
        , (Text
"OpenApiInteger", Text
"integer")
        , (Text
"OpenApiBoolean", Text
"boolean")
        ]