Add QueryParamForm for Client, Server, Internal, Foreign, and SafeLink
This commit is contained in:
Erik Aker
parent
38f3da2499
commit
cffa511df9
19 changed files with 469 additions and 22 deletions
|
|
@ -79,6 +79,7 @@ library
|
|||
, base64-bytestring >= 1.0.0.1 && < 1.1
|
||||
, exceptions >= 0.10.0 && < 0.11
|
||||
, free >= 5.1 && < 5.2
|
||||
, http-api-data >= 0.4 && < 0.4.2
|
||||
, http-media >= 0.7.1.3 && < 0.9
|
||||
, http-types >= 0.12.2 && < 0.13
|
||||
, network-uri >= 2.6.1.0 && < 2.7
|
||||
|
|
|
|||
|
|
@ -55,6 +55,7 @@ module Servant.Client.Core
|
|||
, addHeader
|
||||
, appendToQueryString
|
||||
, appendToPath
|
||||
, concatQueryString
|
||||
, setRequestBodyLBS
|
||||
, setRequestBody
|
||||
) where
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ import Servant.API
|
|||
FromSourceIO (..), Header', Headers (..), HttpVersion,
|
||||
IsSecure, MimeRender (mimeRender),
|
||||
MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
|
||||
QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
|
||||
QueryParam', QueryParams, QueryParamForm', Raw, ReflectMethod (..), RemoteHost,
|
||||
ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,
|
||||
ToSourceIO (..), Vault, Verb, NoContentVerb, WithNamedContext,
|
||||
contentType, getHeadersHList, getResponse, toQueryParam,
|
||||
|
|
@ -57,6 +57,8 @@ import Servant.API.ContentTypes
|
|||
(contentTypes)
|
||||
import Servant.API.Modifiers
|
||||
(FoldRequired, RequiredArgument, foldRequiredArgument)
|
||||
import Web.FormUrlEncoded
|
||||
(ToForm (..))
|
||||
|
||||
import Servant.Client.Core.Auth
|
||||
import Servant.Client.Core.BasicAuth
|
||||
|
|
@ -534,6 +536,55 @@ instance (KnownSymbol sym, HasClient m api)
|
|||
hoistClientMonad pm _ f cl = \b ->
|
||||
hoistClientMonad pm (Proxy :: Proxy api) f (cl b)
|
||||
|
||||
-- | If you use a 'QueryParamForm' in one of your endpoints in your API,
|
||||
-- the corresponding querying function will automatically take
|
||||
-- an additional argument of the type specified by your 'QueryParamForm',
|
||||
-- enclosed in Maybe.
|
||||
--
|
||||
-- If you give Nothing, nothing will be added to the query string.
|
||||
--
|
||||
-- If you give a non-'Nothing' value, this function will take care
|
||||
-- of inserting a textual representation of your form in the query string.
|
||||
--
|
||||
-- You can control how values for your type are turned into
|
||||
-- text by specifying a 'ToForm' instance for your type.
|
||||
-- Example:
|
||||
--
|
||||
-- > data BookSearchParams = BookSearchParams
|
||||
-- > { title :: Text
|
||||
-- > , authors :: [Text]
|
||||
-- > , page :: Maybe Int
|
||||
-- > } deriving (Eq, Show, Generic)
|
||||
-- > instance ToForm BookSearchParams
|
||||
--
|
||||
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
|
||||
-- >
|
||||
-- > myApi :: Proxy MyApi
|
||||
-- > myApi = Proxy
|
||||
-- >
|
||||
-- > getBooks :: Bool -> ClientM [Book]
|
||||
-- > getBooks = client myApi
|
||||
-- > -- then you can just use "getBooks" to query that endpoint.
|
||||
-- > -- 'getBooksBy Nothing' for all books
|
||||
-- > -- 'getBooksBy (Just $ BookSearchParams "white noise" ["DeLillo"] Nothing)'
|
||||
instance (KnownSymbol sym, ToForm a, HasClient m api, SBoolI (FoldRequired mods))
|
||||
=> HasClient m (QueryParamForm' mods sym a :> api) where
|
||||
|
||||
type Client m (QueryParamForm' mods sym a :> api) =
|
||||
RequiredArgument mods a -> Client m api
|
||||
|
||||
-- if mparam = Nothing, we don't add it to the query string
|
||||
clientWithRoute pm Proxy req mparam =
|
||||
clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument
|
||||
(Proxy :: Proxy mods) add (maybe req add) mparam
|
||||
where
|
||||
add :: ToForm a => a -> Request
|
||||
add qForm = concatQueryString qForm req
|
||||
|
||||
hoistClientMonad pm _ f cl = \arg ->
|
||||
hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
|
||||
|
||||
|
||||
-- | Pick a 'Method' and specify where the server you want to query is. You get
|
||||
-- back the full `Response`.
|
||||
instance RunClient m => HasClient m Raw where
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ module Servant.Client.Core.Request (
|
|||
addHeader,
|
||||
appendToPath,
|
||||
appendToQueryString,
|
||||
concatQueryString,
|
||||
setRequestBody,
|
||||
setRequestBodyLBS,
|
||||
) where
|
||||
|
|
@ -50,9 +51,11 @@ import Network.HTTP.Media
|
|||
(MediaType)
|
||||
import Network.HTTP.Types
|
||||
(Header, HeaderName, HttpVersion (..), Method, QueryItem,
|
||||
http11, methodGet)
|
||||
http11, methodGet, parseQuery)
|
||||
import Servant.API
|
||||
(ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
|
||||
import Web.FormUrlEncoded
|
||||
(ToForm (..), urlEncodeAsForm)
|
||||
|
||||
import Servant.Client.Core.Internal (mediaTypeRnf)
|
||||
|
||||
|
|
@ -135,6 +138,14 @@ addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
|
|||
addHeader name val req
|
||||
= req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
|
||||
|
||||
concatQueryString :: ToForm a
|
||||
=> a
|
||||
-> Request
|
||||
-> Request
|
||||
concatQueryString form req
|
||||
= let querySeq = Seq.fromList . parseQuery . LBS.toStrict . urlEncodeAsForm $ form
|
||||
in req { requestQueryString = requestQueryString req Seq.>< querySeq }
|
||||
|
||||
-- | Set body and media type of the request being constructed.
|
||||
--
|
||||
-- The body is set to the given bytestring using the 'RequestBodyLBS'
|
||||
|
|
|
|||
|
|
@ -62,6 +62,7 @@ library
|
|||
, base-compat >= 0.10.5 && < 0.12
|
||||
, case-insensitive >= 1.2.0.11 && < 1.3
|
||||
, hashable >= 1.2.7.0 && < 1.4
|
||||
, http-api-data >= 0.4 && < 0.4.2
|
||||
, http-media >= 0.7.1.3 && < 0.9
|
||||
, http-types >= 0.12.2 && < 0.13
|
||||
, lens >= 4.17 && < 4.19
|
||||
|
|
@ -100,6 +101,7 @@ test-suite spec
|
|||
base
|
||||
, base-compat
|
||||
, aeson
|
||||
, http-api-data
|
||||
, lens
|
||||
, servant
|
||||
, servant-docs
|
||||
|
|
|
|||
|
|
@ -28,9 +28,12 @@ import Control.Lens
|
|||
(makeLenses, mapped, over, traversed, view, (%~), (&), (.~),
|
||||
(<>~), (^.), (|>))
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBSC
|
||||
import Data.ByteString.Lazy.Char8
|
||||
(ByteString)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import Data.Data
|
||||
(Data, toConstr, constrFields)
|
||||
import Data.Foldable
|
||||
(toList)
|
||||
import Data.Foldable
|
||||
|
|
@ -63,6 +66,8 @@ import GHC.TypeLits
|
|||
import Servant.API
|
||||
import Servant.API.ContentTypes
|
||||
import Servant.API.TypeLevel
|
||||
import Web.FormUrlEncoded
|
||||
(ToForm(..), urlEncodeAsForm)
|
||||
|
||||
import qualified Data.Universe.Helpers as U
|
||||
|
||||
|
|
@ -950,6 +955,27 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
|
|||
paramP = Proxy :: Proxy (QueryFlag sym)
|
||||
action' = over params (|> toParam paramP) action
|
||||
|
||||
-- | The docs for a @'QueryParamForm' sym a'@
|
||||
-- require the following instances for the `a`:
|
||||
-- 'Data', 'ToSample'
|
||||
instance (KnownSymbol sym, Data a, ToForm a, ToSample a, HasDocs api)
|
||||
=> HasDocs (QueryParamForm' mods sym a :> api) where
|
||||
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor subApiP (endpoint, action')
|
||||
|
||||
where subApiP = Proxy :: Proxy api
|
||||
action' =
|
||||
let (Just sampleForm) = toSample (Proxy :: Proxy a)
|
||||
paramNames = constrFields (toConstr sampleForm)
|
||||
sampleEncoding = LBSC.unpack . urlEncodeAsForm . toForm $ sampleForm
|
||||
in action & params <>~ (fmap (qParamMaker sampleEncoding) paramNames)
|
||||
qParamMaker formEncodedSample pName = DocQueryParam {
|
||||
_paramName = pName
|
||||
, _paramValues = [formEncodedSample]
|
||||
, _paramDesc = "Query parameter"
|
||||
, _paramKind = Normal
|
||||
}
|
||||
|
||||
instance HasDocs Raw where
|
||||
docsFor _proxy (endpoint, action) _ =
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
|
@ -21,6 +22,8 @@ import Control.Monad
|
|||
import Control.Monad.Trans.Writer
|
||||
(Writer, runWriter, tell)
|
||||
import Data.Aeson
|
||||
import Data.Data
|
||||
(Data)
|
||||
import Data.List
|
||||
(isInfixOf)
|
||||
import Data.Proxy
|
||||
|
|
@ -35,6 +38,8 @@ import Test.Tasty.Golden
|
|||
(goldenVsString)
|
||||
import Test.Tasty.HUnit
|
||||
(Assertion, HasCallStack, assertFailure, testCase, (@?=))
|
||||
import Web.FormUrlEncoded
|
||||
(ToForm)
|
||||
|
||||
import Servant.API
|
||||
import Servant.Docs.Internal
|
||||
|
|
@ -52,6 +57,8 @@ instance ToParam (QueryParam' mods "bar" Int) where
|
|||
toParam _ = DocQueryParam "bar" ["1","2","3"] "QueryParams Int" Normal
|
||||
instance ToParam (QueryParams "foo" Int) where
|
||||
toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" List
|
||||
instance ToParam (QueryParam "query" String) where
|
||||
toParam _ = DocQueryParam "query" ["a","b","c"] "QueryParams String" Normal
|
||||
instance ToParam (QueryFlag "foo") where
|
||||
toParam _ = DocQueryParam "foo" [] "QueryFlag" Flag
|
||||
instance ToCapture (Capture "foo" Int) where
|
||||
|
|
@ -76,7 +83,7 @@ spec = describe "Servant.Docs" $ do
|
|||
(defAction & notes <>~ [DocNote "Get an Integer" ["get an integer in Json or plain text"]])
|
||||
<>
|
||||
extraInfo
|
||||
(Proxy :: Proxy (ReqBody '[JSON] String :> Post '[JSON] Datatype1))
|
||||
(Proxy :: Proxy ("postJson" :> ReqBody '[JSON] String :> Post '[JSON] Datatype1))
|
||||
(defAction & notes <>~ [DocNote "Post data" ["Posts some Json data"]])
|
||||
md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1))
|
||||
tests md
|
||||
|
|
@ -119,6 +126,12 @@ spec = describe "Servant.Docs" $ do
|
|||
md `shouldContain` "## POST"
|
||||
md `shouldContain` "## GET"
|
||||
|
||||
it "should mention the endpoints" $ do
|
||||
md `shouldContain` "## POST /postJson"
|
||||
md `shouldContain` "## GET /qparam"
|
||||
md `shouldContain` "## GET /qparamform"
|
||||
md `shouldContain` "## PUT /header"
|
||||
|
||||
it "mentions headers" $ do
|
||||
md `shouldContain` "- This endpoint is sensitive to the value of the **X-Test** HTTP header."
|
||||
|
||||
|
|
@ -127,6 +140,15 @@ spec = describe "Servant.Docs" $ do
|
|||
it "contains request body samples" $
|
||||
md `shouldContain` "17"
|
||||
|
||||
it "mentions optional query-param" $ do
|
||||
md `shouldContain` "### GET Parameters:"
|
||||
md `shouldContain` "- query"
|
||||
it "mentions optional query-param-form params from QueryParamForm" $ do
|
||||
md `shouldContain` "- dt1field1"
|
||||
md `shouldContain` "- dt1field2"
|
||||
-- contains sample url-encoded form
|
||||
md `shouldContain` "- **Values**: *dt1field1=field%201&dt1field2=13*"
|
||||
|
||||
it "does not generate any docs mentioning the 'empty-api' path" $
|
||||
md `shouldNotContain` "empty-api"
|
||||
|
||||
|
|
@ -135,9 +157,10 @@ spec = describe "Servant.Docs" $ do
|
|||
|
||||
data Datatype1 = Datatype1 { dt1field1 :: String
|
||||
, dt1field2 :: Int
|
||||
} deriving (Eq, Show, Generic)
|
||||
} deriving (Eq, Show, Data, Generic)
|
||||
|
||||
instance ToJSON Datatype1
|
||||
instance ToForm Datatype1
|
||||
|
||||
instance ToSample Datatype1 where
|
||||
toSamples _ = singleSample $ Datatype1 "field 1" 13
|
||||
|
|
@ -152,8 +175,10 @@ instance MimeRender PlainText Int where
|
|||
mimeRender _ = cs . show
|
||||
|
||||
type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
|
||||
:<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
|
||||
:<|> Header "X-Test" Int :> Put '[JSON] Int
|
||||
:<|> "postJson" :> ReqBody '[JSON] String :> Post '[JSON] Datatype1
|
||||
:<|> "qparam" :> QueryParam "query" String :> Get '[JSON] Datatype1
|
||||
:<|> "qparamform" :> QueryParamForm "form" Datatype1 :> Get '[JSON] Datatype1
|
||||
:<|> "header" :> Header "X-Test" Int :> Put '[JSON] Int
|
||||
:<|> "empty-api" :> EmptyAPI
|
||||
|
||||
data TT = TT1 | TT2 deriving (Show, Eq)
|
||||
|
|
|
|||
|
|
@ -88,6 +88,7 @@ data ArgType
|
|||
= Normal
|
||||
| Flag
|
||||
| List
|
||||
| Form
|
||||
deriving (Data, Eq, Show, Typeable)
|
||||
|
||||
makePrisms ''ArgType
|
||||
|
|
@ -324,6 +325,19 @@ instance
|
|||
{ _argName = PathSegment str
|
||||
, _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
|
||||
|
||||
instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (QueryParamForm' mods sym a :> api) where
|
||||
type Foreign ftype (QueryParamForm' mods sym a :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang Proxy Proxy req =
|
||||
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg arg Form]
|
||||
where
|
||||
arg = Arg
|
||||
{ _argName = PathSegment ""
|
||||
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy (RequiredArgument mods a)) }
|
||||
|
||||
|
||||
instance HasForeign lang ftype Raw where
|
||||
type Foreign ftype Raw = HTTP.Method -> Req ftype
|
||||
|
||||
|
|
|
|||
|
|
@ -68,9 +68,21 @@ instance {-# OVERLAPPABLE #-} HasForeignType LangX String a => HasForeignType La
|
|||
instance (HasForeignType LangX String a) => HasForeignType LangX String (Maybe a) where
|
||||
typeFor lang ftype _ = "maybe " <> typeFor lang ftype (Proxy :: Proxy a)
|
||||
|
||||
data ContactForm = ContactForm {
|
||||
name :: String
|
||||
, message :: String
|
||||
, email :: String
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance HasForeignType LangX String ContactForm where
|
||||
typeFor _ _ _ = "contactFormX"
|
||||
|
||||
|
||||
|
||||
type TestApi
|
||||
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
|
||||
:<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
|
||||
:<|> "test" :> QueryParamForm "contact" ContactForm :> Post '[JSON] NoContent
|
||||
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
|
||||
:<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
|
||||
:<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]
|
||||
|
|
@ -82,9 +94,9 @@ testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: P
|
|||
listFromAPISpec :: Spec
|
||||
listFromAPISpec = describe "listFromAPI" $ do
|
||||
it "generates 5 endpoints for TestApi" $ do
|
||||
length testApi `shouldBe` 5
|
||||
length testApi `shouldBe` 6
|
||||
|
||||
let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi
|
||||
let [getReq, postReq, contactReq, putReq, deleteReq, captureAllReq] = testApi
|
||||
|
||||
it "collects all info for get request" $ do
|
||||
shouldBe getReq $ defReq
|
||||
|
|
@ -110,6 +122,17 @@ listFromAPISpec = describe "listFromAPI" $ do
|
|||
, _reqFuncName = FunctionName ["post", "test"]
|
||||
}
|
||||
|
||||
it "collects all info for a queryparamform" $ do
|
||||
shouldBe contactReq $ defReq
|
||||
{ _reqUrl = Url
|
||||
[ Segment $ Static "test" ]
|
||||
[ QueryArg (Arg "" "maybe contactFormX") Form ]
|
||||
, _reqMethod = "POST"
|
||||
, _reqHeaders = []
|
||||
, _reqReturnType = Just "voidX"
|
||||
, _reqFuncName = FunctionName ["post", "test"]
|
||||
}
|
||||
|
||||
it "collects all info for put request" $ do
|
||||
shouldBe putReq $ defReq
|
||||
{ _reqUrl = Url
|
||||
|
|
@ -148,3 +171,4 @@ listFromAPISpec = describe "listFromAPI" $ do
|
|||
, _reqReturnType = Just "listX of intX"
|
||||
, _reqFuncName = FunctionName ["get", "test", "by", "ids"]
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ import Control.Concurrent
|
|||
import Control.DeepSeq
|
||||
(NFData (..))
|
||||
import Control.Exception
|
||||
(bracket, fromException, IOException)
|
||||
(IOException, bracket, fromException)
|
||||
import Control.Monad.Error.Class
|
||||
(throwError)
|
||||
import Data.Aeson
|
||||
|
|
@ -64,7 +64,8 @@ import Servant.API
|
|||
BasicAuthData (..), Capture, CaptureAll, Delete,
|
||||
DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,
|
||||
Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,
|
||||
QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)
|
||||
QueryParam, QueryParamForm, QueryParams, Raw, ReqBody,
|
||||
addHeader, getHeaders)
|
||||
import qualified Servant.Client.Core.Auth as Auth
|
||||
import qualified Servant.Client.Core.Request as Req
|
||||
import Servant.HttpStreams
|
||||
|
|
@ -110,6 +111,14 @@ alice = Person "Alice" 42
|
|||
carol :: Person
|
||||
carol = Person "Carol" 17
|
||||
|
||||
data PersonSearch = PersonSearch
|
||||
{ nameStartsWith :: String
|
||||
, ageGreaterThan :: Integer
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToForm PersonSearch
|
||||
instance FromForm PersonSearch
|
||||
|
||||
type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
|
||||
|
||||
type Api =
|
||||
|
|
@ -121,6 +130,7 @@ type Api =
|
|||
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
|
||||
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
|
||||
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
|
||||
:<|> "paramform" :> QueryParamForm "names" PersonSearch :> Get '[JSON] [Person]
|
||||
:<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
|
||||
:<|> "rawSuccess" :> Raw
|
||||
:<|> "rawFailure" :> Raw
|
||||
|
|
@ -146,6 +156,7 @@ getCaptureAll :: [String] -> ClientM [Person]
|
|||
getBody :: Person -> ClientM Person
|
||||
getQueryParam :: Maybe String -> ClientM Person
|
||||
getQueryParams :: [String] -> ClientM [Person]
|
||||
getQueryParamForm :: Maybe PersonSearch -> ClientM [Person]
|
||||
getQueryFlag :: Bool -> ClientM Bool
|
||||
getRawSuccess :: HTTP.Method -> ClientM Response
|
||||
getRawFailure :: HTTP.Method -> ClientM Response
|
||||
|
|
@ -163,6 +174,7 @@ getRoot
|
|||
:<|> getBody
|
||||
:<|> getQueryParam
|
||||
:<|> getQueryParams
|
||||
:<|> getQueryParamForm
|
||||
:<|> getQueryFlag
|
||||
:<|> getRawSuccess
|
||||
:<|> getRawFailure
|
||||
|
|
@ -185,6 +197,10 @@ server = serve api (
|
|||
Just n -> throwError $ ServerError 400 (n ++ " not found") "" []
|
||||
Nothing -> throwError $ ServerError 400 "missing parameter" "" [])
|
||||
:<|> (\ names -> return (zipWith Person names [0..]))
|
||||
:<|> (\ psearch -> case psearch of
|
||||
Just (Right psearch) -> return [alice, carol]
|
||||
Just (Left err) -> throwError $ ServerError 400 "failed to decode form" "" []
|
||||
Nothing -> return [])
|
||||
:<|> return
|
||||
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
|
||||
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
|
||||
|
|
@ -305,6 +321,11 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
|||
left show <$> runClient (getQueryParams ["alice", "bob"]) baseUrl
|
||||
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
|
||||
|
||||
it "Servant.API.QueryParam.QueryParamForm" $ \(_, baseUrl) -> do
|
||||
left show <$> runClient (getQueryParamForm Nothing) baseUrl `shouldReturn` Right []
|
||||
left show <$> runClient (getQueryParamForm (Just $ PersonSearch "a" 10)) baseUrl
|
||||
`shouldReturn` Right [alice, carol]
|
||||
|
||||
context "Servant.API.QueryParam.QueryFlag" $
|
||||
forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
|
||||
left show <$> runClient (getQueryFlag flag) baseUrl `shouldReturn` Right flag
|
||||
|
|
|
|||
|
|
@ -148,6 +148,7 @@ test-suite spec
|
|||
, base-compat
|
||||
, base64-bytestring
|
||||
, bytestring
|
||||
, http-api-data
|
||||
, http-types
|
||||
, mtl
|
||||
, resourcet
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ import Servant.API
|
|||
((:<|>) (..), (:>), Accept (..), BasicAuth, Capture',
|
||||
CaptureAll, Description, EmptyAPI, FramingRender (..),
|
||||
FramingUnrender (..), FromSourceIO (..), Header', If,
|
||||
IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw,
|
||||
IsSecure (..), QueryFlag, QueryParam', QueryParamForm', QueryParams, Raw,
|
||||
ReflectMethod (reflectMethod), RemoteHost, ReqBody',
|
||||
SBool (..), SBoolI (..), SourceIO, Stream, StreamBody',
|
||||
Summary, ToSourceIO (..), Vault, Verb, NoContentVerb,
|
||||
|
|
@ -86,6 +86,8 @@ import Servant.API.Modifiers
|
|||
unfoldRequestArgument)
|
||||
import Servant.API.ResponseHeaders
|
||||
(GetHeaders, Headers, getHeaders, getResponse)
|
||||
import Web.FormUrlEncoded
|
||||
(FromForm(..), urlDecodeAsForm)
|
||||
import qualified Servant.Types.SourceT as S
|
||||
import Web.HttpApiData
|
||||
(FromHttpApiData, parseHeader, parseQueryParam,
|
||||
|
|
@ -556,6 +558,73 @@ instance (KnownSymbol sym, HasServer api context)
|
|||
examine v | v == "true" || v == "1" || v == "" = True
|
||||
| otherwise = False
|
||||
|
||||
-- | If you define a custom record type, for example @BookSearchParams@, then you can use
|
||||
-- @'QueryParamForm' "formName" BookSearchParams@ in one of the endpoints for your API
|
||||
-- to translate a collection of query-string parameters into a value of your record type.
|
||||
--
|
||||
-- Your server-side handler must be a function that takes an argument of type
|
||||
-- @'Maybe' ('Either' BookSearchParams)@.
|
||||
--
|
||||
-- You can control how the individual values are converted from the query string
|
||||
-- into a value of your type by simply providing an instance of 'FromForm' for your type.
|
||||
-- All of the record's values utilize 'FromHttpApiData'.
|
||||
--
|
||||
-- Note: anytime you use a 'QueryParamForm', your server will assume it's present
|
||||
-- if the query-string is non-empty. This modifier does not check if any specific
|
||||
-- keys from the record are present: it just attempts to 'urlDecodeAsForm' the whole query
|
||||
-- string if any query-string parameters have been provided.
|
||||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > data BookSearchParams = BookSearchParams
|
||||
-- > { title :: Text
|
||||
-- > , authors :: [Text]
|
||||
-- > , page :: Maybe Int
|
||||
-- > } deriving (Eq, Show, Generic)
|
||||
-- > instance FromForm BookSearchParams
|
||||
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
|
||||
--
|
||||
-- Example Handler Signature:
|
||||
-- Maybe (Either Text BookSearchParams) -> Handler [Book]
|
||||
instance
|
||||
( KnownSymbol sym, FromForm a, HasServer api context
|
||||
, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)
|
||||
)
|
||||
=> HasServer (QueryParamForm' mods sym a :> api) context where
|
||||
------
|
||||
type ServerT (QueryParamForm' mods sym a :> api) m =
|
||||
RequestArgument mods a -> ServerT api m
|
||||
|
||||
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
|
||||
|
||||
route Proxy context subserver =
|
||||
|
||||
let formName = cs $ symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
parseParamForm req =
|
||||
unfoldRequestArgument (Proxy :: Proxy mods) errReq errSt mev
|
||||
where
|
||||
rawQS = rawQueryString req
|
||||
|
||||
mev :: Maybe (Either T.Text a)
|
||||
mev = case B.length rawQS of
|
||||
0 -> Nothing
|
||||
_ -> Just $ urlDecodeAsForm (BL.drop 1 . BL.fromStrict $ rawQS)
|
||||
|
||||
errReq = delayedFailFatal err400
|
||||
{ errBody = cs $ "Query parameter form " <> formName <> " is required"
|
||||
}
|
||||
|
||||
errSt e = delayedFailFatal err400
|
||||
{ errBody = cs $ "Error parsing query parameter form "
|
||||
<> formName <> " failed: " <> e
|
||||
}
|
||||
|
||||
delayed = addParameterCheck subserver . withRequest $ \req ->
|
||||
parseParamForm req
|
||||
|
||||
in route (Proxy :: Proxy api) context delayed
|
||||
|
||||
-- | Just pass the request to the underlying application and serve its response.
|
||||
--
|
||||
-- Example:
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ import Servant.API
|
|||
BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete,
|
||||
EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
|
||||
JSON, NoContent (..), NoFraming, OctetStream, Patch,
|
||||
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
||||
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, QueryParamForm, Raw,
|
||||
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,
|
||||
NoContentVerb, addHeader)
|
||||
import Servant.Server
|
||||
|
|
@ -63,6 +63,8 @@ import Test.Hspec.Wai
|
|||
(get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
|
||||
with, (<:>))
|
||||
import qualified Test.Hspec.Wai as THW
|
||||
import Web.FormUrlEncoded
|
||||
(FromForm)
|
||||
|
||||
import Servant.Server.Experimental.Auth
|
||||
(AuthHandler, AuthServerData, mkAuthHandler)
|
||||
|
|
@ -88,6 +90,7 @@ spec = do
|
|||
captureSpec
|
||||
captureAllSpec
|
||||
queryParamSpec
|
||||
queryParamFormSpec
|
||||
reqBodySpec
|
||||
headerSpec
|
||||
rawSpec
|
||||
|
|
@ -451,6 +454,124 @@ queryParamSpec = do
|
|||
name = "Alice"
|
||||
}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- * queryParamFormSpec {{{
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
data AnimalSearch = AnimalSearch {
|
||||
sName :: String
|
||||
, sLegs :: Integer
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromForm AnimalSearch
|
||||
|
||||
type QueryParamFormApi =
|
||||
QueryParamForm "octopus" AnimalSearch :> Get '[JSON] Animal
|
||||
:<|> "before-param"
|
||||
:> QueryParam "before" Bool
|
||||
:> QueryParamForm "before" AnimalSearch
|
||||
:> Get '[JSON] Animal
|
||||
:<|> "mixed-param"
|
||||
:> QueryParam "before" Bool
|
||||
:> QueryParamForm "multiple" AnimalSearch
|
||||
:> QueryParam "after" Bool
|
||||
:> Get '[JSON] Animal
|
||||
|
||||
queryParamFormApi :: Proxy QueryParamFormApi
|
||||
queryParamFormApi = Proxy
|
||||
|
||||
qpFormServer :: Server QueryParamFormApi
|
||||
qpFormServer = searchAnimal :<|> searchWithBeforeParms :<|> searchWithAroundParms
|
||||
|
||||
where searchAnimal (Just (Right search)) = return $ Animal { species = sName search, numberOfLegs = sLegs search}
|
||||
searchAnimal (Just (Left _)) = return $ Animal { species = "broken", numberOfLegs = 0}
|
||||
searchAnimal Nothing = return bimac
|
||||
|
||||
searchWithBeforeParms (Just _) (Just (Right search)) = return $ Animal { species = sName search, numberOfLegs = sLegs search}
|
||||
searchWithBeforeParms _ _ = return bimac
|
||||
|
||||
searchWithAroundParms (Just _) (Just (Right search)) (Just True) = return $ Animal { species = sName search, numberOfLegs = sLegs search}
|
||||
searchWithAroundParms _ _ _ = return bimac
|
||||
|
||||
|
||||
queryParamFormSpec :: Spec
|
||||
queryParamFormSpec = do
|
||||
describe "Servant.API.QueryParamForm" $ do
|
||||
it "allows query params into form" $
|
||||
(flip runSession) (serve queryParamFormApi qpFormServer) $ do
|
||||
let params1 = "?sName=bimac&sLegs=7"
|
||||
response1 <- Network.Wai.Test.request defaultRequest{
|
||||
rawQueryString = params1,
|
||||
queryString = parseQuery params1
|
||||
}
|
||||
liftIO $ do
|
||||
decode' (simpleBody response1) `shouldBe` (Just $ Animal { species = "bimac", numberOfLegs = 7})
|
||||
it "allows no query params at all" $
|
||||
(flip runSession) (serve queryParamFormApi qpFormServer) $ do
|
||||
response1 <- Network.Wai.Test.request defaultRequest
|
||||
liftIO $ do
|
||||
decode' (simpleBody response1) `shouldBe` Just bimac
|
||||
it "does not generate an error for incomplete form" $
|
||||
(flip runSession) (serve queryParamFormApi qpFormServer) $ do
|
||||
let paramsBork = "?sName=bimac"
|
||||
responseBork <- Network.Wai.Test.request defaultRequest{
|
||||
rawQueryString = paramsBork,
|
||||
queryString = parseQuery paramsBork
|
||||
}
|
||||
liftIO $ do
|
||||
decode' (simpleBody responseBork) `shouldBe` (Just $ Animal { species = "broken", numberOfLegs = 0})
|
||||
return ()
|
||||
it "does not generate an error for duplicated keys" $
|
||||
(flip runSession) (serve queryParamFormApi qpFormServer) $ do
|
||||
let paramsBork = "?sName=bimac&sName=dup&sLegs=12"
|
||||
responseBork <- Network.Wai.Test.request defaultRequest{
|
||||
rawQueryString = paramsBork,
|
||||
queryString = parseQuery paramsBork
|
||||
}
|
||||
liftIO $ do
|
||||
decode' (simpleBody responseBork) `shouldBe` (Just $ Animal { species = "broken", numberOfLegs = 0})
|
||||
return ()
|
||||
it "does not generate an error for form with bad input types" $
|
||||
(flip runSession) (serve queryParamFormApi qpFormServer) $ do
|
||||
let paramsBork = "?sName=bimac&sLegs=ocean"
|
||||
responseBork <- Network.Wai.Test.request defaultRequest{
|
||||
rawQueryString = paramsBork,
|
||||
queryString = parseQuery paramsBork
|
||||
}
|
||||
liftIO $ do
|
||||
decode' (simpleBody responseBork) `shouldBe` (Just $ Animal { species = "broken", numberOfLegs = 0})
|
||||
return ()
|
||||
|
||||
it "allows query params into form even with other params" $
|
||||
(flip runSession) (serve queryParamFormApi qpFormServer) $ do
|
||||
let params1 = "?before=true&sName=bimac&sLegs=6"
|
||||
response1 <- Network.Wai.Test.request defaultRequest{
|
||||
rawQueryString = params1,
|
||||
queryString = parseQuery params1,
|
||||
pathInfo = ["before-param"]
|
||||
}
|
||||
liftIO $ do
|
||||
decode' (simpleBody response1) `shouldBe` (Just $ Animal { species = "bimac", numberOfLegs = 6})
|
||||
|
||||
let params2 = "?sName=bimac&before=true&sLegs=5"
|
||||
response2 <- Network.Wai.Test.request defaultRequest{
|
||||
rawQueryString = params2,
|
||||
queryString = parseQuery params2,
|
||||
pathInfo = ["before-param"]
|
||||
}
|
||||
liftIO $ do
|
||||
decode' (simpleBody response2) `shouldBe` (Just $ Animal { species = "bimac", numberOfLegs = 5})
|
||||
it "allows completely mixed up params with QueryParamForm" $
|
||||
(flip runSession) (serve queryParamFormApi qpFormServer) $ do
|
||||
let params1 = "?sLegs=1&before=true&sName=bimac&after=true&unknown=ignoreThis"
|
||||
response1 <- Network.Wai.Test.request defaultRequest{
|
||||
rawQueryString = params1,
|
||||
queryString = parseQuery params1,
|
||||
pathInfo = ["mixed-param"]
|
||||
}
|
||||
liftIO $ do
|
||||
decode' (simpleBody response1) `shouldBe` (Just $ Animal { species = "bimac", numberOfLegs = 1})
|
||||
|
||||
-- }}}
|
||||
------------------------------------------------------------------------------
|
||||
-- * reqBodySpec {{{
|
||||
|
|
@ -811,4 +932,8 @@ chimera = Animal "Chimera" (-1)
|
|||
|
||||
beholder :: Animal
|
||||
beholder = Animal "Beholder" 0
|
||||
|
||||
bimac :: Animal
|
||||
bimac = Animal { species = "Octopus bimaculoides" , numberOfLegs = 8}
|
||||
|
||||
-- }}}
|
||||
|
|
|
|||
|
|
@ -161,6 +161,7 @@ test-suite spec
|
|||
, base-compat
|
||||
, aeson
|
||||
, bytestring
|
||||
, http-api-data
|
||||
, http-media
|
||||
, mtl
|
||||
, servant
|
||||
|
|
|
|||
|
|
@ -101,7 +101,8 @@ import Servant.API.IsSecure
|
|||
import Servant.API.Modifiers
|
||||
(Lenient, Optional, Required, Strict)
|
||||
import Servant.API.QueryParam
|
||||
(QueryFlag, QueryParam, QueryParam', QueryParams)
|
||||
(QueryFlag, QueryParam, QueryParam', QueryParams,
|
||||
QueryParamForm, QueryParamForm')
|
||||
import Servant.API.Raw
|
||||
(Raw)
|
||||
import Servant.API.RemoteHost
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# OPTIONS_HADDOCK not-home #-}
|
||||
module Servant.API.QueryParam (QueryFlag, QueryParam, QueryParam', QueryParams) where
|
||||
module Servant.API.QueryParam (QueryFlag, QueryParam, QueryParam', QueryParams, QueryParamForm, QueryParamForm') where
|
||||
|
||||
import Data.Typeable
|
||||
(Typeable)
|
||||
|
|
@ -38,6 +38,39 @@ data QueryParam' (mods :: [*]) (sym :: Symbol) (a :: *)
|
|||
data QueryParams (sym :: Symbol) (a :: *)
|
||||
deriving Typeable
|
||||
|
||||
-- | Lookup the values associated with a collection of query string parameters
|
||||
-- and try to extract them as a value of type @a@. This is typically
|
||||
-- meant to query string parameters of the form
|
||||
-- @param1=val1¶m2=val2@ and so on into a custom type represented by the form.
|
||||
--
|
||||
-- Note: Unlike with 'QueryParam', by default 'QueryParamForm' is parsed in a
|
||||
-- 'Lenient' way, because it's difficult to know if it should be parsed
|
||||
-- or not (when other 'QueryParam's are present). As a result, most users
|
||||
-- of 'QueryParamForm' are going to implement handlers that take a value
|
||||
-- of type (Maybe (Either Text a)). This also means that in a server implementation
|
||||
-- if there as a query string of any length (even just a "?"), we'll try to parse
|
||||
-- the 'QueryParamForm' into the custom type specified.
|
||||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > data BookSearchParams = BookSearchParams
|
||||
-- > { title :: Text
|
||||
-- > , authors :: [Text]
|
||||
-- > , page :: Maybe Int
|
||||
-- > } deriving (Eq, Show, Generic)
|
||||
-- > instance FromForm BookSearchParams
|
||||
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
|
||||
--
|
||||
-- Example Handler Signature:
|
||||
-- Maybe (Either Text BookSearchParams) -> Handler [Book]
|
||||
|
||||
type QueryParamForm = QueryParamForm' '[Optional, Lenient]
|
||||
|
||||
-- | 'QueryParamForm' which can be 'Required', 'Lenient', or modified otherwise.
|
||||
data QueryParamForm' (mods :: [*]) (sym :: Symbol) (a :: *)
|
||||
deriving Typeable
|
||||
|
||||
|
||||
-- | Lookup a potentially value-less query string parameter
|
||||
-- with boolean semantics. If the param @sym@ is there without any value,
|
||||
-- or if it's there with value "true" or "1", it's interpreted as 'True'.
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ import Servant.API.Capture
|
|||
import Servant.API.Header
|
||||
(Header)
|
||||
import Servant.API.QueryParam
|
||||
(QueryFlag, QueryParam, QueryParams)
|
||||
(QueryFlag, QueryParam, QueryParams, QueryParamForm)
|
||||
import Servant.API.ReqBody
|
||||
(ReqBody)
|
||||
import Servant.API.Sub
|
||||
|
|
@ -127,6 +127,7 @@ type family IsElem endpoint api :: Constraint where
|
|||
= IsElem sa sb
|
||||
IsElem sa (QueryParam x y :> sb) = IsElem sa sb
|
||||
IsElem sa (QueryParams x y :> sb) = IsElem sa sb
|
||||
IsElem sa (QueryParamForm x :> sb) = IsElem sa sb
|
||||
IsElem sa (QueryFlag x :> sb) = IsElem sa sb
|
||||
IsElem (Verb m s ct typ) (Verb m s ct' typ)
|
||||
= IsSubList ct ct'
|
||||
|
|
|
|||
|
|
@ -122,6 +122,8 @@ module Servant.Links (
|
|||
, linkQueryParams
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBSC
|
||||
import Data.List
|
||||
import Data.Proxy
|
||||
(Proxy (..))
|
||||
|
|
@ -139,6 +141,8 @@ import Network.URI
|
|||
(URI (..), escapeURIString, isUnreserved)
|
||||
import Prelude ()
|
||||
import Prelude.Compat
|
||||
import Web.FormUrlEncoded
|
||||
(ToForm(..), urlEncodeAsFormStable)
|
||||
|
||||
import Servant.API.Alternative
|
||||
((:<|>) ((:<|>)))
|
||||
|
|
@ -162,7 +166,7 @@ import Servant.API.IsSecure
|
|||
import Servant.API.Modifiers
|
||||
(FoldRequired)
|
||||
import Servant.API.QueryParam
|
||||
(QueryFlag, QueryParam', QueryParams)
|
||||
(QueryFlag, QueryParam', QueryParams, QueryParamForm')
|
||||
import Servant.API.Raw
|
||||
(Raw)
|
||||
import Servant.API.RemoteHost
|
||||
|
|
@ -219,6 +223,7 @@ data Param
|
|||
= SingleParam String Text.Text
|
||||
| ArrayElemParam String Text.Text
|
||||
| FlagParam String
|
||||
| FormParam LBS.ByteString
|
||||
deriving Show
|
||||
|
||||
addSegment :: Escaped -> Link -> Link
|
||||
|
|
@ -284,6 +289,7 @@ linkURI' addBrackets (Link segments q_params) =
|
|||
makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
|
||||
makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
|
||||
makeQuery (FlagParam k) = escape k
|
||||
makeQuery (FormParam f) = LBSC.unpack f
|
||||
|
||||
style = case addBrackets of
|
||||
LinkArrayElementBracket -> "[]="
|
||||
|
|
@ -472,6 +478,16 @@ instance (KnownSymbol sym, HasLink sub)
|
|||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, ToForm v, HasLink sub, SBoolI (FoldRequired mods))
|
||||
=> HasLink (QueryParamForm' mods sym v :> sub)
|
||||
where
|
||||
type MkLink (QueryParamForm' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
|
||||
toLink toA _ l mv =
|
||||
toLink toA (Proxy :: Proxy sub) $
|
||||
case sbool :: SBool (FoldRequired mods) of
|
||||
STrue -> (addQueryParam . FormParam . urlEncodeAsFormStable) mv l
|
||||
SFalse -> maybe id (addQueryParam . FormParam . urlEncodeAsFormStable) mv l
|
||||
|
||||
-- :<|> instance - Generate all links at once
|
||||
instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
|
||||
type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
|
@ -9,8 +10,11 @@ import Data.Proxy
|
|||
(Proxy (..))
|
||||
import Data.String
|
||||
(fromString)
|
||||
import GHC.Generics
|
||||
import Test.Hspec
|
||||
(Expectation, Spec, describe, it, shouldBe)
|
||||
import Web.FormUrlEncoded
|
||||
(ToForm(..))
|
||||
|
||||
import Servant.API
|
||||
import Servant.Test.ComprehensiveAPI
|
||||
|
|
@ -21,6 +25,8 @@ type TestApi =
|
|||
-- Capture and query params
|
||||
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] NoContent
|
||||
:<|> "hi" :> Capture "name" String :> QueryParam' '[Required] "capital" Bool :> Delete '[JSON] NoContent
|
||||
:<|> "formR" :> QueryParamForm' '[Required, Strict] "someform" TestForm :> Delete '[JSON] NoContent
|
||||
:<|> "form-opt" :> QueryParamForm "someform" TestForm :> Delete '[JSON] NoContent
|
||||
:<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent
|
||||
|
||||
-- Flags
|
||||
|
|
@ -43,6 +49,13 @@ apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
|
|||
=> Proxy endpoint -> MkLink endpoint Link
|
||||
apiLink = safeLink (Proxy :: Proxy TestApi)
|
||||
|
||||
data TestForm = TestForm {
|
||||
testing :: String
|
||||
, time :: String
|
||||
} deriving (Eq, Generic)
|
||||
|
||||
instance ToForm TestForm
|
||||
|
||||
-- | Convert a link to a URI and ensure that this maps to the given string
|
||||
-- given string
|
||||
shouldBeLink :: Link -> String -> Expectation
|
||||
|
|
@ -65,6 +78,17 @@ spec = describe "Servant.Links" $ do
|
|||
:> Delete '[JSON] NoContent)
|
||||
apiLink l4 "privet" False `shouldBeLink` "hi/privet?capital=false"
|
||||
|
||||
it "generates query param form links" $ do
|
||||
-- most who use QueryParamForm are not going to use it Required, Strict, so we'll test it both ways
|
||||
let l3 = Proxy :: Proxy ("formR" :> QueryParamForm' '[Required, Strict] "someform" TestForm
|
||||
:> Delete '[JSON] NoContent)
|
||||
-- We allow `urlEncodeAsFormStable` to uri Escape for us. Validating that assumption here:
|
||||
apiLink l3 (TestForm "sure" "später") `shouldBeLink` "formR?testing=sure&time=sp%C3%A4ter"
|
||||
|
||||
let l4 = Proxy :: Proxy ("form-opt" :> QueryParamForm "someform" TestForm
|
||||
:> Delete '[JSON] NoContent)
|
||||
apiLink l4 (Just $ TestForm "sure" "später") `shouldBeLink` "form-opt?testing=sure&time=sp%C3%A4ter"
|
||||
|
||||
it "generates correct links for CaptureAll" $ do
|
||||
apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))
|
||||
["roads", "lead", "to", "rome"]
|
||||
|
|
|
|||
Loading…
Reference in a new issue