Rewrite client concatQueryString for client requests and pull extraneous data type for spec

Remove symbol from QueryParamForm type args

Remove the data instance for QueryParamForm in HasDocs
This commit is contained in:
Erik Aker 2019-10-02 20:47:54 -07:00
parent cffa511df9
commit 68014463d9
12 changed files with 82 additions and 81 deletions

View file

@ -557,7 +557,7 @@ instance (KnownSymbol sym, HasClient m api)
-- > } deriving (Eq, Show, Generic) -- > } deriving (Eq, Show, Generic)
-- > instance ToForm BookSearchParams -- > instance ToForm BookSearchParams
-- --
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book] -- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
-- > -- >
-- > myApi :: Proxy MyApi -- > myApi :: Proxy MyApi
-- > myApi = Proxy -- > myApi = Proxy
@ -567,10 +567,10 @@ instance (KnownSymbol sym, HasClient m api)
-- > -- then you can just use "getBooks" to query that endpoint. -- > -- then you can just use "getBooks" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just $ BookSearchParams "white noise" ["DeLillo"] Nothing)' -- > -- 'getBooksBy (Just $ BookSearchParams "white noise" ["DeLillo"] Nothing)'
instance (KnownSymbol sym, ToForm a, HasClient m api, SBoolI (FoldRequired mods)) instance (ToForm a, HasClient m api, SBoolI (FoldRequired mods))
=> HasClient m (QueryParamForm' mods sym a :> api) where => HasClient m (QueryParamForm' mods a :> api) where
type Client m (QueryParamForm' mods sym a :> api) = type Client m (QueryParamForm' mods a :> api) =
RequiredArgument mods a -> Client m api RequiredArgument mods a -> Client m api
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string

View file

