Add support for Lenient|Strict Capture

This commit is contained in:
jschaul 2019-03-18 16:43:10 +01:00
parent ad0228030f
commit 966ebe0169
No known key found for this signature in database
GPG key ID: 9CCCD94739682737

View file

@ -87,7 +87,7 @@ import Servant.API.ResponseHeaders
import qualified Servant.Types.SourceT as S import qualified Servant.Types.SourceT as S
import Web.HttpApiData import Web.HttpApiData
(FromHttpApiData, parseHeader, parseQueryParam, (FromHttpApiData, parseHeader, parseQueryParam,
parseUrlPieceMaybe, parseUrlPieces) parseUrlPieceMaybe, parseUrlPieces, parseUrlPiece)
import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.BasicAuth
import Servant.Server.Internal.Context import Servant.Server.Internal.Context
@ -166,11 +166,11 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
-- > server = getBook -- > server = getBook
-- > where getBook :: Text -> Handler Book -- > where getBook :: Text -> Handler Book
-- > getBook isbn = ... -- > 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 => HasServer (Capture' mods capture a :> api) context where
type ServerT (Capture' mods capture a :> api) m = 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 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
@ -178,9 +178,11 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
CaptureRouter $ CaptureRouter $
route (Proxy :: Proxy api) route (Proxy :: Proxy api)
context context
(addCapture d $ \ txt -> case parseUrlPieceMaybe txt of (addCapture d $ \ txt -> case ( sbool :: SBool (FoldLenient mods)
Nothing -> delayedFail err400 , parseUrlPiece txt :: Either T.Text a) of
Just v -> return v (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, -- | If you use 'CaptureAll' in one of the endpoints for your API,