From 3c13cb8e5a690bc98a57c7722fc3480261259d8a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Delafargue?= <clement@delafargue.name>
Date: Wed, 24 Aug 2022 15:17:04 +0200
Subject: [PATCH] Add support for full query string capture in servant-server

---
 servant-server/src/Servant/Server/Internal.hs | 30 +++++++++++++-
 servant/servant.cabal                         |  1 +
 servant/src/Servant/API.hs                    |  4 ++
 servant/src/Servant/API/QueryString.hs        | 39 +++++++++++++++++++
 4 files changed, 73 insertions(+), 1 deletion(-)
 create mode 100644 servant/src/Servant/API/QueryString.hs

diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index a4d74564..63857ded 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -74,7 +74,7 @@ import           Servant.API
                  CaptureAll, Description, EmptyAPI, Fragment,
                  FramingRender (..), FramingUnrender (..), FromSourceIO (..),
                  Header', If, IsSecure (..), NoContentVerb, QueryFlag,
-                 QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),
+                 QueryParam', QueryParams, QueryString, Raw, ReflectMethod (reflectMethod),
                  RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,
                  Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,
                  WithNamedContext, NamedRoutes)
@@ -585,6 +585,34 @@ instance (KnownSymbol sym, HasServer api context)
           examine v | v == "true" || v == "1" || v == "" = True
                     | otherwise = False
 
+-- | If you use @'QueryString'@ 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 @Query@ (@[('ByteString', 'Maybe' 'ByteString')]@).
+--
+-- This lets you extract the whole query string. This is useful when the query string
+-- can contain parameters with dynamic names, that you can't access with @'QueryParam'@.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> QueryString :> Get '[JSON] [Book]
+-- >
+-- > server :: Server MyApi
+-- > server = getBooksBy
+-- >   where getBooksBy :: Query -> Handler [Book]
+-- >         getBooksBy filters = ...filter books based on the dynamic filters provided...
+instance
+  ( HasServer api context
+  )
+  => HasServer (QueryString :> api) context where
+------
+  type ServerT (QueryString :> api) m =
+    Query -> ServerT api m
+
+  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
+
+  route Proxy context subserver =
+    route (Proxy :: Proxy api) context (passToServer subserver queryString)
+
 -- | Just pass the request to the underlying application and serve its response.
 --
 -- Example:
diff --git a/servant/servant.cabal b/servant/servant.cabal
index a3dc401d..27874ecd 100644
--- a/servant/servant.cabal
+++ b/servant/servant.cabal
@@ -48,6 +48,7 @@ library
     Servant.API.Modifiers
     Servant.API.NamedRoutes
     Servant.API.QueryParam
+    Servant.API.QueryString
     Servant.API.Raw
     Servant.API.RemoteHost
     Servant.API.ReqBody
diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs
index 22309dce..cf50d46b 100644
--- a/servant/src/Servant/API.hs
+++ b/servant/src/Servant/API.hs
@@ -19,6 +19,8 @@ module Servant.API (
   -- | Retrieving the HTTP version of the request
   module Servant.API.QueryParam,
   -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@
+  module Servant.API.QueryString,
+  -- | Retrieving the complete query string of the 'URI': @'QueryString'@
   module Servant.API.Fragment,
   -- | Documenting the fragment of the 'URI': @'Fragment'@
   module Servant.API.ReqBody,
@@ -114,6 +116,8 @@ import           Servant.API.Modifiers
                  (Lenient, Optional, Required, Strict)
 import           Servant.API.QueryParam
                  (QueryFlag, QueryParam, QueryParam', QueryParams)
+import           Servant.API.QueryString
+                 (QueryString)
 import           Servant.API.Raw
                  (Raw)
 import           Servant.API.RemoteHost
diff --git a/servant/src/Servant/API/QueryString.hs b/servant/src/Servant/API/QueryString.hs
new file mode 100644
index 00000000..138ffeec
--- /dev/null
+++ b/servant/src/Servant/API/QueryString.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE PolyKinds          #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# OPTIONS_HADDOCK not-home    #-}
+module Servant.API.QueryString (QueryString, DeepQuery) where
+
+import           Data.Typeable
+                 (Typeable)
+import           GHC.TypeLits
+                 (Symbol)
+
+-- | Extract the whole query string from a request. This is useful for query strings
+-- containing dynamic parameter names. For query strings with static parameter names,
+-- 'QueryParam' is more suited.
+--
+-- Example:
+--
+-- >>> -- /books?author=<author name>&year=<book year>
+-- >>> type MyApi = "books" :> QueryString :> Get '[JSON] [Book]
+data QueryString
+    deriving Typeable
+
+-- | Extract an deep object from a query string.
+--
+-- Example:
+--
+-- >>> -- /books?filter[author][name]=<author name>&filter[year]=<book year>
+-- >>> type MyApi = "books" :> DeepQuery "filter" BookQuery :> Get '[JSON] [Book]
+data DeepQuery (sym :: Symbol) (a :: *)
+    deriving Typeable
+
+-- $setup
+-- >>> import Servant.API
+-- >>> import Data.Aeson
+-- >>> import Data.Text
+-- >>> data Book
+-- >>> data BookQuery
+-- >>> instance ToJSON Book where { toJSON = undefined }