From 1ae85d1ee9c2c58c9440203ca629dcd009af2269 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Delafargue?= Date: Thu, 15 Dec 2022 16:30:10 +0100 Subject: [PATCH] servant-client: add spec for QueryString and DeepQuery --- .../test/Servant/ClientTestUtils.hs | 42 +++++++++++++++++-- servant-client/test/Servant/SuccessSpec.hs | 7 ++++ 2 files changed, 46 insertions(+), 3 deletions(-) diff --git a/servant-client/test/Servant/ClientTestUtils.hs b/servant-client/test/Servant/ClientTestUtils.hs index b548c40f..8f98984f 100644 --- a/servant-client/test/Servant/ClientTestUtils.hs +++ b/servant-client/test/Servant/ClientTestUtils.hs @@ -31,11 +31,13 @@ import Control.Monad.Error.Class import Data.Aeson import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as C8 import Data.ByteString.Builder (byteString) import qualified Data.ByteString.Lazy as LazyByteString import Data.Char (chr, isPrint) +import Data.Maybe (fromMaybe) import Data.Monoid () import Data.Proxy import Data.SOP @@ -54,17 +56,18 @@ import Network.Wai.Handler.Warp import System.IO.Unsafe (unsafePerformIO) import Test.QuickCheck +import Text.Read (readMaybe) import Web.FormUrlEncoded (FromForm, ToForm) import Servant.API ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, - BasicAuthData (..), Capture, CaptureAll, DeleteNoContent, + BasicAuthData (..), Capture, CaptureAll, DeepQuery, DeleteNoContent, EmptyAPI, FormUrlEncoded, Fragment, FromHttpApiData (..), Get, Header, Headers, JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam, - QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union, - Verb, WithStatus (WithStatus), NamedRoutes, addHeader) + QueryParams, QueryString, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), + UVerb, Union, Verb, WithStatus (WithStatus), NamedRoutes, addHeader) import Servant.API.Generic ((:-)) import Servant.Client import qualified Servant.Client.Core.Auth as Auth @@ -121,6 +124,25 @@ data OtherRoutes mode = OtherRoutes -- Get for HTTP 307 Temporary Redirect type Get307 = Verb 'GET 307 +data Filter = Filter + { ageFilter :: Integer + , nameFilter :: String + } + deriving Show + +instance FromDeepQuery Filter where + fromDeepQuery params = do + let maybeToRight l = maybe (Left l) Right + age' <- maybeToRight "missing age" $ readMaybe . Text.unpack =<< join (lookup ["age"] params) + name' <- maybeToRight "missing name" $ join $ lookup ["name"] params + return $ Filter age' (Text.unpack name') + +instance ToDeepQuery Filter where + toDeepQuery (Filter age' name') = + [ (["age"], Just (Text.pack $ show age')) + , (["name"], Just (Text.pack name')) + ] + type Api = Get '[JSON] Person :<|> "get" :> Get '[JSON] Person @@ -139,6 +161,8 @@ type Api = :<|> "param-binary" :> QueryParam "payload" UrlEncodedByteString :> Raw :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person] :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool + :<|> "query-string" :> QueryString :> Get '[JSON] Person + :<|> "deep-query" :> DeepQuery "filter" Filter :> Get '[JSON] Person :<|> "fragment" :> Fragment String :> Get '[JSON] Person :<|> "rawSuccess" :> Raw :<|> "rawSuccessPassHeaders" :> Raw @@ -176,6 +200,8 @@ getQueryParam :: Maybe String -> ClientM Person getQueryParamBinary :: Maybe UrlEncodedByteString -> HTTP.Method -> ClientM Response getQueryParams :: [String] -> ClientM [Person] getQueryFlag :: Bool -> ClientM Bool +getQueryString :: [(ByteString, Maybe ByteString)] -> ClientM Person +getDeepQuery :: Filter -> ClientM Person getFragment :: ClientM Person getRawSuccess :: HTTP.Method -> ClientM Response getRawSuccessPassHeaders :: HTTP.Method -> ClientM Response @@ -203,6 +229,8 @@ getRoot :<|> getQueryParamBinary :<|> getQueryParams :<|> getQueryFlag + :<|> getQueryString + :<|> getDeepQuery :<|> getFragment :<|> getRawSuccess :<|> getRawSuccessPassHeaders @@ -240,6 +268,14 @@ server = serve api ( ) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return + :<|> (\ q -> return alice { _name = maybe mempty C8.unpack $ join (lookup "name" q) + , _age = fromMaybe 0 (readMaybe . C8.unpack =<< join (lookup "age" q)) + } + ) + :<|> (\ filter' -> return alice { _name = nameFilter filter' + , _age = ageFilter filter' + } + ) :<|> return alice :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess") :<|> (Tagged $ \ request respond -> (respond $ Wai.responseLBS HTTP.ok200 (Wai.requestHeaders $ request) "rawSuccess")) diff --git a/servant-client/test/Servant/SuccessSpec.hs b/servant-client/test/Servant/SuccessSpec.hs index 06437ca6..28009f89 100644 --- a/servant-client/test/Servant/SuccessSpec.hs +++ b/servant-client/test/Servant/SuccessSpec.hs @@ -115,6 +115,13 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do left show <$> runClient (getQueryFlag flag) baseUrl `shouldReturn` Right flag + it "Servant.API.QueryParam.QueryString" $ \(_, baseUrl) -> do + let qs = [("name", Just "bob"), ("age", Just "1")] + left show <$> runClient (getQueryString qs) baseUrl `shouldReturn` (Right (Person "bob" 1)) + + it "Servant.API.QueryParam.DeepQuery" $ \(_, baseUrl) -> do + left show <$> runClient (getDeepQuery $ Filter 1 "bob") baseUrl `shouldReturn` (Right (Person "bob" 1)) + it "Servant.API.Fragment" $ \(_, baseUrl) -> do left id <$> runClient getFragment baseUrl `shouldReturn` Right alice