From 7472c505695a396e25a5818eb9df25412ee0e8ef Mon Sep 17 00:00:00 2001 From: tmbull Date: Thu, 12 Oct 2017 17:44:57 -0500 Subject: [PATCH] Adding request body content types to servant-foreign request type. --- .../src/Servant/Foreign/Internal.hs | 19 +++++---- servant-foreign/test/Servant/ForeignSpec.hs | 42 ++++++++++++++----- 2 files changed, 42 insertions(+), 19 deletions(-) diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index ceb3a05d..f990c1ce 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -22,7 +22,6 @@ import Network.HTTP.Media.MediaType import Prelude hiding (concat) import Servant.API import Servant.API.ContentTypes (AllMime, allMime) -import Servant.API.TypeLevel newtype FunctionName = FunctionName { unFunctionName :: [Text] } @@ -121,13 +120,14 @@ defUrl = Url [] [] makeLenses ''Url data Req f = Req - { _reqUrl :: Url f - , _reqMethod :: HTTP.Method - , _reqHeaders :: [HeaderArg f] - , _reqBody :: Maybe f - , _reqReturnType :: Maybe f - , _reqFuncName :: FunctionName + { _reqUrl :: Url f + , _reqMethod :: HTTP.Method + , _reqHeaders :: [HeaderArg f] + , _reqBody :: Maybe f + , _reqBodyContentTypes :: [MediaType] + , _reqReturnType :: Maybe f , _reqReturnContentTypes :: [MediaType] + , _reqFuncName :: FunctionName } deriving instance Eq f => Eq (Req f) @@ -136,7 +136,7 @@ deriving instance Show f => Show (Req f) makeLenses ''Req defReq :: Req ftype -defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) [] +defReq = Req defUrl "GET" [] Nothing [] Nothing [] (FunctionName []) -- | 'HasForeignType' maps Haskell types with types in the target -- language of your backend. For example, let's say you're @@ -302,13 +302,14 @@ instance HasForeign lang ftype Raw where req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :) & reqMethod .~ method -instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api) +instance (AllMime list, HasForeignType lang ftype a, HasForeign lang ftype api) => HasForeign lang ftype (ReqBody list a :> api) where type Foreign ftype (ReqBody list a :> api) = Foreign ftype api foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $ req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a)) + & reqBodyContentTypes .~ allMime (Proxy :: Proxy list) instance (KnownSymbol path, HasForeign lang ftype api) => HasForeign lang ftype (path :> api) where diff --git a/servant-foreign/test/Servant/ForeignSpec.hs b/servant-foreign/test/Servant/ForeignSpec.hs index 25c2d053..bd449f74 100644 --- a/servant-foreign/test/Servant/ForeignSpec.hs +++ b/servant-foreign/test/Servant/ForeignSpec.hs @@ -58,7 +58,8 @@ type TestApi :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int] - :<|> "test" :> "text" :> Get '[PlainText] String + :<|> "test" :> "text" :> ReqBody '[PlainText] String :> Get '[PlainText] String + :<|> "test" :> "multi" :> ReqBody '[JSON, PlainText] String :> Get '[JSON, PlainText] String :<|> "test" :> EmptyAPI testApi :: [Req String] @@ -67,9 +68,9 @@ testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: P listFromAPISpec :: Spec listFromAPISpec = describe "listFromAPI" $ do it "generates 5 endpoints for TestApi" $ do - length testApi `shouldBe` 6 + length testApi `shouldBe` 7 - let [getReq, postReq, putReq, deleteReq, captureAllReq, getTextReq] = testApi + let [getReq, postReq, putReq, deleteReq, captureAllReq, getTextReq, getMultiReq] = testApi it "collects all info for get request" $ do shouldBe getReq $ defReq @@ -79,9 +80,10 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqMethod = "GET" , _reqHeaders = [HeaderArg $ Arg "header" "listX of stringX"] , _reqBody = Nothing + , _reqBodyContentTypes = [] , _reqReturnType = Just "intX" - , _reqFuncName = FunctionName ["get", "test"] , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) + , _reqFuncName = FunctionName ["get", "test"] } it "collects all info for post request" $ do @@ -92,9 +94,10 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqMethod = "POST" , _reqHeaders = [] , _reqBody = Just "listX of stringX" + , _reqBodyContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) , _reqReturnType = Just "voidX" - , _reqFuncName = FunctionName ["post", "test"] , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) + , _reqFuncName = FunctionName ["post", "test"] } it "collects all info for put request" $ do @@ -106,9 +109,10 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqMethod = "PUT" , _reqHeaders = [] , _reqBody = Just "stringX" + , _reqBodyContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) , _reqReturnType = Just "voidX" - , _reqFuncName = FunctionName ["put", "test"] , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) + , _reqFuncName = FunctionName ["put", "test"] } it "collects all info for delete request" $ do @@ -120,9 +124,10 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqMethod = "DELETE" , _reqHeaders = [] , _reqBody = Nothing + , _reqBodyContentTypes = [] , _reqReturnType = Just "voidX" - , _reqFuncName = FunctionName ["delete", "test", "by", "id"] , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) + , _reqFuncName = FunctionName ["delete", "test", "by", "id"] } it "collects all info for capture all request" $ do @@ -134,9 +139,10 @@ listFromAPISpec = describe "listFromAPI" $ do , _reqMethod = "GET" , _reqHeaders = [] , _reqBody = Nothing + , _reqBodyContentTypes = [] , _reqReturnType = Just "listX of intX" - , _reqFuncName = FunctionName ["get", "test", "by", "ids"] , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy JSON) + , _reqFuncName = FunctionName ["get", "test", "by", "ids"] } it "collects all info for plaintext request" $ do @@ -147,9 +153,25 @@ listFromAPISpec = describe "listFromAPI" $ do [] , _reqMethod = "GET" , _reqHeaders = [] - , _reqBody = Nothing + , _reqBody = Just "stringX" + , _reqBodyContentTypes = toList $ contentTypes (Proxy :: Proxy PlainText) , _reqReturnType = Just "stringX" - , _reqFuncName = FunctionName ["get", "test", "text"] , _reqReturnContentTypes = toList $ contentTypes (Proxy :: Proxy PlainText) + , _reqFuncName = FunctionName ["get", "test", "text"] + } + + it "collects all info for requets with multiple request/return types" $ do + shouldBe getMultiReq $ defReq + { _reqUrl = Url + [ Segment $ Static "test" + , Segment $ Static "multi" ] + [] + , _reqMethod = "GET" + , _reqHeaders = [] + , _reqBody = Just "stringX" + , _reqBodyContentTypes = (toList $ contentTypes (Proxy :: Proxy JSON)) ++ [contentType (Proxy :: Proxy PlainText)] + , _reqReturnType = Just "stringX" + , _reqReturnContentTypes = (toList $ contentTypes (Proxy :: Proxy JSON)) ++ [contentType (Proxy :: Proxy PlainText)] + , _reqFuncName = FunctionName ["get", "test", "multi"] }