@ -51,11 +51,11 @@ import Network.HTTP.Media
(MediaType) (MediaType)
import Network.HTTP.Types import Network.HTTP.Types
(Header, HeaderName, HttpVersion (..), Method, QueryItem, (Header, HeaderName, HttpVersion (..), Method, QueryItem,
http11, methodGet, parseQuery) http11, methodGet)
import Servant.API import Servant.API
(ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO) (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
import Web.FormUrlEncoded import Web.FormUrlEncoded
(ToForm (..), urlEncodeAsForm) (ToForm (..), toListStable)
import Servant.Client.Core.Internal (mediaTypeRnf) import Servant.Client.Core.Internal (mediaTypeRnf)
@ -143,14 +143,16 @@ concatQueryString :: ToForm a
-> Request -> Request
-> Request -> Request
concatQueryString form req concatQueryString form req
= let querySeq = Seq.fromList . parseQuery . LBS.toStrict . urlEncodeAsForm $ form = let
queryEncoder = map (bimap encodeUtf8 (Just . encodeUtf8))
querySeq = Seq.fromList . queryEncoder . toListStable . toForm $ form
in req { requestQueryString = requestQueryString req Seq.>< querySeq } in req { requestQueryString = requestQueryString req Seq.>< querySeq }
-- | Set body and media type of the request being constructed. -- | Set body and media type of the request being constructed.
-- --
-- The body is set to the given bytestring using the 'RequestBodyLBS' -- The body is set to the given bytestring using the 'RequestBodyLBS'
-- constructor. -- constructor.
--
-- @since 0.12 -- @since 0.12
-- --
setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request

View file

@ -32,8 +32,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBSC
import Data.ByteString.Lazy.Char8 import Data.ByteString.Lazy.Char8
(ByteString) (ByteString)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Data.Data
(Data, toConstr, constrFields)
import Data.Foldable import Data.Foldable
(toList) (toList)
import Data.Foldable import Data.Foldable
@ -955,11 +953,10 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
paramP = Proxy :: Proxy (QueryFlag sym) paramP = Proxy :: Proxy (QueryFlag sym)
action' = over params (|> toParam paramP) action action' = over params (|> toParam paramP) action
-- | The docs for a @'QueryParamForm' sym a'@ -- | The docs for a @'QueryParamForm' a'@
-- require the following instances for the `a`: -- require a 'ToSample a' instance
-- 'Data', 'ToSample' instance (ToForm a, ToSample a, HasDocs api)
instance (KnownSymbol sym, Data a, ToForm a, ToSample a, HasDocs api) => HasDocs (QueryParamForm' mods a :> api) where
=> HasDocs (QueryParamForm' mods sym a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor subApiP (endpoint, action') docsFor subApiP (endpoint, action')
@ -967,13 +964,12 @@ instance (KnownSymbol sym, Data a, ToForm a, ToSample a, HasDocs api)
where subApiP = Proxy :: Proxy api where subApiP = Proxy :: Proxy api
action' = action' =
let (Just sampleForm) = toSample (Proxy :: Proxy a) let (Just sampleForm) = toSample (Proxy :: Proxy a)
paramNames = constrFields (toConstr sampleForm)
sampleEncoding = LBSC.unpack . urlEncodeAsForm . toForm $ sampleForm sampleEncoding = LBSC.unpack . urlEncodeAsForm . toForm $ sampleForm
in action & params <>~ (fmap (qParamMaker sampleEncoding) paramNames) in action & params <>~ [qParamMaker sampleEncoding]
qParamMaker formEncodedSample pName = DocQueryParam { qParamMaker formEncodedSample = DocQueryParam {
_paramName = pName _paramName = "Collection of Parameters"
, _paramValues = [formEncodedSample] , _paramValues = [formEncodedSample]
, _paramDesc = "Query parameter" , _paramDesc = "Query parameters"
, _paramKind = Normal , _paramKind = Normal
} }

View file

@ -143,10 +143,7 @@ spec = describe "Servant.Docs" $ do
it "mentions optional query-param" $ do it "mentions optional query-param" $ do
md `shouldContain` "### GET Parameters:" md `shouldContain` "### GET Parameters:"
md `shouldContain` "- query" md `shouldContain` "- query"
it "mentions optional query-param-form params from QueryParamForm" $ do it "mentions optional query-param-form params from QueryParamForm" $
md `shouldContain` "- dt1field1"
md `shouldContain` "- dt1field2"
-- contains sample url-encoded form
md `shouldContain` "- **Values**: *dt1field1=field%201&dt1field2=13*" md `shouldContain` "- **Values**: *dt1field1=field%201&dt1field2=13*"
it "does not generate any docs mentioning the 'empty-api' path" $ it "does not generate any docs mentioning the 'empty-api' path" $
@ -177,7 +174,7 @@ instance MimeRender PlainText Int where
type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int) type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
:<|> "postJson" :> ReqBody '[JSON] String :> Post '[JSON] Datatype1 :<|> "postJson" :> ReqBody '[JSON] String :> Post '[JSON] Datatype1
:<|> "qparam" :> QueryParam "query" String :> Get '[JSON] Datatype1 :<|> "qparam" :> QueryParam "query" String :> Get '[JSON] Datatype1
:<|> "qparamform" :> QueryParamForm "form" Datatype1 :> Get '[JSON] Datatype1 :<|> "qparamform" :> QueryParamForm Datatype1 :> Get '[JSON] Datatype1
:<|> "header" :> Header "X-Test" Int :> Put '[JSON] Int :<|> "header" :> Header "X-Test" Int :> Put '[JSON] Int
:<|> "empty-api" :> EmptyAPI :<|> "empty-api" :> EmptyAPI

View file

@ -325,9 +325,9 @@ instance
{ _argName = PathSegment str { _argName = PathSegment str
, _argType = typeFor lang ftype (Proxy :: Proxy Bool) } , _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api) instance (HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
=> HasForeign lang ftype (QueryParamForm' mods sym a :> api) where => HasForeign lang ftype (QueryParamForm' mods a :> api) where
type Foreign ftype (QueryParamForm' mods sym a :> api) = Foreign ftype api type Foreign ftype (QueryParamForm' mods a :> api) = Foreign ftype api
foreignFor lang Proxy Proxy req = foreignFor lang Proxy Proxy req =
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $ foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $

View file

@ -82,7 +82,7 @@ instance HasForeignType LangX String ContactForm where
type TestApi type TestApi
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
:<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
:<|> "test" :> QueryParamForm "contact" ContactForm :> Post '[JSON] NoContent :<|> "test" :> QueryParamForm ContactForm :> Post '[JSON] NoContent
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
:<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
:<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int] :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]

View file

@ -111,14 +111,6 @@ alice = Person "Alice" 42
carol :: Person carol :: Person
carol = Person "Carol" 17 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 TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
type Api = type Api =
@ -130,7 +122,7 @@ type Api =
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person] :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
:<|> "paramform" :> QueryParamForm "names" PersonSearch :> Get '[JSON] [Person] :<|> "paramform" :> QueryParamForm Person :> Get '[JSON] [Person]
:<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
:<|> "rawSuccess" :> Raw :<|> "rawSuccess" :> Raw
:<|> "rawFailure" :> Raw :<|> "rawFailure" :> Raw
@ -156,7 +148,7 @@ getCaptureAll :: [String] -> ClientM [Person]
getBody :: Person -> ClientM Person getBody :: Person -> ClientM Person
getQueryParam :: Maybe String -> ClientM Person getQueryParam :: Maybe String -> ClientM Person
getQueryParams :: [String] -> ClientM [Person] getQueryParams :: [String] -> ClientM [Person]
getQueryParamForm :: Maybe PersonSearch -> ClientM [Person] getQueryParamForm :: Maybe Person -> ClientM [Person]
getQueryFlag :: Bool -> ClientM Bool getQueryFlag :: Bool -> ClientM Bool
getRawSuccess :: HTTP.Method -> ClientM Response getRawSuccess :: HTTP.Method -> ClientM Response
getRawFailure :: HTTP.Method -> ClientM Response getRawFailure :: HTTP.Method -> ClientM Response
@ -198,8 +190,8 @@ server = serve api (
Nothing -> throwError $ ServerError 400 "missing parameter" "" []) Nothing -> throwError $ ServerError 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..])) :<|> (\ names -> return (zipWith Person names [0..]))
:<|> (\ psearch -> case psearch of :<|> (\ psearch -> case psearch of
Just (Right psearch) -> return [alice, carol] Just (Right _) -> return [alice, carol]
Just (Left err) -> throwError $ ServerError 400 "failed to decode form" "" [] Just (Left _) -> throwError $ ServerError 400 "failed to decode form" "" []
Nothing -> return []) Nothing -> return [])
:<|> return :<|> return
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess") :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
@ -323,7 +315,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
it "Servant.API.QueryParam.QueryParamForm" $ \(_, baseUrl) -> do it "Servant.API.QueryParam.QueryParamForm" $ \(_, baseUrl) -> do
left show <$> runClient (getQueryParamForm Nothing) baseUrl `shouldReturn` Right [] left show <$> runClient (getQueryParamForm Nothing) baseUrl `shouldReturn` Right []
left show <$> runClient (getQueryParamForm (Just $ PersonSearch "a" 10)) baseUrl left show <$> runClient (getQueryParamForm (Just $ Person "a" 10)) baseUrl
`shouldReturn` Right [alice, carol] `shouldReturn` Right [alice, carol]
context "Servant.API.QueryParam.QueryFlag" $ context "Servant.API.QueryParam.QueryFlag" $

