git.iko.soy/servant
on master help sign in
Merge pull request #1156 from wireapp/feature/capture-lenient

Feature/capture lenient

commitdc4125dcc45a98629a8d55300cf256a010e579ce authorOleg Grenrus <oleg.grenrus@iki.fi> dateWed 27 Mar 2019, 01:15 (8 years ago) parentad022806cbf0d3
4 files changed+67−13
compare with master
unifiedsplit
servant-docs/golden/comprehensive.md+22 servant-server/src/Servant/Server/Internal.hs+8−6 servant-server/test/Servant/ServerSpec.hs+36−7 servant/src/Servant/Test/ComprehensiveAPI.hs+1
servant-docs/golden/comprehensive.md+22
@@ -96,6 +96,28 @@
9696
9797```
9898
99+## GET /capture-lenient/:foo
100+
101+### Captures:
102+
103+- *foo*: Capture foo Int
104+
105+### Response:
106+
107+- Status code 200
108+- Headers: []
109+
110+- Supported content types are:
111+
112+ - `application/json;charset=utf-8`
113+ - `application/json`
114+
115+- Example (`application/json;charset=utf-8`, `application/json`):
116+
117+```javascript
118+
119+```
120+
99121## GET /description
100122
101123### foo
servant-server/src/Servant/Server/Internal.hs+8−6
@@ -87,7 +87,7 @@ import Servant.API.ResponseHeaders
8787import qualified Servant.Types.SourceT as S
8888import Web.HttpApiData
8989 (FromHttpApiData, parseHeader, parseQueryParam,
90− parseUrlPieceMaybe, parseUrlPieces)
90+ parseUrlPieceMaybe, parseUrlPieces, parseUrlPiece)
9191
9292import Servant.Server.Internal.BasicAuth
9393import Servant.Server.Internal.Context
@@ -166,11 +166,11 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
166166-- > server = getBook
167167-- > where getBook :: Text -> Handler Book
168168-- > getBook isbn = ...
169−instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
169+instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI (FoldLenient mods))
170170 => HasServer (Capture' mods capture a :> api) context where
171171
172172 type ServerT (Capture' mods capture a :> api) m =
173− a -> ServerT api m
173+ If (FoldLenient mods) (Either String a) a -> ServerT api m
174174
175175 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
176176
@@ -178,9 +178,11 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
178178 CaptureRouter $
179179 route (Proxy :: Proxy api)
180180 context
181− (addCapture d $ \ txt -> case parseUrlPieceMaybe txt of
182− Nothing -> delayedFail err400
183− Just v -> return v
181+ (addCapture d $ \ txt -> case ( sbool :: SBool (FoldLenient mods)
182+ , parseUrlPiece txt :: Either T.Text a) of
183+ (SFalse, Left e) -> delayedFail err400 { errBody = cs e }
184+ (SFalse, Right v) -> return v
185+ (STrue, piece) -> return $ (either (Left . cs) Right) piece
184186 )
185187
186188-- | If you use 'CaptureAll' in one of the endpoints for your API,
servant-server/test/Servant/ServerSpec.hs+36−7
@@ -46,7 +46,7 @@ import Network.Wai.Test
4646 simpleHeaders, simpleStatus)
4747import Servant.API
4848 ((:<|>) (..), (:>), AuthProtect, BasicAuth,
49− BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
49+ BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete,
5050 EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
5151 JSON, NoContent (..), NoFraming, OctetStream, Patch,
5252 PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
@@ -54,7 +54,7 @@ import Servant.API
5454 addHeader)
5555import Servant.Server
5656 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
57− emptyServer, err401, err403, err404, serve, serveWithContext)
57+ emptyServer, err400, err401, err403, err404, serve, serveWithContext)
5858import Servant.Test.ComprehensiveAPI
5959import qualified Servant.Types.SourceT as S
6060import Test.Hspec
@@ -204,13 +204,27 @@ verbSpec = describe "Servant.API.Verb" $ do
204204------------------------------------------------------------------------------
205205
206206type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
207+ :<|> "ears" :> Capture' '[Lenient] "ears" Integer :> Get '[JSON] Animal
208+ :<|> "eyes" :> Capture' '[Strict] "eyes" Integer :> Get '[JSON] Animal
207209captureApi :: Proxy CaptureApi
208210captureApi = Proxy
209−captureServer :: Integer -> Handler Animal
210−captureServer legs = case legs of
211− 4 -> return jerry
212− 2 -> return tweety
213− _ -> throwError err404
211+
212+captureServer :: Server CaptureApi
213+captureServer = getLegs :<|> getEars :<|> getEyes
214+ where getLegs :: Integer -> Handler Animal
215+ getLegs legs = case legs of
216+ 4 -> return jerry
217+ 2 -> return tweety
218+ _ -> throwError err404
219+
220+ getEars :: Either String Integer -> Handler Animal
221+ getEars (Left e) = return chimera -- ignore integer parse error, return weird animal
222+ getEars (Right 2) = return jerry
223+ getEars (Right _) = throwError err404
224+
225+ getEyes :: Integer -> Handler Animal
226+ getEyes 2 = return jerry
227+ getEyes _ = throwError err404
214228
215229captureSpec :: Spec
216230captureSpec = do
@@ -224,6 +238,17 @@ captureSpec = do
224238 it "returns 400 if the decoding fails" $ do
225239 get "/notAnInt" `shouldRespondWith` 400
226240
241+ it "returns an animal if eyes or ears are 2" $ do
242+ get "/ears/2" `shouldRespondWith` 200
243+ get "/eyes/2" `shouldRespondWith` 200
244+
245+ it "returns a weird animal on Lenient Capture" $ do
246+ response <- get "/ears/bla"
247+ liftIO $ decode' (simpleBody response) `shouldBe` Just chimera
248+
249+ it "returns 400 if parsing integer fails on Strict Capture" $ do
250+ get "/eyes/bla" `shouldRespondWith` 400
251+
227252 with (return (serve
228253 (Proxy :: Proxy (Capture "captured" String :> Raw))
229254 (\ "captured" -> Tagged $ \request_ respond ->
@@ -780,6 +805,10 @@ jerry = Animal "Mouse" 4
780805tweety :: Animal
781806tweety = Animal "Bird" 2
782807
808+-- weird animal with non-integer amount of ears
809+chimera :: Animal
810+chimera = Animal "Chimera" (-1)
811+
783812beholder :: Animal
784813beholder = Animal "Beholder" 0
785814-- }}}
servant/src/Servant/Test/ComprehensiveAPI.hs+1
@@ -49,6 +49,7 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =
4949 GET
5050 :<|> "get-int" :> Get '[JSON] Int
5151 :<|> "capture" :> Capture' '[Description "example description"] "foo" Int :> GET
52+ :<|> "capture-lenient" :> Capture' '[Lenient] "foo" Int :> GET
5253 :<|> "header" :> Header "foo" Int :> GET
5354 :<|> "header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET
5455 :<|> "http-version" :> HttpVersion :> GET