eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Rewrite client concatQueryString for client requests and pull extraneous data type for spec

Browse source 
Remove symbol from QueryParamForm type args

Remove the data instance for QueryParamForm in HasDocs
This commit is contained in:
Erik Aker 2019-10-02 20:47:54 -07:00
parent cffa511df9
commit 68014463d9
12 changed files with 82 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
servant-client-core/src/Servant/Client/Core/HasClient.hs
View file

@ -557,7 +557,7 @@ instance (KnownSymbol sym, HasClient m api)
-- > } deriving (Eq, Show, Generic)
-- > instance ToForm BookSearchParams
--
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
-- >
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
@ -567,10 +567,10 @@ instance (KnownSymbol sym, HasClient m api)
-- > -- then you can just use "getBooks" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just $ BookSearchParams "white noise" ["DeLillo"] Nothing)'
instance (KnownSymbol sym, ToForm a, HasClient m api, SBoolI (FoldRequired mods))
=> HasClient m (QueryParamForm' mods sym a :> api) where
instance (ToForm a, HasClient m api, SBoolI (FoldRequired mods))
=> HasClient m (QueryParamForm' mods a :> api) where
type Client m (QueryParamForm' mods sym a :> api) =
type Client m (QueryParamForm' mods a :> api) =
RequiredArgument mods a -> Client m api
-- if mparam = Nothing, we don't add it to the query string

10
servant-client-core/src/Servant/Client/Core/Request.hs
View file

@ -51,11 +51,11 @@ import Network.HTTP.Media
(MediaType)
import Network.HTTP.Types
(Header, HeaderName, HttpVersion (..), Method, QueryItem,
http11, methodGet, parseQuery)
http11, methodGet)
import Servant.API
(ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
import Web.FormUrlEncoded
(ToForm (..), urlEncodeAsForm)
(ToForm (..), toListStable)
import Servant.Client.Core.Internal (mediaTypeRnf)
@ -143,14 +143,16 @@ concatQueryString :: ToForm a
-> Request
-> Request
concatQueryString form req
= let querySeq = Seq.fromList . parseQuery . LBS.toStrict . urlEncodeAsForm $ form
= let
queryEncoder = map (bimap encodeUtf8 (Just . encodeUtf8))
querySeq = Seq.fromList . queryEncoder . toListStable . toForm $ form
in req { requestQueryString = requestQueryString req Seq.>< querySeq }
-- | Set body and media type of the request being constructed.
--
-- The body is set to the given bytestring using the 'RequestBodyLBS'
-- constructor.
--
-- @since 0.12
--
setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request

22
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -32,8 +32,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBSC
import Data.ByteString.Lazy.Char8
(ByteString)
import qualified Data.CaseInsensitive as CI
import Data.Data
(Data, toConstr, constrFields)
import Data.Foldable
(toList)
import Data.Foldable
@ -955,25 +953,23 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
paramP = Proxy :: Proxy (QueryFlag sym)
action' = over params (|> toParam paramP) action
-- | The docs for a @'QueryParamForm' sym a'@
-- require the following instances for the `a`:
-- 'Data', 'ToSample'
instance (KnownSymbol sym, Data a, ToForm a, ToSample a, HasDocs api)
=> HasDocs (QueryParamForm' mods sym a :> api) where
-- | The docs for a @'QueryParamForm' a'@
-- require a 'ToSample a' instance
instance (ToForm a, ToSample a, HasDocs api)
=> HasDocs (QueryParamForm' mods a :> api) where
docsFor Proxy (endpoint, action) =
docsFor subApiP (endpoint, action')
where subApiP = Proxy :: Proxy api
action' =
let (Just sampleForm) = toSample (Proxy :: Proxy a)
paramNames = constrFields (toConstr sampleForm)
sampleEncoding = LBSC.unpack . urlEncodeAsForm . toForm $ sampleForm
in action & params <>~ (fmap (qParamMaker sampleEncoding) paramNames)
qParamMaker formEncodedSample pName = DocQueryParam {
_paramName = pName
in action & params <>~ [qParamMaker sampleEncoding]
qParamMaker formEncodedSample = DocQueryParam {
_paramName = "Collection of Parameters"
, _paramValues = [formEncodedSample]
, _paramDesc = "Query parameter"
, _paramDesc = "Query parameters"
, _paramKind = Normal
}

9
servant-docs/test/Servant/DocsSpec.hs
View file

@ -58,7 +58,7 @@ instance ToParam (QueryParam' mods "bar" Int) where
instance ToParam (QueryParams "foo" Int) where
toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" List
instance ToParam (QueryParam "query" String) where
toParam _ = DocQueryParam "query" ["a","b","c"] "QueryParams String" Normal
toParam _ = DocQueryParam "query" ["a","b","c"] "QueryParams String" Normal
instance ToParam (QueryFlag "foo") where
toParam _ = DocQueryParam "foo" [] "QueryFlag" Flag
instance ToCapture (Capture "foo" Int) where
@ -143,10 +143,7 @@ spec = describe "Servant.Docs" $ do
it "mentions optional query-param" $ do
md `shouldContain` "### GET Parameters:"
md `shouldContain` "- query"
it "mentions optional query-param-form params from QueryParamForm" $ do
md `shouldContain` "- dt1field1"
md `shouldContain` "- dt1field2"
-- contains sample url-encoded form
it "mentions optional query-param-form params from QueryParamForm" $
md `shouldContain` "- **Values**: *dt1field1=field%201&dt1field2=13*"
it "does not generate any docs mentioning the 'empty-api' path" $
@ -177,7 +174,7 @@ instance MimeRender PlainText Int where
type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
:<|> "postJson" :> ReqBody '[JSON] String :> Post '[JSON] Datatype1
:<|> "qparam" :> QueryParam "query" String :> Get '[JSON] Datatype1
:<|> "qparamform" :> QueryParamForm "form" Datatype1 :> Get '[JSON] Datatype1
:<|> "qparamform" :> QueryParamForm Datatype1 :> Get '[JSON] Datatype1
:<|> "header" :> Header "X-Test" Int :> Put '[JSON] Int
:<|> "empty-api" :> EmptyAPI

8
servant-foreign/src/Servant/Foreign/Internal.hs
View file

@ -325,9 +325,9 @@ instance
{ _argName = PathSegment str
, _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
=> HasForeign lang ftype (QueryParamForm' mods sym a :> api) where
type Foreign ftype (QueryParamForm' mods sym a :> api) = Foreign ftype api
instance (HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
=> HasForeign lang ftype (QueryParamForm' mods a :> api) where
type Foreign ftype (QueryParamForm' mods a :> api) = Foreign ftype api
foreignFor lang Proxy Proxy req =
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
@ -336,7 +336,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a),
arg = Arg
{ _argName = PathSegment ""
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy (RequiredArgument mods a)) }
instance HasForeign lang ftype Raw where
type Foreign ftype Raw = HTTP.Method -> Req ftype

2
servant-foreign/test/Servant/ForeignSpec.hs
View file

@ -82,7 +82,7 @@ instance HasForeignType LangX String ContactForm where
type TestApi
= "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
:<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
:<|> "test" :> QueryParamForm "contact" ContactForm :> Post '[JSON] NoContent
:<|> "test" :> QueryParamForm ContactForm :> Post '[JSON] NoContent
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
:<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
:<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]

18
servant-http-streams/test/Servant/ClientSpec.hs
View file

@ -111,14 +111,6 @@ alice = Person "Alice" 42
carol :: Person
carol = Person "Carol" 17
data PersonSearch = PersonSearch
{ nameStartsWith :: String
, ageGreaterThan :: Integer
} deriving (Eq, Show, Generic)
instance ToForm PersonSearch
instance FromForm PersonSearch
type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
type Api =
@ -130,7 +122,7 @@ type Api =
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
:<|> "paramform" :> QueryParamForm "names" PersonSearch :> Get '[JSON] [Person]
:<|> "paramform" :> QueryParamForm Person :> Get '[JSON] [Person]
:<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
:<|> "rawSuccess" :> Raw
:<|> "rawFailure" :> Raw
@ -156,7 +148,7 @@ getCaptureAll :: [String] -> ClientM [Person]
getBody :: Person -> ClientM Person
getQueryParam :: Maybe String -> ClientM Person
getQueryParams :: [String] -> ClientM [Person]
getQueryParamForm :: Maybe PersonSearch -> ClientM [Person]
getQueryParamForm :: Maybe Person -> ClientM [Person]
getQueryFlag :: Bool -> ClientM Bool
getRawSuccess :: HTTP.Method -> ClientM Response
getRawFailure :: HTTP.Method -> ClientM Response
@ -198,8 +190,8 @@ server = serve api (
Nothing -> throwError $ ServerError 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> (\ psearch -> case psearch of
Just (Right psearch) -> return [alice, carol]
Just (Left err) -> throwError $ ServerError 400 "failed to decode form" "" []
Just (Right _) -> return [alice, carol]
Just (Left _) -> throwError $ ServerError 400 "failed to decode form" "" []
Nothing -> return [])
:<|> return
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
@ -323,7 +315,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
it "Servant.API.QueryParam.QueryParamForm" $ \(_, baseUrl) -> do
left show <$> runClient (getQueryParamForm Nothing) baseUrl `shouldReturn` Right []
left show <$> runClient (getQueryParamForm (Just $ PersonSearch "a" 10)) baseUrl
left show <$> runClient (getQueryParamForm (Just $ Person "a" 10)) baseUrl
`shouldReturn` Right [alice, carol]
context "Servant.API.QueryParam.QueryFlag" $

27
servant-server/src/Servant/Server/Internal.hs
View file

@ -558,9 +558,9 @@ instance (KnownSymbol sym, HasServer api context)
examine v | v == "true" || v == "1" || v == "" = True
| otherwise = False
-- | If you define a custom record type, for example @BookSearchParams@, then you can use
-- @'QueryParamForm' "formName" BookSearchParams@ in one of the endpoints for your API
-- to translate a collection of query-string parameters into a value of your record type.
-- | If you define a custom record type, for example @BookSearchParams@, then you can use
-- @'QueryParamForm' BookSearchParams@ in one of the endpoints for your API
-- to translate a collection of query-string parameters into a value of your record type.
--
-- Your server-side handler must be a function that takes an argument of type
-- @'Maybe' ('Either' BookSearchParams)@.
@ -582,26 +582,24 @@ instance (KnownSymbol sym, HasServer api context)
-- > , page :: Maybe Int
-- > } deriving (Eq, Show, Generic)
-- > instance FromForm BookSearchParams
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
--
-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
--
-- Example Handler Signature:
-- Maybe (Either Text BookSearchParams) -> Handler [Book]
instance
( KnownSymbol sym, FromForm a, HasServer api context
(FromForm a, HasServer api context
, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)
)
=> HasServer (QueryParamForm' mods sym a :> api) context where
=> HasServer (QueryParamForm' mods a :> api) context where
------
type ServerT (QueryParamForm' mods sym a :> api) m =
type ServerT (QueryParamForm' mods a :> api) m =
RequestArgument mods a -> ServerT api m
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
route Proxy context subserver =
let formName = cs $ symbolVal (Proxy :: Proxy sym)
route Proxy context subserver =
parseParamForm req =
let parseParamForm req =
unfoldRequestArgument (Proxy :: Proxy mods) errReq errSt mev
where
rawQS = rawQueryString req
@ -612,12 +610,11 @@ instance
_ -> Just $ urlDecodeAsForm (BL.drop 1 . BL.fromStrict $ rawQS)
errReq = delayedFailFatal err400
{ errBody = cs $ "Query parameter form " <> formName <> " is required"
{ errBody = "Query parameter form is required"
}
errSt e = delayedFailFatal err400
{ errBody = cs $ "Error parsing query parameter form "
<> formName <> " failed: " <> e
{ errBody = cs $ "Error: parsing query parameter form failed. " <> e
}
delayed = addParameterCheck subserver . withRequest $ \req ->

6
servant-server/test/Servant/ServerSpec.hs
View file

@ -466,14 +466,14 @@ data AnimalSearch = AnimalSearch {
instance FromForm AnimalSearch
type QueryParamFormApi =
QueryParamForm "octopus" AnimalSearch :> Get '[JSON] Animal
QueryParamForm AnimalSearch :> Get '[JSON] Animal
:<|> "before-param"
:> QueryParam "before" Bool
:> QueryParamForm "before" AnimalSearch
:> QueryParamForm AnimalSearch
:> Get '[JSON] Animal
:<|> "mixed-param"
:> QueryParam "before" Bool
:> QueryParamForm "multiple" AnimalSearch
:> QueryParamForm AnimalSearch
:> QueryParam "after" Bool
:> Get '[JSON] Animal

8
servant/src/Servant/API/QueryParam.hs
View file

@ -50,7 +50,7 @@ data QueryParams (sym :: Symbol) (a :: *)
-- of type (Maybe (Either Text a)). This also means that in a server implementation
-- if there as a query string of any length (even just a "?"), we'll try to parse
-- the 'QueryParamForm' into the custom type specified.
--
--
-- Example:
--
-- > data BookSearchParams = BookSearchParams
@ -59,15 +59,15 @@ data QueryParams (sym :: Symbol) (a :: *)
-- > , page :: Maybe Int
-- > } deriving (Eq, Show, Generic)
-- > instance FromForm BookSearchParams
-- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
--
-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
--
-- Example Handler Signature:
-- Maybe (Either Text BookSearchParams) -> Handler [Book]
type QueryParamForm = QueryParamForm' '[Optional, Lenient]
-- | 'QueryParamForm' which can be 'Required', 'Lenient', or modified otherwise.
data QueryParamForm' (mods :: [*]) (sym :: Symbol) (a :: *)
data QueryParamForm' (mods :: [*]) (a :: *)
deriving Typeable

12
servant/src/Servant/Links.hs
View file

@ -142,7 +142,7 @@ import Network.URI
import Prelude ()
import Prelude.Compat
import Web.FormUrlEncoded
(ToForm(..), urlEncodeAsFormStable)
(ToForm(..), urlEncodeAsForm)
import Servant.API.Alternative
((:<|>) ((:<|>)))
@ -478,15 +478,15 @@ instance (KnownSymbol sym, HasLink sub)
where
k = symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, ToForm v, HasLink sub, SBoolI (FoldRequired mods))
=> HasLink (QueryParamForm' mods sym v :> sub)
instance (ToForm v, HasLink sub, SBoolI (FoldRequired mods))
=> HasLink (QueryParamForm' mods v :> sub)
where
type MkLink (QueryParamForm' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
type MkLink (QueryParamForm' mods v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
toLink toA _ l mv =
toLink toA (Proxy :: Proxy sub) $
case sbool :: SBool (FoldRequired mods) of
STrue -> (addQueryParam . FormParam . urlEncodeAsFormStable) mv l
SFalse -> maybe id (addQueryParam . FormParam . urlEncodeAsFormStable) mv l
STrue -> (addQueryParam . FormParam . urlEncodeAsForm) mv l
SFalse -> maybe id (addQueryParam . FormParam . urlEncodeAsForm) mv l
-- :<|> instance - Generate all links at once
instance (HasLink a, HasLink b) => HasLink (a :<|> b) where

33
servant/test/Servant/LinksSpec.hs
View file

@ -6,13 +6,15 @@
{-# LANGUAGE TypeOperators #-}
module Servant.LinksSpec where
import Data.Proxy
(Proxy (..))
import Data.String
(fromString)
import qualified Data.Text as T
import GHC.Generics
import Test.Hspec
(Expectation, Spec, describe, it, shouldBe)
(Expectation, Spec, describe, it, shouldBe, shouldContain)
import Web.FormUrlEncoded
(ToForm(..))
@ -25,8 +27,8 @@ type TestApi =
-- Capture and query params
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] NoContent
:<|> "hi" :> Capture "name" String :> QueryParam' '[Required] "capital" Bool :> Delete '[JSON] NoContent
:<|> "formR" :> QueryParamForm' '[Required, Strict] "someform" TestForm :> Delete '[JSON] NoContent
:<|> "form-opt" :> QueryParamForm "someform" TestForm :> Delete '[JSON] NoContent
:<|> "formR" :> QueryParamForm' '[Required, Strict] TestForm :> Delete '[JSON] NoContent
:<|> "form-opt" :> QueryParamForm TestForm :> Delete '[JSON] NoContent
:<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent
-- Flags
@ -62,6 +64,10 @@ shouldBeLink :: Link -> String -> Expectation
shouldBeLink link expected =
toUrlPiece link `shouldBe` fromString expected
linkShouldContain :: Link -> String -> Expectation
linkShouldContain link expected =
T.unpack (toUrlPiece link) `shouldContain` expected
spec :: Spec
spec = describe "Servant.Links" $ do
it "generates correct links for capture query params" $ do
@ -80,14 +86,25 @@ spec = describe "Servant.Links" $ do
it "generates query param form links" $ do
-- most who use QueryParamForm are not going to use it Required, Strict, so we'll test it both ways
let l3 = Proxy :: Proxy ("formR" :> QueryParamForm' '[Required, Strict] "someform" TestForm
let l3 = Proxy :: Proxy ("formR" :> QueryParamForm' '[Required, Strict] TestForm
:> Delete '[JSON] NoContent)
-- We allow `urlEncodeAsFormStable` to uri Escape for us. Validating that assumption here:
apiLink l3 (TestForm "sure" "später") `shouldBeLink` "formR?testing=sure&time=sp%C3%A4ter"
let l4 = Proxy :: Proxy ("form-opt" :> QueryParamForm "someform" TestForm
let result3 = apiLink l3 (TestForm "sure" "später")
-- we can't guarantee the order of the params unless we switch to `urlEncodeAsFormStable`...
result3 `linkShouldContain` "formR?"
result3 `linkShouldContain` "&"
result3 `linkShouldContain` "time=sp%C3%A4ter"
result3 `linkShouldContain` "testing=sure"
let l4 = Proxy :: Proxy ("form-opt" :> QueryParamForm TestForm
:> Delete '[JSON] NoContent)
apiLink l4 (Just $ TestForm "sure" "später") `shouldBeLink` "form-opt?testing=sure&time=sp%C3%A4ter"
let result4 = apiLink l4 (Just $ TestForm "sure" "später")
-- we can't guarantee the order of the params unless we switch to `urlEncodeAsFormStable`...
result4 `linkShouldContain` "form-opt?"
result4 `linkShouldContain` "&"
result4 `linkShouldContain` "time=sp%C3%A4ter"
result4 `linkShouldContain` "testing=sure"
it "generates correct links for CaptureAll" $ do
apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))