{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

module Web.Spock.Api.Server (defEndpoint, defDocumentedEndpoint) where

import Control.Monad.Trans
import Data.Aeson (object, (.=))
import qualified Data.ByteString as BS
import qualified Data.CaseInsensitive as CI
import Data.HVect
import qualified Data.HVect as HV
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Types (status400)
import qualified Network.Wai as Wai
import Web.HttpApiData (FromHttpApiData, parseHeader, parseQueryParam)
import Web.Spock.Api
import Web.Spock.Api.Document
import Web.Spock.Core

-- | Wire an 'Endpoint' defined using the @Spock-api@ package
defEndpoint ::
  forall p i o m ctx.
  (MonadIO m, HasRep p) =>
  Endpoint p i o ->
  HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o)) ->
  SpockCtxT ctx m ()
defEndpoint :: forall (p :: [*]) (i :: Maybe (*)) o (m :: * -> *) ctx.
(MonadIO m, HasRep p) =>
Endpoint p i o
-> HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
-> SpockCtxT ctx m ()
defEndpoint Endpoint p i o
ep HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
handler =
  (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
forall (p :: [*]) (i :: Maybe (*)) o (m :: * -> *) ctx.
(MonadIO m, HasRep p) =>
(Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
defEndpointCore (Endpoint p i o
ep, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
step2)
  where
    step1 :: HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
    step1 :: HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
step1 = HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
-> HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
forall (ts :: [*]) a. HVectElim ts a -> HVect ts -> a
HV.uncurry HVectElim p (HVectElim (MaybeToList i) (ActionCtxT ctx m o))
handler

    step2 :: HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
    step2 :: HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
step2 HVect p
p = HVectElim (MaybeToList i) (ActionCtxT ctx m o)
-> HVect (MaybeToList i) -> ActionCtxT ctx m o
forall (ts :: [*]) a. HVectElim ts a -> HVect ts -> a
HV.uncurry (HVect p -> HVectElim (MaybeToList i) (ActionCtxT ctx m o)
step1 HVect p
p)

-- | Register a documented endpoint. Arguments are path captures, query/header
-- parameters in declaration order, then the JSON body (if any). Scalar
-- duplicates, missing required parameters, and malformed values return 400.
-- Like 'defEndpoint', this uses Spock-core routing; configure browser CSRF
-- protection explicitly if using cookie authentication.
defDocumentedEndpoint :: forall p q i o m ctx. (MonadIO m, HasRep p) =>
  DocumentedEndpoint p q i o ->
  HVectElim p (HVectElim q (HVectElim (MaybeToList i) (ActionCtxT ctx m o))) ->
  SpockCtxT ctx m ()
defDocumentedEndpoint :: forall (p :: [*]) (q :: [*]) (i :: Maybe (*)) o (m :: * -> *) ctx.
(MonadIO m, HasRep p) =>
DocumentedEndpoint p q i o
-> HVectElim
     p (HVectElim q (HVectElim (MaybeToList i) (ActionCtxT ctx m o)))
-> SpockCtxT ctx m ()
defDocumentedEndpoint DocumentedEndpoint p q i o
endpoint HVectElim
  p (HVectElim q (HVectElim (MaybeToList i) (ActionCtxT ctx m o)))
handler = do
  case 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 of
    Left (OpenApiError Text
message) -> IO () -> SpockCtxT ctx m ()
forall a. IO a -> SpockCtxT ctx m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SpockCtxT ctx m ()) -> IO () -> SpockCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall a. HasCallStack => IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
message
    Right () -> () -> SpockCtxT ctx m ()
forall a. a -> SpockCtxT ctx m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
forall (p :: [*]) (i :: Maybe (*)) o (m :: * -> *) ctx.
(MonadIO m, HasRep p) =>
(Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
defEndpointCore (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, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
run)
  where
    run :: HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
    run :: HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
run HVect p
pathValues HVect (MaybeToList i)
bodyValues = do
      req <- ActionCtxT ctx m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
request
      values <- case readParameters (de_parameters endpoint) req of
        Left Text
message -> Status -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
setStatus Status
status400 ActionCtxT ctx m ()
-> ActionCtxT ctx m (HVect q) -> ActionCtxT ctx m (HVect q)
forall a b.
ActionCtxT ctx m a -> ActionCtxT ctx m b -> ActionCtxT ctx m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> ActionCtxT ctx m (HVect q)
forall a (m :: * -> *) ctx b.
(ToJSON a, MonadIO m) =>
a -> ActionCtxT ctx m b
json ([(Key, Value)] -> Value
object [Key
"error" 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
message])
        Right HVect q
parsed -> HVect q -> ActionCtxT ctx m (HVect q)
forall a. a -> ActionCtxT ctx m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HVect q
parsed
      HV.uncurry (HV.uncurry (HV.uncurry handler pathValues) values) bodyValues

defEndpointCore ::
  forall p i o m ctx.
  (MonadIO m, HasRep p) =>
  (Endpoint p i o, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o) ->
  SpockCtxT ctx m ()
defEndpointCore :: forall (p :: [*]) (i :: Maybe (*)) o (m :: * -> *) ctx.
(MonadIO m, HasRep p) =>
(Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
-> SpockCtxT ctx m ()
defEndpointCore (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
t =
  case (Endpoint p i o,
 HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o)
t of
    (MethodGet Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
      let pf :: HVect p -> ActionCtxT ctx m ()
          pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args =
            do
              r <- HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler HVect p
args HVect '[]
HVect (MaybeToList i)
HNil
              json r
       in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
get Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)
    (MethodPost Proxy (i1 -> o)
_ Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
      let pf :: HVect p -> ActionCtxT ctx m ()
          pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args =
            do
              req <- ActionCtxT ctx m i1
forall (m :: * -> *) a ctx.
(MonadIO m, FromJSON a) =>
ActionCtxT ctx m a
jsonBody'
              r <- handler args (req :&: HNil)
              json r
       in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
post Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)
    (MethodPut Proxy (i1 -> o)
_ Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
      let pf :: HVect p -> ActionCtxT ctx m ()
          pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args =
            do
              req <- ActionCtxT ctx m i1
forall (m :: * -> *) a ctx.
(MonadIO m, FromJSON a) =>
ActionCtxT ctx m a
jsonBody'
              r <- handler args (req :&: HNil)
              json r
       in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
put Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)
    (MethodPatch Proxy (i1 -> o)
_ Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
      let pf :: HVect p -> ActionCtxT ctx m ()
          pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args = do
            req <- ActionCtxT ctx m i1
forall (m :: * -> *) a ctx.
(MonadIO m, FromJSON a) =>
ActionCtxT ctx m a
jsonBody'
            handler args (req :&: HNil) >>= json
       in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
patch Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)
    (MethodDelete Path p 'Open
path, HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler) ->
      let pf :: HVect p -> ActionCtxT ctx m ()
          pf :: HVect p -> ActionCtxT ctx m ()
pf HVect p
args = HVect p -> HVect (MaybeToList i) -> ActionCtxT ctx m o
handler HVect p
args HVect '[]
HVect (MaybeToList i)
HNil ActionCtxT ctx m o
-> (o -> ActionCtxT ctx m ()) -> ActionCtxT ctx m ()
forall a b.
ActionCtxT ctx m a
-> (a -> ActionCtxT ctx m b) -> ActionCtxT ctx m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= o -> ActionCtxT ctx m ()
forall a (m :: * -> *) ctx b.
(ToJSON a, MonadIO m) =>
a -> ActionCtxT ctx m b
json
       in Path p 'Open
-> HVectElim p (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
delete Path p 'Open
path ((HVect p -> ActionCtxT ctx m ())
-> HVectElim p (ActionCtxT ctx m ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect p -> ActionCtxT ctx m ()
pf)

readParameters :: Parameters q -> Wai.Request -> Either T.Text (HVect q)
readParameters :: forall (q :: [*]). Parameters q -> Request -> Either Text (HVect q)
readParameters Parameters q
NoParameters Request
_ = HVect q -> Either Text (HVect q)
forall a b. b -> Either a b
Right HVect q
HVect '[]
HNil
readParameters (Parameter a
parameter :> Parameters q1
rest) Request
req = a -> HVect q1 -> HVect q
a -> HVect q1 -> HVect (a : q1)
forall t (ts1 :: [*]). t -> HVect ts1 -> HVect (t : ts1)
(:&:) (a -> HVect q1 -> HVect q)
-> Either Text a -> Either Text (HVect q1 -> HVect q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parameter a -> Either Text a
forall a. Parameter a -> Either Text a
readParameter Parameter a
parameter Either Text (HVect q1 -> HVect q)
-> Either Text (HVect q1) -> Either Text (HVect q)
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parameters q1 -> Request -> Either Text (HVect q1)
forall (q :: [*]). Parameters q -> Request -> Either Text (HVect q)
readParameters Parameters q1
rest Request
req
  where
    readParameter :: Parameter a -> Either T.Text a
    readParameter :: forall a. Parameter a -> Either Text a
readParameter (QueryParam ParameterInfo a
info) = Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text a
forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text a
required Text
"query" ParameterInfo a
info ByteString -> Either Text a
forall a. FromHttpApiData a => ByteString -> Either Text a
parseQuery (ParameterInfo a -> [ByteString]
forall a. ParameterInfo a -> [ByteString]
queryValues ParameterInfo a
info)
    readParameter (OptionalQueryParam ParameterInfo a1
info) = Text
-> ParameterInfo a1
-> (ByteString -> Either Text a1)
-> [ByteString]
-> Either Text (Maybe a1)
forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text (Maybe a)
optional Text
"query" ParameterInfo a1
info ByteString -> Either Text a1
forall a. FromHttpApiData a => ByteString -> Either Text a
parseQuery (ParameterInfo a1 -> [ByteString]
forall a. ParameterInfo a -> [ByteString]
queryValues ParameterInfo a1
info)
    readParameter (QueryList ParameterInfo a1
info) = (ByteString -> Either Text a1) -> [ByteString] -> Either Text [a1]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text
-> ParameterInfo a1
-> (ByteString -> Either Text a1)
-> ByteString
-> Either Text a1
forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> ByteString
-> Either Text a
parseValue Text
"query" ParameterInfo a1
info ByteString -> Either Text a1
forall a. FromHttpApiData a => ByteString -> Either Text a
parseQuery) (ParameterInfo a1 -> [ByteString]
forall a. ParameterInfo a -> [ByteString]
queryValues ParameterInfo a1
info)
    readParameter (HeaderParam ParameterInfo a
info) = Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text a
forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text a
required Text
"header" ParameterInfo a
info ByteString -> Either Text a
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ParameterInfo a -> [ByteString]
forall a. ParameterInfo a -> [ByteString]
headerValues ParameterInfo a
info)
    readParameter (OptionalHeaderParam ParameterInfo a1
info) = Text
-> ParameterInfo a1
-> (ByteString -> Either Text a1)
-> [ByteString]
-> Either Text (Maybe a1)
forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text (Maybe a)
optional Text
"header" ParameterInfo a1
info ByteString -> Either Text a1
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ParameterInfo a1 -> [ByteString]
forall a. ParameterInfo a -> [ByteString]
headerValues ParameterInfo a1
info)
    queryValues :: ParameterInfo a -> [BS.ByteString]
    queryValues :: forall a. ParameterInfo a -> [ByteString]
queryValues ParameterInfo a
info = [ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
BS.empty Maybe ByteString
value | (ByteString
name, Maybe ByteString
value) <- Request -> Query
Wai.queryString Request
req, ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ByteString
T.encodeUtf8 (ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info)]
    headerValues :: ParameterInfo a -> [BS.ByteString]
    headerValues :: forall a. ParameterInfo a -> [ByteString]
headerValues ParameterInfo a
info = [ByteString
value | (CI ByteString
name, ByteString
value) <- Request -> RequestHeaders
Wai.requestHeaders Request
req, CI ByteString
name CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info)]

parseQuery :: FromHttpApiData a => BS.ByteString -> Either T.Text a
parseQuery :: forall a. FromHttpApiData a => ByteString -> Either Text a
parseQuery ByteString
value = case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
value of
  Left UnicodeException
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"Invalid UTF-8"
  Right Text
textValue -> Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
textValue

required :: T.Text -> ParameterInfo a -> (BS.ByteString -> Either T.Text a) -> [BS.ByteString] -> Either T.Text a
required :: forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text a
required Text
location ParameterInfo a
info ByteString -> Either Text a
parser [ByteString]
values = case [ByteString]
values of
  [] -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Missing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
location Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" parameter: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info
  [ByteString
value] -> Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> ByteString
-> Either Text a
forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> ByteString
-> Either Text a
parseValue Text
location ParameterInfo a
info ByteString -> Either Text a
parser ByteString
value
  [ByteString]
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Duplicate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
location Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" parameter: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info

optional :: T.Text -> ParameterInfo a -> (BS.ByteString -> Either T.Text a) -> [BS.ByteString] -> Either T.Text (Maybe a)
optional :: forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text (Maybe a)
optional Text
_ ParameterInfo a
_ ByteString -> Either Text a
_ [] = Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
optional Text
location ParameterInfo a
info ByteString -> Either Text a
parser [ByteString]
values = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either Text a -> Either Text (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text a
forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> [ByteString]
-> Either Text a
required Text
location ParameterInfo a
info ByteString -> Either Text a
parser [ByteString]
values

parseValue :: T.Text -> ParameterInfo a -> (BS.ByteString -> Either T.Text a) -> BS.ByteString -> Either T.Text a
parseValue :: forall a.
Text
-> ParameterInfo a
-> (ByteString -> Either Text a)
-> ByteString
-> Either Text a
parseValue Text
location ParameterInfo a
info ByteString -> Either Text a
parser ByteString
value = case ByteString -> Either Text a
parser ByteString
value of
  -- Do not include client-supplied values in error responses.
  Left Text
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Invalid " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
location Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" parameter: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParameterInfo a -> Text
forall a. ParameterInfo a -> Text
pi_name ParameterInfo a
info
  Right a
parsed -> a -> Either Text a
forall a b. b -> Either a b
Right a
parsed