View file

@ -559,7 +559,7 @@ instance (KnownSymbol sym, HasServer api context)
| otherwise = False | otherwise = False
-- | If you define a custom record type, for example @BookSearchParams@, then you can use -- | 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 -- @'QueryParamForm' BookSearchParams@ in one of the endpoints for your API
-- to translate a collection of query-string parameters into a value of your record type. -- 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 -- Your server-side handler must be a function that takes an argument of type
@ -582,26 +582,24 @@ instance (KnownSymbol sym, HasServer api context)
-- > , page :: Maybe Int -- > , page :: Maybe Int
-- > } deriving (Eq, Show, Generic) -- > } deriving (Eq, Show, Generic)
-- > instance FromForm BookSearchParams -- > instance FromForm BookSearchParams
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book] -- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
-- --
-- Example Handler Signature: -- Example Handler Signature:
-- Maybe (Either Text BookSearchParams) -> Handler [Book] -- Maybe (Either Text BookSearchParams) -> Handler [Book]
instance instance
( KnownSymbol sym, FromForm a, HasServer api context (FromForm a, HasServer api context
, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods) , SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)
) )
=> HasServer (QueryParamForm' mods sym a :> api) context where => HasServer (QueryParamForm' mods a :> api) context where
------ ------
type ServerT (QueryParamForm' mods sym a :> api) m = type ServerT (QueryParamForm' mods a :> api) m =
RequestArgument mods a -> ServerT api m RequestArgument mods a -> ServerT api m
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
route Proxy context subserver = route Proxy context subserver =
let formName = cs $ symbolVal (Proxy :: Proxy sym) let parseParamForm req =
parseParamForm req =
unfoldRequestArgument (Proxy :: Proxy mods) errReq errSt mev unfoldRequestArgument (Proxy :: Proxy mods) errReq errSt mev
where where
rawQS = rawQueryString req rawQS = rawQueryString req
@ -612,12 +610,11 @@ instance
_ -> Just $ urlDecodeAsForm (BL.drop 1 . BL.fromStrict $ rawQS) _ -> Just $ urlDecodeAsForm (BL.drop 1 . BL.fromStrict $ rawQS)
errReq = delayedFailFatal err400 errReq = delayedFailFatal err400
{ errBody = cs $ "Query parameter form " <> formName <> " is required" { errBody = "Query parameter form is required"
} }
errSt e = delayedFailFatal err400 errSt e = delayedFailFatal err400
{ errBody = cs $ "Error parsing query parameter form " { errBody = cs $ "Error: parsing query parameter form failed. " <> e
<> formName <> " failed: " <> e
} }
delayed = addParameterCheck subserver . withRequest $ \req -> delayed = addParameterCheck subserver . withRequest $ \req ->

