Rewrite client concatQueryString for client requests and pull extraneous data type for spec
Remove symbol from QueryParamForm type args Remove the data instance for QueryParamForm in HasDocs
This commit is contained in:
parent
cffa511df9
commit
68014463d9
12 changed files with 82 additions and 81 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,11 +953,10 @@ 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')
|
||||
|
@ -967,13 +964,12 @@ instance (KnownSymbol sym, Data a, ToForm a, ToSample a, HasDocs api)
|
|||
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
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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) $
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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" $
|
||||
|
|
|
@ -559,7 +559,7 @@ instance (KnownSymbol sym, HasServer api context)
|
|||
| 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
|
||||
-- @'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
|
||||
|
@ -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)
|
||||
|
||||
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 ->
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -59,7 +59,7 @@ 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]
|
||||
|
@ -67,7 +67,7 @@ data QueryParams (sym :: Symbol) (a :: *)
|
|||
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
|
||||
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in a new issue