-- |
-- Copyright        : (c) Raghu Kaippully, 2020
-- License          : MPL-2.0
-- Maintainer       : rkaippully@gmail.com
--
-- Middlewares for handling query parameters
--
module WebGear.Middlewares.Params
  ( -- * Traits
    QueryParam
  , QueryParam'
  , ParamNotFound (..)
  , ParamParseError (..)

    -- * Middlewares
  , 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


-- | Capture a query parameter with a specified @name@ and convert it
-- to a value of type @val@ via 'FromHttpApiData'.
type QueryParam (name :: Symbol) val = QueryParam' Required Strict name val

-- | Capture a query parameter with a specified @name@ and convert it
-- to a value of type @val@ via 'FromHttpApiData'. The type parameter
-- @e@ denotes whether the query parameter is required to be
-- present. The parse style parameter @p@ determines whether the
-- conversion is applied strictly or leniently.
data QueryParam' (e :: Existence) (p :: ParseStyle) (name :: Symbol) val

-- | Indicates a missing query parameter
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)

-- | Error in converting a query parameter
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))


-- | A middleware to extract a query parameter and convert it to a
-- value of type @val@ using 'FromHttpApiData'.
--
-- Example usage:
--
-- > queryParam @"limit" @Int handler
--
-- The associated trait attribute has type @val@. This middleware will
-- respond with a 400 Bad Request response if the query parameter is
-- not found or could not be parsed.
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

-- | A middleware to extract an optional query parameter and convert
-- it to a value of type @val@ using 'FromHttpApiData'.
--
-- Example usage:
--
-- > optionalQueryParam @"limit" @Int handler
--
-- The associated trait attribute has type @Maybe val@; a @Nothing@
-- value indicates a missing param. A 400 Bad Request response is
-- returned if the query parameter could not be parsed.
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

-- | A middleware to extract a query parameter and convert it to a
-- value of type @val@ using 'FromHttpApiData'.
--
-- Example usage:
--
-- > lenientQueryParam @"limit" @Int handler
--
-- The associated trait attribute has type @Either Text val@. A 400
-- Bad Request reponse is returned if the query parameter is
-- missing. The parsing is done leniently; the trait attribute is set
-- to @Left Text@ in case of parse errors or @Right val@ on success.
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

-- | A middleware to extract an optional query parameter and convert it
-- to a value of type @val@ using 'FromHttpApiData'.
--
-- Example usage:
--
-- > optionalLenientHeader @"Content-Length" @Integer handler
--
-- The associated trait attribute has type @Maybe (Either Text
-- val)@. This middleware never fails.
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)