View file

@ -466,14 +466,14 @@ data AnimalSearch = AnimalSearch {
instance FromForm AnimalSearch instance FromForm AnimalSearch
type QueryParamFormApi = type QueryParamFormApi =
QueryParamForm "octopus" AnimalSearch :> Get '[JSON] Animal QueryParamForm AnimalSearch :> Get '[JSON] Animal
:<|> "before-param" :<|> "before-param"
:> QueryParam "before" Bool :> QueryParam "before" Bool
:> QueryParamForm "before" AnimalSearch :> QueryParamForm AnimalSearch
:> Get '[JSON] Animal :> Get '[JSON] Animal
:<|> "mixed-param" :<|> "mixed-param"
:> QueryParam "before" Bool :> QueryParam "before" Bool
:> QueryParamForm "multiple" AnimalSearch :> QueryParamForm AnimalSearch
:> QueryParam "after" Bool :> QueryParam "after" Bool
:> Get '[JSON] Animal :> Get '[JSON] Animal

View file

@ -59,7 +59,7 @@ data QueryParams (sym :: Symbol) (a :: *)
-- > , page :: Maybe Int -- > , page :: Maybe Int
-- > } deriving (Eq, Show, Generic) -- > } deriving (Eq, Show, Generic)
-- > instance FromForm BookSearchParams -- > instance FromForm BookSearchParams
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book] -- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
-- --
-- Example Handler Signature: -- Example Handler Signature:
-- Maybe (Either Text BookSearchParams) -> Handler [Book] -- Maybe (Either Text BookSearchParams) -> Handler [Book]
@ -67,7 +67,7 @@ data QueryParams (sym :: Symbol) (a :: *)
type QueryParamForm = QueryParamForm' '[Optional, Lenient] type QueryParamForm = QueryParamForm' '[Optional, Lenient]
-- | 'QueryParamForm' which can be 'Required', 'Lenient', or modified otherwise. -- | 'QueryParamForm' which can be 'Required', 'Lenient', or modified otherwise.
data QueryParamForm' (mods :: [*]) (sym :: Symbol) (a :: *) data QueryParamForm' (mods :: [*]) (a :: *)
deriving Typeable deriving Typeable

View file

