diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 5442fdee..7f9bc5f9 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs @@ -557,7 +557,7 @@ instance (KnownSymbol sym, HasClient m api) -- > } deriving (Eq, Show, Generic) -- > 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 @@ -567,10 +567,10 @@ instance (KnownSymbol sym, HasClient m api) -- > -- 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 +instance (ToForm a, HasClient m api, SBoolI (FoldRequired mods)) + => 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 -- if mparam = Nothing, we don't add it to the query string diff --git a/servant-client-core/src/Servant/Client/Core/Request.hs b/servant-client-core/src/Servant/Client/Core/Request.hs index 8b6fd992..bd36b895 100644 --- a/servant-client-core/src/Servant/Client/Core/Request.hs +++ b/servant-client-core/src/Servant/Client/Core/Request.hs @@ -51,11 +51,11 @@ import Network.HTTP.Media (MediaType) import Network.HTTP.Types (Header, HeaderName, HttpVersion (..), Method, QueryItem, - http11, methodGet, parseQuery) + http11, methodGet) import Servant.API (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO) import Web.FormUrlEncoded - (ToForm (..), urlEncodeAsForm) + (ToForm (..), toListStable) import Servant.Client.Core.Internal (mediaTypeRnf) @@ -143,14 +143,16 @@ concatQueryString :: ToForm a -> Request -> Request 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 } + -- | Set body and media type of the request being constructed. -- -- The body is set to the given bytestring using the 'RequestBodyLBS' -- constructor. --- -- @since 0.12 -- setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 14b534bb..54c16a83 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -32,8 +32,6 @@ 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 @@ -955,25 +953,23 @@ 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 - +-- | The docs for a @'QueryParamForm' a'@ +-- require a 'ToSample a' instance +instance (ToForm a, ToSample a, HasDocs api) + => HasDocs (QueryParamForm' mods 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 + in action & params <>~ [qParamMaker sampleEncoding] + qParamMaker formEncodedSample = DocQueryParam { + _paramName = "Collection of Parameters" , _paramValues = [formEncodedSample] - , _paramDesc = "Query parameter" + , _paramDesc = "Query parameters" , _paramKind = Normal } diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 72b18841..32ffce11 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -58,7 +58,7 @@ instance ToParam (QueryParam' mods "bar" Int) where 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 + 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 @@ -143,10 +143,7 @@ spec = describe "Servant.Docs" $ do 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 + it "mentions optional query-param-form params from QueryParamForm" $ md `shouldContain` "- **Values**: *dt1field1=field%201&dt1field2=13*" 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) :<|> "postJson" :> ReqBody '[JSON] String :> Post '[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 :<|> "empty-api" :> EmptyAPI diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 8941b19e..771f4442 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -325,9 +325,9 @@ 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 +instance (HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api) + => HasForeign lang ftype (QueryParamForm' mods a :> api) where + type Foreign ftype (QueryParamForm' mods a :> api) = Foreign ftype api foreignFor lang Proxy Proxy req = foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $ @@ -336,7 +336,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), 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 diff --git a/servant-foreign/test/Servant/ForeignSpec.hs b/servant-foreign/test/Servant/ForeignSpec.hs index 1f7096ab..e25b61f3 100644 --- a/servant-foreign/test/Servant/ForeignSpec.hs +++ b/servant-foreign/test/Servant/ForeignSpec.hs @@ -82,7 +82,7 @@ instance HasForeignType LangX String ContactForm where 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" :> QueryParamForm 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] diff --git a/servant-http-streams/test/Servant/ClientSpec.hs b/servant-http-streams/test/Servant/ClientSpec.hs index 079f1559..4ea340b9 100644 --- a/servant-http-streams/test/Servant/ClientSpec.hs +++ b/servant-http-streams/test/Servant/ClientSpec.hs @@ -111,14 +111,6 @@ 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 = @@ -130,7 +122,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] + :<|> "paramform" :> QueryParamForm Person :> Get '[JSON] [Person] :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool :<|> "rawSuccess" :> Raw :<|> "rawFailure" :> Raw @@ -156,7 +148,7 @@ getCaptureAll :: [String] -> ClientM [Person] getBody :: Person -> ClientM Person getQueryParam :: Maybe String -> ClientM Person getQueryParams :: [String] -> ClientM [Person] -getQueryParamForm :: Maybe PersonSearch -> ClientM [Person] +getQueryParamForm :: Maybe Person -> ClientM [Person] getQueryFlag :: Bool -> ClientM Bool getRawSuccess :: HTTP.Method -> ClientM Response getRawFailure :: HTTP.Method -> ClientM Response @@ -198,8 +190,8 @@ server = serve api ( 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" "" [] + Just (Right _) -> return [alice, carol] + Just (Left _) -> throwError $ ServerError 400 "failed to decode form" "" [] Nothing -> return []) :<|> return :<|> (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 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] context "Servant.API.QueryParam.QueryFlag" $ diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 2c428a99..8a3ac8d9 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -558,9 +558,9 @@ 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. +-- | If you define a custom record type, for example @BookSearchParams@, then you can use +-- @'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. -- -- Your server-side handler must be a function that takes an argument of type -- @'Maybe' ('Either' BookSearchParams)@. @@ -582,26 +582,24 @@ instance (KnownSymbol sym, HasServer api context) -- > , page :: Maybe Int -- > } deriving (Eq, Show, Generic) -- > instance FromForm BookSearchParams --- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book] --- +-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book] +-- -- Example Handler Signature: -- Maybe (Either Text BookSearchParams) -> Handler [Book] instance - ( KnownSymbol sym, FromForm a, HasServer api context + (FromForm a, HasServer api context , 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 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s - route Proxy context subserver = - - let formName = cs $ symbolVal (Proxy :: Proxy sym) + route Proxy context subserver = - parseParamForm req = + let parseParamForm req = unfoldRequestArgument (Proxy :: Proxy mods) errReq errSt mev where rawQS = rawQueryString req @@ -612,12 +610,11 @@ instance _ -> Just $ urlDecodeAsForm (BL.drop 1 . BL.fromStrict $ rawQS) errReq = delayedFailFatal err400 - { errBody = cs $ "Query parameter form " <> formName <> " is required" + { errBody = "Query parameter form is required" } errSt e = delayedFailFatal err400 - { errBody = cs $ "Error parsing query parameter form " - <> formName <> " failed: " <> e + { errBody = cs $ "Error: parsing query parameter form failed. " <> e } delayed = addParameterCheck subserver . withRequest $ \req -> diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index d28bf098..5f023363 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -466,14 +466,14 @@ data AnimalSearch = AnimalSearch { instance FromForm AnimalSearch type QueryParamFormApi = - QueryParamForm "octopus" AnimalSearch :> Get '[JSON] Animal + QueryParamForm AnimalSearch :> Get '[JSON] Animal :<|> "before-param" :> QueryParam "before" Bool - :> QueryParamForm "before" AnimalSearch + :> QueryParamForm AnimalSearch :> Get '[JSON] Animal :<|> "mixed-param" :> QueryParam "before" Bool - :> QueryParamForm "multiple" AnimalSearch + :> QueryParamForm AnimalSearch :> QueryParam "after" Bool :> Get '[JSON] Animal diff --git a/servant/src/Servant/API/QueryParam.hs b/servant/src/Servant/API/QueryParam.hs index 18e978c5..adb5d35a 100644 --- a/servant/src/Servant/API/QueryParam.hs +++ b/servant/src/Servant/API/QueryParam.hs @@ -50,7 +50,7 @@ data QueryParams (sym :: Symbol) (a :: *) -- 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 @@ -59,15 +59,15 @@ data QueryParams (sym :: Symbol) (a :: *) -- > , page :: Maybe Int -- > } deriving (Eq, Show, Generic) -- > instance FromForm BookSearchParams --- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book] --- +-- > type MyApi = "books" :> QueryParamForm 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 :: *) +data QueryParamForm' (mods :: [*]) (a :: *) deriving Typeable diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs index b58b5ea1..ba6e73a0 100644 --- a/servant/src/Servant/Links.hs +++ b/servant/src/Servant/Links.hs @@ -142,7 +142,7 @@ import Network.URI import Prelude () import Prelude.Compat import Web.FormUrlEncoded - (ToForm(..), urlEncodeAsFormStable) + (ToForm(..), urlEncodeAsForm) import Servant.API.Alternative ((:<|>) ((:<|>))) @@ -478,15 +478,15 @@ 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) +instance (ToForm v, HasLink sub, SBoolI (FoldRequired mods)) + => HasLink (QueryParamForm' mods v :> sub) 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 (Proxy :: Proxy sub) $ case sbool :: SBool (FoldRequired mods) of - STrue -> (addQueryParam . FormParam . urlEncodeAsFormStable) mv l - SFalse -> maybe id (addQueryParam . FormParam . urlEncodeAsFormStable) mv l + STrue -> (addQueryParam . FormParam . urlEncodeAsForm) mv l + SFalse -> maybe id (addQueryParam . FormParam . urlEncodeAsForm) mv l -- :<|> instance - Generate all links at once instance (HasLink a, HasLink b) => HasLink (a :<|> b) where diff --git a/servant/test/Servant/LinksSpec.hs b/servant/test/Servant/LinksSpec.hs index 00b80039..f3940dc6 100644 --- a/servant/test/Servant/LinksSpec.hs +++ b/servant/test/Servant/LinksSpec.hs @@ -6,13 +6,15 @@ {-# LANGUAGE TypeOperators #-} module Servant.LinksSpec where + import Data.Proxy (Proxy (..)) import Data.String (fromString) +import qualified Data.Text as T import GHC.Generics import Test.Hspec - (Expectation, Spec, describe, it, shouldBe) + (Expectation, Spec, describe, it, shouldBe, shouldContain) import Web.FormUrlEncoded (ToForm(..)) @@ -25,8 +27,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 + :<|> "formR" :> QueryParamForm' '[Required, Strict] TestForm :> Delete '[JSON] NoContent + :<|> "form-opt" :> QueryParamForm TestForm :> Delete '[JSON] NoContent :<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent -- Flags @@ -62,6 +64,10 @@ shouldBeLink :: Link -> String -> Expectation shouldBeLink link expected = toUrlPiece link `shouldBe` fromString expected +linkShouldContain :: Link -> String -> Expectation +linkShouldContain link expected = + T.unpack (toUrlPiece link) `shouldContain` expected + spec :: Spec spec = describe "Servant.Links" $ 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 -- 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) - -- 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) - 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 apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))