module WebGear.Middlewares.Params
(
QueryParam
, QueryParam'
, ParamNotFound (..)
, ParamParseError (..)
, queryParam
, optionalQueryParam
, lenientQueryParam
, optionalLenientQueryParam
) where
import Control.Arrow (Kleisli (..))
import Control.Monad ((>=>))
import Data.List (find)
import Data.Proxy (Proxy (..))
import Data.String (fromString)
import Data.Text (Text)
import Data.Void (Void, absurd)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Network.HTTP.Types (queryToQueryText)
import Text.Printf (printf)
import Web.HttpApiData (FromHttpApiData (..))
import WebGear.Modifiers (Existence (..), ParseStyle (..))
import WebGear.Trait (Result (..), Trait (..), probe)
import WebGear.Types (MonadRouter (..), Request, RequestMiddleware', Response (..), badRequest400,
queryString)
import qualified Data.ByteString.Lazy as LBS
type QueryParam (name :: Symbol) val = QueryParam' Required Strict name val
data QueryParam' (e :: Existence) (p :: ParseStyle) (name :: Symbol) val
data ParamNotFound = ParamNotFound
deriving stock (ReadPrec [ParamNotFound]
ReadPrec ParamNotFound
Int -> ReadS ParamNotFound
ReadS [ParamNotFound]
(Int -> ReadS ParamNotFound)
-> ReadS [ParamNotFound]
-> ReadPrec ParamNotFound
-> ReadPrec [ParamNotFound]
-> Read ParamNotFound
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParamNotFound]
$creadListPrec :: ReadPrec [ParamNotFound]
readPrec :: ReadPrec ParamNotFound
$creadPrec :: ReadPrec ParamNotFound
readList :: ReadS [ParamNotFound]
$creadList :: ReadS [ParamNotFound]
readsPrec :: Int -> ReadS ParamNotFound
$creadsPrec :: Int -> ReadS ParamNotFound
Read, Int -> ParamNotFound -> ShowS
[ParamNotFound] -> ShowS
ParamNotFound -> String
(Int -> ParamNotFound -> ShowS)
-> (ParamNotFound -> String)
-> ([ParamNotFound] -> ShowS)
-> Show ParamNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamNotFound] -> ShowS
$cshowList :: [ParamNotFound] -> ShowS
show :: ParamNotFound -> String
$cshow :: ParamNotFound -> String
showsPrec :: Int -> ParamNotFound -> ShowS
$cshowsPrec :: Int -> ParamNotFound -> ShowS
Show, ParamNotFound -> ParamNotFound -> Bool
(ParamNotFound -> ParamNotFound -> Bool)
-> (ParamNotFound -> ParamNotFound -> Bool) -> Eq ParamNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamNotFound -> ParamNotFound -> Bool
$c/= :: ParamNotFound -> ParamNotFound -> Bool
== :: ParamNotFound -> ParamNotFound -> Bool
$c== :: ParamNotFound -> ParamNotFound -> Bool
Eq)
newtype ParamParseError = ParamParseError Text
deriving stock (ReadPrec [ParamParseError]
ReadPrec ParamParseError
Int -> ReadS ParamParseError
ReadS [ParamParseError]
(Int -> ReadS ParamParseError)
-> ReadS [ParamParseError]
-> ReadPrec ParamParseError
-> ReadPrec [ParamParseError]
-> Read ParamParseError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParamParseError]
$creadListPrec :: ReadPrec [ParamParseError]
readPrec :: ReadPrec ParamParseError
$creadPrec :: ReadPrec ParamParseError
readList :: ReadS [ParamParseError]
$creadList :: ReadS [ParamParseError]
readsPrec :: Int -> ReadS ParamParseError
$creadsPrec :: Int -> ReadS ParamParseError
Read, Int -> ParamParseError -> ShowS
[ParamParseError] -> ShowS
ParamParseError -> String
(Int -> ParamParseError -> ShowS)
-> (ParamParseError -> String)
-> ([ParamParseError] -> ShowS)
-> Show ParamParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamParseError] -> ShowS
$cshowList :: [ParamParseError] -> ShowS
show :: ParamParseError -> String
$cshow :: ParamParseError -> String
showsPrec :: Int -> ParamParseError -> ShowS
$cshowsPrec :: Int -> ParamParseError -> ShowS
Show, ParamParseError -> ParamParseError -> Bool
(ParamParseError -> ParamParseError -> Bool)
-> (ParamParseError -> ParamParseError -> Bool)
-> Eq ParamParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamParseError -> ParamParseError -> Bool
$c/= :: ParamParseError -> ParamParseError -> Bool
== :: ParamParseError -> ParamParseError -> Bool
$c== :: ParamParseError -> ParamParseError -> Bool
Eq)
deriveRequestParam :: (KnownSymbol name, FromHttpApiData val)
=> Proxy name -> Request -> (Maybe (Either Text val) -> r) -> r
deriveRequestParam :: Proxy name -> Request -> (Maybe (Either Text val) -> r) -> r
deriveRequestParam Proxy name
proxy Request
req Maybe (Either Text val) -> r
cont =
let name :: Text
name = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy name
proxy
params :: QueryText
params = Query -> QueryText
queryToQueryText (Query -> QueryText) -> Query -> QueryText
forall a b. (a -> b) -> a -> b
$ Request -> Query
queryString Request
req
in Maybe (Either Text val) -> r
cont (Maybe (Either Text val) -> r) -> Maybe (Either Text val) -> r
forall a b. (a -> b) -> a -> b
$ Text -> Either Text val
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam (Text -> Either Text val) -> Maybe Text -> Maybe (Either Text val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Text, Maybe Text) -> Bool)
-> QueryText -> Maybe (Text, Maybe Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) (Text -> Bool)
-> ((Text, Maybe Text) -> Text) -> (Text, Maybe Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Maybe Text) -> Text
forall a b. (a, b) -> a
fst) QueryText
params Maybe (Text, Maybe Text)
-> ((Text, Maybe Text) -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text, Maybe Text) -> Maybe Text
forall a b. (a, b) -> b
snd)
instance (KnownSymbol name, FromHttpApiData val, Monad m) => Trait (QueryParam' Required Strict name val) Request m where
type Attribute (QueryParam' Required Strict name val) Request = val
type Absence (QueryParam' Required Strict name val) Request = Either ParamNotFound ParamParseError
toAttribute :: Request -> m (Result (QueryParam' Required Strict name val) Request)
toAttribute :: Request
-> m (Result (QueryParam' 'Required 'Strict name val) Request)
toAttribute Request
r = Result (QueryParam' 'Required 'Strict name val) Request
-> m (Result (QueryParam' 'Required 'Strict name val) Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (QueryParam' 'Required 'Strict name val) Request
-> m (Result (QueryParam' 'Required 'Strict name val) Request))
-> Result (QueryParam' 'Required 'Strict name val) Request
-> m (Result (QueryParam' 'Required 'Strict name val) Request)
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Request
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Required 'Strict name val) Request)
-> Result (QueryParam' 'Required 'Strict name val) Request
forall (name :: Symbol) val r.
(KnownSymbol name, FromHttpApiData val) =>
Proxy name -> Request -> (Maybe (Either Text val) -> r) -> r
deriveRequestParam (Proxy name
forall k (t :: k). Proxy t
Proxy @name) Request
r ((Maybe (Either Text val)
-> Result (QueryParam' 'Required 'Strict name val) Request)
-> Result (QueryParam' 'Required 'Strict name val) Request)
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Required 'Strict name val) Request)
-> Result (QueryParam' 'Required 'Strict name val) Request
forall a b. (a -> b) -> a -> b
$ \case
Maybe (Either Text val)
Nothing -> Absence (QueryParam' 'Required 'Strict name val) Request
-> Result (QueryParam' 'Required 'Strict name val) Request
forall k (t :: k) a. Absence t a -> Result t a
NotFound (ParamNotFound -> Either ParamNotFound ParamParseError
forall a b. a -> Either a b
Left ParamNotFound
ParamNotFound)
Just (Left Text
e) -> Absence (QueryParam' 'Required 'Strict name val) Request
-> Result (QueryParam' 'Required 'Strict name val) Request
forall k (t :: k) a. Absence t a -> Result t a
NotFound (ParamParseError -> Either ParamNotFound ParamParseError
forall a b. b -> Either a b
Right (ParamParseError -> Either ParamNotFound ParamParseError)
-> ParamParseError -> Either ParamNotFound ParamParseError
forall a b. (a -> b) -> a -> b
$ Text -> ParamParseError
ParamParseError Text
e)
Just (Right val
x) -> Attribute (QueryParam' 'Required 'Strict name val) Request
-> Result (QueryParam' 'Required 'Strict name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found val
Attribute (QueryParam' 'Required 'Strict name val) Request
x
instance (KnownSymbol name, FromHttpApiData val, Monad m) => Trait (QueryParam' Optional Strict name val) Request m where
type Attribute (QueryParam' Optional Strict name val) Request = Maybe val
type Absence (QueryParam' Optional Strict name val) Request = ParamParseError
toAttribute :: Request -> m (Result (QueryParam' Optional Strict name val) Request)
toAttribute :: Request
-> m (Result (QueryParam' 'Optional 'Strict name val) Request)
toAttribute Request
r = Result (QueryParam' 'Optional 'Strict name val) Request
-> m (Result (QueryParam' 'Optional 'Strict name val) Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (QueryParam' 'Optional 'Strict name val) Request
-> m (Result (QueryParam' 'Optional 'Strict name val) Request))
-> Result (QueryParam' 'Optional 'Strict name val) Request
-> m (Result (QueryParam' 'Optional 'Strict name val) Request)
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Request
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Optional 'Strict name val) Request)
-> Result (QueryParam' 'Optional 'Strict name val) Request
forall (name :: Symbol) val r.
(KnownSymbol name, FromHttpApiData val) =>
Proxy name -> Request -> (Maybe (Either Text val) -> r) -> r
deriveRequestParam (Proxy name
forall k (t :: k). Proxy t
Proxy @name) Request
r ((Maybe (Either Text val)
-> Result (QueryParam' 'Optional 'Strict name val) Request)
-> Result (QueryParam' 'Optional 'Strict name val) Request)
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Optional 'Strict name val) Request)
-> Result (QueryParam' 'Optional 'Strict name val) Request
forall a b. (a -> b) -> a -> b
$ \case
Maybe (Either Text val)
Nothing -> Attribute (QueryParam' 'Optional 'Strict name val) Request
-> Result (QueryParam' 'Optional 'Strict name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found Attribute (QueryParam' 'Optional 'Strict name val) Request
forall a. Maybe a
Nothing
Just (Left Text
e) -> Absence (QueryParam' 'Optional 'Strict name val) Request
-> Result (QueryParam' 'Optional 'Strict name val) Request
forall k (t :: k) a. Absence t a -> Result t a
NotFound (Absence (QueryParam' 'Optional 'Strict name val) Request
-> Result (QueryParam' 'Optional 'Strict name val) Request)
-> Absence (QueryParam' 'Optional 'Strict name val) Request
-> Result (QueryParam' 'Optional 'Strict name val) Request
forall a b. (a -> b) -> a -> b
$ Text -> ParamParseError
ParamParseError Text
e
Just (Right val
x) -> Attribute (QueryParam' 'Optional 'Strict name val) Request
-> Result (QueryParam' 'Optional 'Strict name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found (val -> Maybe val
forall a. a -> Maybe a
Just val
x)
instance (KnownSymbol name, FromHttpApiData val, Monad m) => Trait (QueryParam' Required Lenient name val) Request m where
type Attribute (QueryParam' Required Lenient name val) Request = Either Text val
type Absence (QueryParam' Required Lenient name val) Request = ParamNotFound
toAttribute :: Request -> m (Result (QueryParam' Required Lenient name val) Request)
toAttribute :: Request
-> m (Result (QueryParam' 'Required 'Lenient name val) Request)
toAttribute Request
r = Result (QueryParam' 'Required 'Lenient name val) Request
-> m (Result (QueryParam' 'Required 'Lenient name val) Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (QueryParam' 'Required 'Lenient name val) Request
-> m (Result (QueryParam' 'Required 'Lenient name val) Request))
-> Result (QueryParam' 'Required 'Lenient name val) Request
-> m (Result (QueryParam' 'Required 'Lenient name val) Request)
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Request
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Required 'Lenient name val) Request)
-> Result (QueryParam' 'Required 'Lenient name val) Request
forall (name :: Symbol) val r.
(KnownSymbol name, FromHttpApiData val) =>
Proxy name -> Request -> (Maybe (Either Text val) -> r) -> r
deriveRequestParam (Proxy name
forall k (t :: k). Proxy t
Proxy @name) Request
r ((Maybe (Either Text val)
-> Result (QueryParam' 'Required 'Lenient name val) Request)
-> Result (QueryParam' 'Required 'Lenient name val) Request)
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Required 'Lenient name val) Request)
-> Result (QueryParam' 'Required 'Lenient name val) Request
forall a b. (a -> b) -> a -> b
$ \case
Maybe (Either Text val)
Nothing -> Absence (QueryParam' 'Required 'Lenient name val) Request
-> Result (QueryParam' 'Required 'Lenient name val) Request
forall k (t :: k) a. Absence t a -> Result t a
NotFound Absence (QueryParam' 'Required 'Lenient name val) Request
ParamNotFound
ParamNotFound
Just (Left Text
e) -> Attribute (QueryParam' 'Required 'Lenient name val) Request
-> Result (QueryParam' 'Required 'Lenient name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found (Text -> Either Text val
forall a b. a -> Either a b
Left Text
e)
Just (Right val
x) -> Attribute (QueryParam' 'Required 'Lenient name val) Request
-> Result (QueryParam' 'Required 'Lenient name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found (val -> Either Text val
forall a b. b -> Either a b
Right val
x)
instance (KnownSymbol name, FromHttpApiData val, Monad m) => Trait (QueryParam' Optional Lenient name val) Request m where
type Attribute (QueryParam' Optional Lenient name val) Request = Maybe (Either Text val)
type Absence (QueryParam' Optional Lenient name val) Request = Void
toAttribute :: Request -> m (Result (QueryParam' Optional Lenient name val) Request)
toAttribute :: Request
-> m (Result (QueryParam' 'Optional 'Lenient name val) Request)
toAttribute Request
r = Result (QueryParam' 'Optional 'Lenient name val) Request
-> m (Result (QueryParam' 'Optional 'Lenient name val) Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result (QueryParam' 'Optional 'Lenient name val) Request
-> m (Result (QueryParam' 'Optional 'Lenient name val) Request))
-> Result (QueryParam' 'Optional 'Lenient name val) Request
-> m (Result (QueryParam' 'Optional 'Lenient name val) Request)
forall a b. (a -> b) -> a -> b
$ Proxy name
-> Request
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Optional 'Lenient name val) Request)
-> Result (QueryParam' 'Optional 'Lenient name val) Request
forall (name :: Symbol) val r.
(KnownSymbol name, FromHttpApiData val) =>
Proxy name -> Request -> (Maybe (Either Text val) -> r) -> r
deriveRequestParam (Proxy name
forall k (t :: k). Proxy t
Proxy @name) Request
r ((Maybe (Either Text val)
-> Result (QueryParam' 'Optional 'Lenient name val) Request)
-> Result (QueryParam' 'Optional 'Lenient name val) Request)
-> (Maybe (Either Text val)
-> Result (QueryParam' 'Optional 'Lenient name val) Request)
-> Result (QueryParam' 'Optional 'Lenient name val) Request
forall a b. (a -> b) -> a -> b
$ \case
Maybe (Either Text val)
Nothing -> Attribute (QueryParam' 'Optional 'Lenient name val) Request
-> Result (QueryParam' 'Optional 'Lenient name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found Attribute (QueryParam' 'Optional 'Lenient name val) Request
forall a. Maybe a
Nothing
Just (Left Text
e) -> Attribute (QueryParam' 'Optional 'Lenient name val) Request
-> Result (QueryParam' 'Optional 'Lenient name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found (Either Text val -> Maybe (Either Text val)
forall a. a -> Maybe a
Just (Text -> Either Text val
forall a b. a -> Either a b
Left Text
e))
Just (Right val
x) -> Attribute (QueryParam' 'Optional 'Lenient name val) Request
-> Result (QueryParam' 'Optional 'Lenient name val) Request
forall k (t :: k) a. Attribute t a -> Result t a
Found (Either Text val -> Maybe (Either Text val)
forall a. a -> Maybe a
Just (val -> Either Text val
forall a b. b -> Either a b
Right val
x))
queryParam :: forall name val m req a. (KnownSymbol name, FromHttpApiData val, MonadRouter m)
=> RequestMiddleware' m req (QueryParam name val:req) a
queryParam :: RequestMiddleware' m req (QueryParam name val : req) a
queryParam Handler' m (QueryParam name val : req) a
handler = (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a))
-> (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall a b. (a -> b) -> a -> b
$ forall (ts :: [*]) a (m :: * -> *).
Trait (QueryParam name val) a m =>
Linked ts a
-> m (Either
(Absence (QueryParam name val) a)
(Linked (QueryParam name val : ts) a))
forall t (ts :: [*]) a (m :: * -> *).
Trait t a m =>
Linked ts a -> m (Either (Absence t a) (Linked (t : ts) a))
probe @(QueryParam name val) (Linked req Request
-> m (Either
(Either ParamNotFound ParamParseError)
(Linked (QueryParam name val : req) Request)))
-> (Either
(Either ParamNotFound ParamParseError)
(Linked (QueryParam name val : req) Request)
-> m (Response a))
-> Linked req Request
-> m (Response a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Either ParamNotFound ParamParseError -> m (Response a))
-> (Linked (QueryParam name val : req) Request -> m (Response a))
-> Either
(Either ParamNotFound ParamParseError)
(Linked (QueryParam name val : req) Request)
-> m (Response a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Response ByteString -> m (Response a)
forall (m :: * -> *) a. MonadRouter m => Response ByteString -> m a
errorResponse (Response ByteString -> m (Response a))
-> (Either ParamNotFound ParamParseError -> Response ByteString)
-> Either ParamNotFound ParamParseError
-> m (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParamNotFound ParamParseError -> Response ByteString
mkError) (Handler' m (QueryParam name val : req) a
-> Linked (QueryParam name val : req) Request -> m (Response a)
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Handler' m (QueryParam name val : req) a
handler)
where
paramName :: String
paramName :: String
paramName = Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ Proxy name
forall k (t :: k). Proxy t
Proxy @name
mkError :: Either ParamNotFound ParamParseError -> Response LBS.ByteString
mkError :: Either ParamNotFound ParamParseError -> Response ByteString
mkError Either ParamNotFound ParamParseError
err = ByteString -> Response ByteString
forall a. a -> Response a
badRequest400 (ByteString -> Response ByteString)
-> ByteString -> Response ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
case Either ParamNotFound ParamParseError
err of
Left ParamNotFound
ParamNotFound -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Could not find query parameter %s" String
paramName
Right (ParamParseError Text
_) -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Invalid value for query parameter %s" String
paramName
optionalQueryParam :: forall name val m req a. (KnownSymbol name, FromHttpApiData val, MonadRouter m)
=> RequestMiddleware' m req (QueryParam' Optional Strict name val:req) a
optionalQueryParam :: RequestMiddleware'
m req (QueryParam' 'Optional 'Strict name val : req) a
optionalQueryParam Handler' m (QueryParam' 'Optional 'Strict name val : req) a
handler = (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a))
-> (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall a b. (a -> b) -> a -> b
$ forall (ts :: [*]) a (m :: * -> *).
Trait (QueryParam' 'Optional 'Strict name val) a m =>
Linked ts a
-> m (Either
(Absence (QueryParam' 'Optional 'Strict name val) a)
(Linked (QueryParam' 'Optional 'Strict name val : ts) a))
forall t (ts :: [*]) a (m :: * -> *).
Trait t a m =>
Linked ts a -> m (Either (Absence t a) (Linked (t : ts) a))
probe @(QueryParam' Optional Strict name val) (Linked req Request
-> m (Either
ParamParseError
(Linked (QueryParam' 'Optional 'Strict name val : req) Request)))
-> (Either
ParamParseError
(Linked (QueryParam' 'Optional 'Strict name val : req) Request)
-> m (Response a))
-> Linked req Request
-> m (Response a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ParamParseError -> m (Response a))
-> (Linked (QueryParam' 'Optional 'Strict name val : req) Request
-> m (Response a))
-> Either
ParamParseError
(Linked (QueryParam' 'Optional 'Strict name val : req) Request)
-> m (Response a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Response ByteString -> m (Response a)
forall (m :: * -> *) a. MonadRouter m => Response ByteString -> m a
errorResponse (Response ByteString -> m (Response a))
-> (ParamParseError -> Response ByteString)
-> ParamParseError
-> m (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamParseError -> Response ByteString
mkError) (Handler' m (QueryParam' 'Optional 'Strict name val : req) a
-> Linked (QueryParam' 'Optional 'Strict name val : req) Request
-> m (Response a)
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Handler' m (QueryParam' 'Optional 'Strict name val : req) a
handler)
where
paramName :: String
paramName :: String
paramName = Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ Proxy name
forall k (t :: k). Proxy t
Proxy @name
mkError :: ParamParseError -> Response LBS.ByteString
mkError :: ParamParseError -> Response ByteString
mkError ParamParseError
_ = ByteString -> Response ByteString
forall a. a -> Response a
badRequest400 (ByteString -> Response ByteString)
-> ByteString -> Response ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Invalid value for query parameter %s" String
paramName
lenientQueryParam :: forall name val m req a. (KnownSymbol name, FromHttpApiData val, MonadRouter m)
=> RequestMiddleware' m req (QueryParam' Required Lenient name val:req) a
lenientQueryParam :: RequestMiddleware'
m req (QueryParam' 'Required 'Lenient name val : req) a
lenientQueryParam Handler' m (QueryParam' 'Required 'Lenient name val : req) a
handler = (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a))
-> (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall a b. (a -> b) -> a -> b
$
forall (ts :: [*]) a (m :: * -> *).
Trait (QueryParam' 'Required 'Lenient name val) a m =>
Linked ts a
-> m (Either
(Absence (QueryParam' 'Required 'Lenient name val) a)
(Linked (QueryParam' 'Required 'Lenient name val : ts) a))
forall t (ts :: [*]) a (m :: * -> *).
Trait t a m =>
Linked ts a -> m (Either (Absence t a) (Linked (t : ts) a))
probe @(QueryParam' Required Lenient name val) (Linked req Request
-> m (Either
ParamNotFound
(Linked (QueryParam' 'Required 'Lenient name val : req) Request)))
-> (Either
ParamNotFound
(Linked (QueryParam' 'Required 'Lenient name val : req) Request)
-> m (Response a))
-> Linked req Request
-> m (Response a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ParamNotFound -> m (Response a))
-> (Linked (QueryParam' 'Required 'Lenient name val : req) Request
-> m (Response a))
-> Either
ParamNotFound
(Linked (QueryParam' 'Required 'Lenient name val : req) Request)
-> m (Response a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Response ByteString -> m (Response a)
forall (m :: * -> *) a. MonadRouter m => Response ByteString -> m a
errorResponse (Response ByteString -> m (Response a))
-> (ParamNotFound -> Response ByteString)
-> ParamNotFound
-> m (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamNotFound -> Response ByteString
mkError) (Handler' m (QueryParam' 'Required 'Lenient name val : req) a
-> Linked (QueryParam' 'Required 'Lenient name val : req) Request
-> m (Response a)
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Handler' m (QueryParam' 'Required 'Lenient name val : req) a
handler)
where
paramName :: String
paramName :: String
paramName = Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ Proxy name
forall k (t :: k). Proxy t
Proxy @name
mkError :: ParamNotFound -> Response LBS.ByteString
mkError :: ParamNotFound -> Response ByteString
mkError ParamNotFound
ParamNotFound = ByteString -> Response ByteString
forall a. a -> Response a
badRequest400 (ByteString -> Response ByteString)
-> ByteString -> Response ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Could not find query parameter %s" String
paramName
optionalLenientQueryParam :: forall name val m req a. (KnownSymbol name, FromHttpApiData val, MonadRouter m)
=> RequestMiddleware' m req (QueryParam' Optional Lenient name val:req) a
optionalLenientQueryParam :: RequestMiddleware'
m req (QueryParam' 'Optional 'Lenient name val : req) a
optionalLenientQueryParam Handler' m (QueryParam' 'Optional 'Lenient name val : req) a
handler = (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a))
-> (Linked req Request -> m (Response a))
-> Kleisli m (Linked req Request) (Response a)
forall a b. (a -> b) -> a -> b
$
forall (ts :: [*]) a (m :: * -> *).
Trait (QueryParam' 'Optional 'Lenient name val) a m =>
Linked ts a
-> m (Either
(Absence (QueryParam' 'Optional 'Lenient name val) a)
(Linked (QueryParam' 'Optional 'Lenient name val : ts) a))
forall t (ts :: [*]) a (m :: * -> *).
Trait t a m =>
Linked ts a -> m (Either (Absence t a) (Linked (t : ts) a))
probe @(QueryParam' Optional Lenient name val) (Linked req Request
-> m (Either
Void
(Linked (QueryParam' 'Optional 'Lenient name val : req) Request)))
-> (Either
Void
(Linked (QueryParam' 'Optional 'Lenient name val : req) Request)
-> m (Response a))
-> Linked req Request
-> m (Response a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Void -> m (Response a))
-> (Linked (QueryParam' 'Optional 'Lenient name val : req) Request
-> m (Response a))
-> Either
Void
(Linked (QueryParam' 'Optional 'Lenient name val : req) Request)
-> m (Response a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> m (Response a)
forall a. Void -> a
absurd (Handler' m (QueryParam' 'Optional 'Lenient name val : req) a
-> Linked (QueryParam' 'Optional 'Lenient name val : req) Request
-> m (Response a)
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Handler' m (QueryParam' 'Optional 'Lenient name val : req) a
handler)