@ -142,7 +142,7 @@ import Network.URI
import Prelude () import Prelude ()
import Prelude.Compat import Prelude.Compat
import Web.FormUrlEncoded import Web.FormUrlEncoded
(ToForm(..), urlEncodeAsFormStable) (ToForm(..), urlEncodeAsForm)
import Servant.API.Alternative import Servant.API.Alternative
((:<|>) ((:<|>))) ((:<|>) ((:<|>)))
@ -478,15 +478,15 @@ instance (KnownSymbol sym, HasLink sub)
where where
k = symbolVal (Proxy :: Proxy sym) k = symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, ToForm v, HasLink sub, SBoolI (FoldRequired mods)) instance (ToForm v, HasLink sub, SBoolI (FoldRequired mods))
=> HasLink (QueryParamForm' mods sym v :> sub) => HasLink (QueryParamForm' mods v :> sub)
where where
type MkLink (QueryParamForm' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a type MkLink (QueryParamForm' mods v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
toLink toA _ l mv = toLink toA _ l mv =
toLink toA (Proxy :: Proxy sub) $ toLink toA (Proxy :: Proxy sub) $
case sbool :: SBool (FoldRequired mods) of case sbool :: SBool (FoldRequired mods) of
STrue -> (addQueryParam . FormParam . urlEncodeAsFormStable) mv l STrue -> (addQueryParam . FormParam . urlEncodeAsForm) mv l
SFalse -> maybe id (addQueryParam . FormParam . urlEncodeAsFormStable) mv l SFalse -> maybe id (addQueryParam . FormParam . urlEncodeAsForm) mv l
-- :<|> instance - Generate all links at once -- :<|> instance - Generate all links at once
instance (HasLink a, HasLink b) => HasLink (a :<|> b) where instance (HasLink a, HasLink b) => HasLink (a :<|> b) where

View file

@ -6,13 +6,15 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Servant.LinksSpec where module Servant.LinksSpec where
import Data.Proxy import Data.Proxy
(Proxy (..)) (Proxy (..))
import Data.String import Data.String
(fromString) (fromString)
import qualified Data.Text as T
import GHC.Generics import GHC.Generics
import Test.Hspec import Test.Hspec
(Expectation, Spec, describe, it, shouldBe) (Expectation, Spec, describe, it, shouldBe, shouldContain)
import Web.FormUrlEncoded import Web.FormUrlEncoded
(ToForm(..)) (ToForm(..))
@ -25,8 +27,8 @@ type TestApi =
-- Capture and query params -- Capture and query params
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] NoContent "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] NoContent
:<|> "hi" :> Capture "name" String :> QueryParam' '[Required] "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 :<|> "formR" :> QueryParamForm' '[Required, Strict] TestForm :> Delete '[JSON] NoContent
:<|> "form-opt" :> QueryParamForm "someform" TestForm :> Delete '[JSON] NoContent :<|> "form-opt" :> QueryParamForm TestForm :> Delete '[JSON] NoContent
:<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent :<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent
-- Flags -- Flags
@ -62,6 +64,10 @@ shouldBeLink :: Link -> String -> Expectation
shouldBeLink link expected = shouldBeLink link expected =
toUrlPiece link `shouldBe` fromString expected toUrlPiece link `shouldBe` fromString expected
linkShouldContain :: Link -> String -> Expectation
linkShouldContain link expected =
T.unpack (toUrlPiece link) `shouldContain` expected
spec :: Spec spec :: Spec
spec = describe "Servant.Links" $ do spec = describe "Servant.Links" $ do
it "generates correct links for capture query params" $ do it "generates correct links for capture query params" $ do
@ -80,14 +86,25 @@ spec = describe "Servant.Links" $ do
it "generates query param form links" $ do 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 -- 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 let l3 = Proxy :: Proxy ("formR" :> QueryParamForm' '[Required, Strict] TestForm
:> Delete '[JSON] NoContent) :> 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 let result3 = apiLink l3 (TestForm "sure" "später")
-- we can't guarantee the order of the params unless we switch to `urlEncodeAsFormStable`...
result3 `linkShouldContain` "formR?"
result3 `linkShouldContain` "&"
result3 `linkShouldContain` "time=sp%C3%A4ter"
result3 `linkShouldContain` "testing=sure"
let l4 = Proxy :: Proxy ("form-opt" :> QueryParamForm TestForm
:> Delete '[JSON] NoContent) :> Delete '[JSON] NoContent)
apiLink l4 (Just $ TestForm "sure" "später") `shouldBeLink` "form-opt?testing=sure&time=sp%C3%A4ter"
let result4 = apiLink l4 (Just $ TestForm "sure" "später")
-- we can't guarantee the order of the params unless we switch to `urlEncodeAsFormStable`...
result4 `linkShouldContain` "form-opt?"
result4 `linkShouldContain` "&"
result4 `linkShouldContain` "time=sp%C3%A4ter"
result4 `linkShouldContain` "testing=sure"
it "generates correct links for CaptureAll" $ do it "generates correct links for CaptureAll" $ do
apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent)) apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))