diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index fe3496a7..999111bb 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -127,6 +127,7 @@ test-suite spec , exceptions , hspec == 2.* , hspec-wai >= 0.8 && <0.9 + , http-api-data , http-types , mtl , network >= 2.6 diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 686cf59d..73bdfd75 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -46,6 +46,7 @@ import Network.Wai (Application, Request, Response, responseLBS, vault) import Prelude () import Prelude.Compat +import Web.FormUrlEncoded (FromForm, urlDecodeAsForm) import Web.HttpApiData (FromHttpApiData, parseHeaderMaybe, parseQueryParam, parseUrlPieceMaybe, @@ -54,7 +55,7 @@ import Servant.API ((:<|>) (..), (:>), BasicAuth, Capt CaptureAll, Verb, ReflectMethod(reflectMethod), IsSecure(..), Header, QueryFlag, - QueryParam, QueryParams, Raw, + QueryParam, QueryParams, QueryParamForm, Raw, RemoteHost, ReqBody, Vault, WithNamedContext) import Servant.API.ContentTypes (AcceptHeader (..), @@ -405,6 +406,48 @@ instance (KnownSymbol sym, HasServer api context) examine v | v == "true" || v == "1" || v == "" = True | otherwise = False +-- | If you use @'QueryParamForm' BookSearchParams@ in one of the endpoints for your API, +-- this automatically requires your server-side handler to be a function +-- that takes an argument of type @['BookSearchParams']@. +-- +-- This lets servant worry about all key-values in the query string +-- and turning each of them into a value of the type you specify. +-- +-- You can control how the individual values are converted from 'BookSearchParams' +-- to your type by simply providing an instance of 'FromForm' for your type. +-- +-- Example: +-- +-- > data BookSearchParams = BookSearchParams +-- > { title :: Text +-- > { authors :: [Text] +-- > , page :: Maybe Int +-- > } deriving (Generic) +-- > instance FromForm BookSearchParams +-- > +-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book] +-- > +-- > server :: Server MyApi +-- > server = getBooksBy +-- > where getBooksBy :: BookSearchParams -> Handler [Book] +-- > getBooksBy searchParams = ...return all books by these conditions... + +instance (FromForm a, HasServer api context) + => HasServer (QueryParamForm a :> api) context where + + type ServerT (QueryParamForm a :> api) m = + a -> ServerT api m + + route Proxy context subserver = route (Proxy :: Proxy api) context $ + subserver `addParameterCheck` withRequest paramsCheck + where + paramsCheck req = + case urlDecodeAsForm (BL.drop 1 . BL.fromStrict $ rawQueryString req) of + Right form -> return form + Left err -> delayedFailFatal err400 + { errBody = cs $ "Error parsing query parameter(s) to form failed: " <> err + } + -- | Just pass the request to the underlying application and serve its response. -- -- Example: diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index c0042f44..d6357962 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -44,7 +44,7 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect, NoContent (..), Patch, PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, - Raw, RemoteHost, ReqBody, + QueryParamForm, Raw, RemoteHost, ReqBody, StdMethod (..), Verb, addHeader) import Servant.API.Internal.Test.ComprehensiveAPI import Servant.Server (Server, Handler, err401, err403, @@ -64,6 +64,7 @@ import Servant.Server.Experimental.Auth mkAuthHandler) import Servant.Server.Internal.Context (NamedContext(..)) +import Web.FormUrlEncoded (FromForm) -- * comprehensive api test @@ -277,12 +278,13 @@ type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person :<|> "b" :> QueryFlag "capitalize" :> Get '[JSON] Person :<|> "param" :> QueryParam "age" Integer :> Get '[JSON] Person :<|> "multiparam" :> QueryParams "ages" Integer :> Get '[JSON] Person + :<|> "paramform" :> QueryParamForm Person :> Get '[JSON] Person queryParamApi :: Proxy QueryParamApi queryParamApi = Proxy qpServer :: Server QueryParamApi -qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAges +qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAges :<|> qpPerson where qpNames (_:name2:_) = return alice { name = name2 } qpNames _ = return alice @@ -295,6 +297,8 @@ qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAge qpAges ages = return alice{ age = sum ages} + qpPerson person = return person + queryParamServer (Just name_) = return alice{name = name_} queryParamServer Nothing = return alice @@ -410,6 +414,28 @@ queryParamSpec = do name = "Alice" } + it "parses query form" $ + (flip runSession) (serve queryParamApi qpServer) $ do + let params = "?name=Alice&age=42" + response <- Network.Wai.Test.request defaultRequest{ + rawQueryString = params, + queryString = parseQuery params, + pathInfo = ["paramform"] + } + liftIO $ + decode' (simpleBody response) `shouldBe` Just alice + + it "generates an error on parse failures of query form" $ + (flip runSession) (serve queryParamApi qpServer) $ do + let params = "?name=Alice" + response <- Network.Wai.Test.request defaultRequest{ + rawQueryString = params, + queryString = parseQuery params, + pathInfo = ["paramform"] + } + liftIO $ statusCode (simpleStatus response) `shouldBe` 400 + return () + -- }}} ------------------------------------------------------------------------------ -- * reqBodySpec {{{ @@ -732,6 +758,7 @@ data Person = Person { instance ToJSON Person instance FromJSON Person +instance FromForm Person alice :: Person alice = Person "Alice" 42