servant-server: add spec for QueryString and DeepQuery
This commit is contained in:
parent
bf477e3954
commit
7b04790796
|
@ -12,16 +12,19 @@
|
||||||
|
|
||||||
module Servant.ServerSpec where
|
module Servant.ServerSpec where
|
||||||
|
|
||||||
|
import Debug.Trace
|
||||||
|
|
||||||
import Prelude ()
|
import Prelude ()
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
(forM_, unless, when)
|
(forM_, join, unless, when)
|
||||||
import Control.Monad.Error.Class
|
import Control.Monad.Error.Class
|
||||||
(MonadError (..))
|
(MonadError (..))
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
(FromJSON, ToJSON, decode', encode)
|
(FromJSON, ToJSON, decode', encode)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
|
import qualified Data.ByteString.Char8 as C8
|
||||||
import qualified Data.ByteString.Base64 as Base64
|
import qualified Data.ByteString.Base64 as Base64
|
||||||
import Data.Char
|
import Data.Char
|
||||||
(toUpper)
|
(toUpper)
|
||||||
|
@ -49,14 +52,15 @@ import Network.Wai.Test
|
||||||
import Servant.API
|
import Servant.API
|
||||||
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
||||||
BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,
|
BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,
|
||||||
Delete, EmptyAPI, Fragment, Get, HasStatus (StatusOf), Header,
|
DeepQuery, Delete, EmptyAPI, Fragment, Get,
|
||||||
Headers, HttpVersion, IsSecure (..), JSON, Lenient,
|
HasStatus (StatusOf), Header, Headers, HttpVersion,
|
||||||
NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch,
|
IsSecure (..), JSON, Lenient, NoContent (..), NoContentVerb,
|
||||||
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
NoFraming, OctetStream, Patch, PlainText, Post, Put,
|
||||||
|
QueryFlag, QueryParam, QueryParams, QueryString, Raw,
|
||||||
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict,
|
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict,
|
||||||
UVerb, Union, Verb, WithStatus (..), addHeader)
|
UVerb, Union, Verb, WithStatus (..), addHeader)
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
(Context ((:.), EmptyContext), FromDeepQuery (..), Handler, Server, Tagged (..),
|
||||||
emptyServer, err401, err403, err404, respond, serve,
|
emptyServer, err401, err403, err404, respond, serve,
|
||||||
serveWithContext)
|
serveWithContext)
|
||||||
import Servant.Test.ComprehensiveAPI
|
import Servant.Test.ComprehensiveAPI
|
||||||
|
@ -67,6 +71,7 @@ import Test.Hspec.Wai
|
||||||
(get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
|
(get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
|
||||||
with, (<:>))
|
with, (<:>))
|
||||||
import qualified Test.Hspec.Wai as THW
|
import qualified Test.Hspec.Wai as THW
|
||||||
|
import Text.Read (readMaybe)
|
||||||
|
|
||||||
import Servant.Server.Experimental.Auth
|
import Servant.Server.Experimental.Auth
|
||||||
(AuthHandler, AuthServerData, mkAuthHandler)
|
(AuthHandler, AuthServerData, mkAuthHandler)
|
||||||
|
@ -320,17 +325,33 @@ captureAllSpec = do
|
||||||
-- * queryParamSpec {{{
|
-- * queryParamSpec {{{
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
data Filter = Filter
|
||||||
|
{ ageFilter :: Integer
|
||||||
|
, nameFilter :: String
|
||||||
|
}
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance FromDeepQuery Filter where
|
||||||
|
fromDeepQuery params = traceShowId $ do
|
||||||
|
let maybeToRight l = maybe (Left l) Right
|
||||||
|
age' <- maybeToRight "missing age" $ readMaybe . T.unpack =<< join (lookup ["age"] params)
|
||||||
|
name' <- maybeToRight "missing name" $ join $ lookup ["name"] params
|
||||||
|
return $ Filter age' (T.unpack name')
|
||||||
|
|
||||||
|
|
||||||
type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
|
type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
|
||||||
:<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
|
:<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
|
||||||
:<|> "b" :> QueryFlag "capitalize" :> Get '[JSON] Person
|
:<|> "b" :> QueryFlag "capitalize" :> Get '[JSON] Person
|
||||||
:<|> "param" :> QueryParam "age" Integer :> Get '[JSON] Person
|
:<|> "param" :> QueryParam "age" Integer :> Get '[JSON] Person
|
||||||
:<|> "multiparam" :> QueryParams "ages" Integer :> Get '[JSON] Person
|
:<|> "multiparam" :> QueryParams "ages" Integer :> Get '[JSON] Person
|
||||||
|
:<|> "raw-query-string" :> QueryString :> Get '[JSON] Person
|
||||||
|
:<|> "deep-query" :> DeepQuery "filter" Filter :> Get '[JSON] Person
|
||||||
|
|
||||||
queryParamApi :: Proxy QueryParamApi
|
queryParamApi :: Proxy QueryParamApi
|
||||||
queryParamApi = Proxy
|
queryParamApi = Proxy
|
||||||
|
|
||||||
qpServer :: Server QueryParamApi
|
qpServer :: Server QueryParamApi
|
||||||
qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAges
|
qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAges :<|> qpRaw :<|> qpDeep
|
||||||
|
|
||||||
where qpNames (_:name2:_) = return alice { name = name2 }
|
where qpNames (_:name2:_) = return alice { name = name2 }
|
||||||
qpNames _ = return alice
|
qpNames _ = return alice
|
||||||
|
@ -343,6 +364,15 @@ qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize :<|> qpAge :<|> qpAge
|
||||||
|
|
||||||
qpAges ages = return alice{ age = sum ages}
|
qpAges ages = return alice{ age = sum ages}
|
||||||
|
|
||||||
|
qpRaw q = return alice { name = maybe mempty C8.unpack $ join (lookup "name" q)
|
||||||
|
, age = fromMaybe 0 (readMaybe . C8.unpack =<< join (lookup "age" q))
|
||||||
|
}
|
||||||
|
|
||||||
|
qpDeep filter' =
|
||||||
|
return alice { name = nameFilter filter'
|
||||||
|
, age = ageFilter filter'
|
||||||
|
}
|
||||||
|
|
||||||
queryParamServer (Just name_) = return alice{name = name_}
|
queryParamServer (Just name_) = return alice{name = name_}
|
||||||
queryParamServer Nothing = return alice
|
queryParamServer Nothing = return alice
|
||||||
|
|
||||||
|
@ -414,6 +444,22 @@ queryParamSpec = do
|
||||||
{ name = "Alice"
|
{ name = "Alice"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
it "allows retrieving a full query string" $
|
||||||
|
flip runSession (serve queryParamApi qpServer) $ do
|
||||||
|
response <- mkRequest "?age=32&name=john" ["raw-query-string"]
|
||||||
|
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
|
||||||
|
{ name = "john"
|
||||||
|
, age = 32
|
||||||
|
}
|
||||||
|
|
||||||
|
it "allows retrieving a query string deep object" $
|
||||||
|
flip runSession (serve queryParamApi qpServer) $ do
|
||||||
|
response <- mkRequest "?filter[age]=32&filter[name]=john" ["deep-query"]
|
||||||
|
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
|
||||||
|
{ name = "john"
|
||||||
|
, age = 32
|
||||||
|
}
|
||||||
|
|
||||||
describe "Uses queryString instead of rawQueryString" $ do
|
describe "Uses queryString instead of rawQueryString" $ do
|
||||||
-- test query parameters rewriter
|
-- test query parameters rewriter
|
||||||
let queryRewriter :: Middleware
|
let queryRewriter :: Middleware
|
||||||
|
|
Loading…
Reference in New Issue
Block a user