git.iko.soy/servant
on master help sign in
Merge pull request #1156 from wireapp/feature/capture-lenient
dc4125dOleg Grenrus
servant-docs/golden/comprehensive.md+22
compare with master
unifiedsplit
@@ -96,6 +96,28 @@
96
96
97```
97```
98
98
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+
99## GET /description
121## GET /description
100
122
101### foo
123### foo
servant-server/src/Servant/Server/Internal.hs+8−6
@@ -87,7 +87,7 @@ import Servant.API.ResponseHeaders
87import qualified Servant.Types.SourceT as S
87import qualified Servant.Types.SourceT as S
88import Web.HttpApiData
88import Web.HttpApiData
89 (FromHttpApiData, parseHeader, parseQueryParam,
89 (FromHttpApiData, parseHeader, parseQueryParam,
90− parseUrlPieceMaybe, parseUrlPieces)
90+ parseUrlPieceMaybe, parseUrlPieces, parseUrlPiece)
91
91
92import Servant.Server.Internal.BasicAuth
92import Servant.Server.Internal.BasicAuth
93import Servant.Server.Internal.Context
93import Servant.Server.Internal.Context
@@ -166,11 +166,11 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
166-- > server = getBook
166-- > server = getBook
167-- > where getBook :: Text -> Handler Book
167-- > where getBook :: Text -> Handler Book
168-- > getBook isbn = ...
168-- > getBook isbn = ...
169−instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
169+instance (KnownSymbol capture, FromHttpApiData a, HasServer api context, SBoolI (FoldLenient mods))
170 => HasServer (Capture' mods capture a :> api) context where
170 => HasServer (Capture' mods capture a :> api) context where
171
171
172 type ServerT (Capture' mods capture a :> api) m =
172 type ServerT (Capture' mods capture a :> api) m =
173− a -> ServerT api m
173+ If (FoldLenient mods) (Either String a) a -> ServerT api m
174
174
175 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
175 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
176
176
@@ -178,9 +178,11 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
178 CaptureRouter $
178 CaptureRouter $
179 route (Proxy :: Proxy api)
179 route (Proxy :: Proxy api)
180 context
180 context
181− (addCapture d $ \ txt -> case parseUrlPieceMaybe txt of
181+ (addCapture d $ \ txt -> case ( sbool :: SBool (FoldLenient mods)
182+ , parseUrlPiece txt :: Either T.Text a) of
182− Nothing -> delayedFail err400
183+ (SFalse, Left e) -> delayedFail err400 { errBody = cs e }
183− Just v -> return v
184+ (SFalse, Right v) -> return v
185+ (STrue, piece) -> return $ (either (Left . cs) Right) piece
184 )
186 )
185
187
186-- | If you use 'CaptureAll' in one of the endpoints for your API,
188-- | 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
46 simpleHeaders, simpleStatus)
46 simpleHeaders, simpleStatus)
47import Servant.API
47import Servant.API
48 ((:<|>) (..), (:>), AuthProtect, BasicAuth,
48 ((:<|>) (..), (:>), AuthProtect, BasicAuth,
49− BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
49+ BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, Lenient, Strict, Delete,
50 EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
50 EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
51 JSON, NoContent (..), NoFraming, OctetStream, Patch,
51 JSON, NoContent (..), NoFraming, OctetStream, Patch,
52 PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
52 PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
@@ -54,7 +54,7 @@ import Servant.API
54 addHeader)
54 addHeader)
55import Servant.Server
55import Servant.Server
56 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
56 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
57− emptyServer, err401, err403, err404, serve, serveWithContext)
57+ emptyServer, err400, err401, err403, err404, serve, serveWithContext)
58import Servant.Test.ComprehensiveAPI
58import Servant.Test.ComprehensiveAPI
59import qualified Servant.Types.SourceT as S
59import qualified Servant.Types.SourceT as S
60import Test.Hspec
60import Test.Hspec
@@ -204,13 +204,27 @@ verbSpec = describe "Servant.API.Verb" $ do
204------------------------------------------------------------------------------
204------------------------------------------------------------------------------
205
205
206type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
206type 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
207captureApi :: Proxy CaptureApi
209captureApi :: Proxy CaptureApi
208captureApi = Proxy
210captureApi = Proxy
211+
212+captureServer :: Server CaptureApi
213+captureServer = getLegs :<|> getEars :<|> getEyes
209−captureServer :: Integer -> Handler Animal
214+ where getLegs :: Integer -> Handler Animal
210−captureServer legs = case legs of
215+ getLegs legs = case legs of
211− 4 -> return jerry
216+ 4 -> return jerry
212− 2 -> return tweety
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
213− _ -> throwError err404
227+ getEyes _ = throwError err404
214
228
215captureSpec :: Spec
229captureSpec :: Spec
216captureSpec = do
230captureSpec = do
@@ -224,6 +238,17 @@ captureSpec = do
224 it "returns 400 if the decoding fails" $ do
238 it "returns 400 if the decoding fails" $ do
225 get "/notAnInt" `shouldRespondWith` 400
239 get "/notAnInt" `shouldRespondWith` 400
226
240
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+
227 with (return (serve
252 with (return (serve
228 (Proxy :: Proxy (Capture "captured" String :> Raw))
253 (Proxy :: Proxy (Capture "captured" String :> Raw))
229 (\ "captured" -> Tagged $ \request_ respond ->
254 (\ "captured" -> Tagged $ \request_ respond ->
@@ -780,6 +805,10 @@ jerry = Animal "Mouse" 4
780tweety :: Animal
805tweety :: Animal
781tweety = Animal "Bird" 2
806tweety = Animal "Bird" 2
782
807
808+-- weird animal with non-integer amount of ears
809+chimera :: Animal
810+chimera = Animal "Chimera" (-1)
811+
783beholder :: Animal
812beholder :: Animal
784beholder = Animal "Beholder" 0
813beholder = Animal "Beholder" 0
785-- }}}
814-- }}}
servant/src/Servant/Test/ComprehensiveAPI.hs+1
@@ -49,6 +49,7 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =
49 GET
49 GET
50 :<|> "get-int" :> Get '[JSON] Int
50 :<|> "get-int" :> Get '[JSON] Int
51 :<|> "capture" :> Capture' '[Description "example description"] "foo" Int :> GET
51 :<|> "capture" :> Capture' '[Description "example description"] "foo" Int :> GET
52+ :<|> "capture-lenient" :> Capture' '[Lenient] "foo" Int :> GET
52 :<|> "header" :> Header "foo" Int :> GET
53 :<|> "header" :> Header "foo" Int :> GET
53 :<|> "header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET
54 :<|> "header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET
54 :<|> "http-version" :> HttpVersion :> GET
55 :<|> "http-version" :> HttpVersion :> GET