From 966ebe016912c0d7bac8220aab45b8995ddeb54e Mon Sep 17 00:00:00 2001 From: jschaul Date: Mon, 18 Mar 2019 16:43:10 +0100 Subject: [PATCH 1/3] Add support for Lenient|Strict Capture --- servant-server/src/Servant/Server/Internal.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 6405e3dc..9b1a77eb 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -87,7 +87,7 @@ import Servant.API.ResponseHeaders import qualified Servant.Types.SourceT as S import Web.HttpApiData (FromHttpApiData, parseHeader, parseQueryParam, - parseUrlPieceMaybe, parseUrlPieces) + parseUrlPieceMaybe, parseUrlPieces, parseUrlPiece) import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.Context @@ -166,11 +166,11 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont -- > server = getBook -- > where getBook :: Text -> Handler Book -- > getBook isbn = ... -instance (KnownSymbol capture, FromHttpApiData a, HasServer api context) +instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI (FoldLenient mods)) => HasServer (Capture' mods capture a :> api) context where type ServerT (Capture' mods capture a :> api) m = - a -> ServerT api m + If (FoldLenient mods) (Either String a) a -> ServerT api m hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s @@ -178,9 +178,11 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context) CaptureRouter $ route (Proxy :: Proxy api) context - (addCapture d $ \ txt -> case parseUrlPieceMaybe txt of - Nothing -> delayedFail err400 - Just v -> return v + (addCapture d $ \ txt -> case ( sbool :: SBool (FoldLenient mods) + , parseUrlPiece txt :: Either T.Text a) of + (SFalse, Left e) -> delayedFail err400 { errBody = cs e } + (SFalse, Right v) -> return v + (STrue, piece) -> return $ (either (Left . cs) Right) piece ) -- | If you use 'CaptureAll' in one of the endpoints for your API, From a4e570795550df062b541ddf7b0c5f885bae6321 Mon Sep 17 00:00:00 2001 From: jschaul Date: Mon, 18 Mar 2019 17:18:24 +0100 Subject: [PATCH 2/3] add test --- servant-server/test/Servant/ServerSpec.hs | 43 +++++++++++++++++++---- 1 file changed, 36 insertions(+), 7 deletions(-) diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index d940542e..d7583dc2 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -46,7 +46,7 @@ import Network.Wai.Test simpleHeaders, simpleStatus) import Servant.API ((:<|>) (..), (:>), AuthProtect, BasicAuth, - BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete, + BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete, EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..), JSON, NoContent (..), NoFraming, OctetStream, Patch, PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, @@ -54,7 +54,7 @@ import Servant.API addHeader) import Servant.Server (Context ((:.), EmptyContext), Handler, Server, Tagged (..), - emptyServer, err401, err403, err404, serve, serveWithContext) + emptyServer, err400, err401, err403, err404, serve, serveWithContext) import Servant.Test.ComprehensiveAPI import qualified Servant.Types.SourceT as S import Test.Hspec @@ -204,13 +204,27 @@ verbSpec = describe "Servant.API.Verb" $ do ------------------------------------------------------------------------------ type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal + :<|> "ears" :> Capture' '[Lenient] "ears" Integer :> Get '[JSON] Animal + :<|> "eyes" :> Capture' '[Strict] "eyes" Integer :> Get '[JSON] Animal captureApi :: Proxy CaptureApi captureApi = Proxy -captureServer :: Integer -> Handler Animal -captureServer legs = case legs of - 4 -> return jerry - 2 -> return tweety - _ -> throwError err404 + +captureServer :: Server CaptureApi +captureServer = getLegs :<|> getEars :<|> getEyes + where getLegs :: Integer -> Handler Animal + getLegs legs = case legs of + 4 -> return jerry + 2 -> return tweety + _ -> throwError err404 + + getEars :: Either String Integer -> Handler Animal + getEars (Left e) = return chimera -- ignore integer parse error, return weird animal + getEars (Right 2) = return jerry + getEars (Right _) = throwError err404 + + getEyes :: Integer -> Handler Animal + getEyes 2 = return jerry + getEyes _ = throwError err404 captureSpec :: Spec captureSpec = do @@ -224,6 +238,17 @@ captureSpec = do it "returns 400 if the decoding fails" $ do get "/notAnInt" `shouldRespondWith` 400 + it "returns an animal if eyes or ears are 2" $ do + get "/ears/2" `shouldRespondWith` 200 + get "/eyes/2" `shouldRespondWith` 200 + + it "returns a weird animal on Lenient Capture" $ do + response <- get "/ears/bla" + liftIO $ decode' (simpleBody response) `shouldBe` Just chimera + + it "returns 400 if parsing integer fails on Strict Capture" $ do + get "/eyes/bla" `shouldRespondWith` 400 + with (return (serve (Proxy :: Proxy (Capture "captured" String :> Raw)) (\ "captured" -> Tagged $ \request_ respond -> @@ -780,6 +805,10 @@ jerry = Animal "Mouse" 4 tweety :: Animal tweety = Animal "Bird" 2 +-- weird animal with non-integer amount of ears +chimera :: Animal +chimera = Animal "Chimera" (-1) + beholder :: Animal beholder = Animal "Beholder" 0 -- }}} From 6cbf0d38914522bc5652998c86fcef1de4cb89a5 Mon Sep 17 00:00:00 2001 From: jschaul Date: Wed, 20 Mar 2019 12:34:02 +0100 Subject: [PATCH 3/3] add route to comprehensive API --- servant-docs/golden/comprehensive.md | 22 ++++++++++++++++++++ servant/src/Servant/Test/ComprehensiveAPI.hs | 1 + 2 files changed, 23 insertions(+) diff --git a/servant-docs/golden/comprehensive.md b/servant-docs/golden/comprehensive.md index 9239726c..2277af31 100644 --- a/servant-docs/golden/comprehensive.md +++ b/servant-docs/golden/comprehensive.md @@ -96,6 +96,28 @@ ``` +## GET /capture-lenient/:foo + +### Captures: + +- *foo*: Capture foo Int + +### Response: + +- Status code 200 +- Headers: [] + +- Supported content types are: + + - `application/json;charset=utf-8` + - `application/json` + +- Example (`application/json;charset=utf-8`, `application/json`): + +```javascript + +``` + ## GET /description ### foo diff --git a/servant/src/Servant/Test/ComprehensiveAPI.hs b/servant/src/Servant/Test/ComprehensiveAPI.hs index 51721c3a..76800be4 100644 --- a/servant/src/Servant/Test/ComprehensiveAPI.hs +++ b/servant/src/Servant/Test/ComprehensiveAPI.hs @@ -49,6 +49,7 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint = GET :<|> "get-int" :> Get '[JSON] Int :<|> "capture" :> Capture' '[Description "example description"] "foo" Int :> GET + :<|> "capture-lenient" :> Capture' '[Lenient] "foo" Int :> GET :<|> "header" :> Header "foo" Int :> GET :<|> "header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET :<|> "http-version" :> HttpVersion :> GET