Add QueryParamform to Server

Author: isairz

Diff for: 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 for: 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 for: 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