servant-server 0.6 → 0.6.1
raw patch · 3 files changed
+50/−23 lines, 3 filesdep ~base64-bytestring
Dependency ranges changed: base64-bytestring
Files
- servant-server.cabal +2/−1
- src/Servant/Server/Internal/BasicAuth.hs +8/−8
- test/Servant/ServerSpec.hs +40/−14
servant-server.cabal view
@@ -1,5 +1,5 @@ name: servant-server-version: 0.6+version: 0.6.1 synopsis: A family of combinators for defining webservices APIs and serving them description: A family of combinators for defining webservices APIs and serving them@@ -111,6 +111,7 @@ base == 4.* , base-compat , aeson+ , base64-bytestring , bytestring , bytestring-conversion , directory
src/Servant/Server/Internal/BasicAuth.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} module Servant.Server.Internal.BasicAuth where @@ -15,9 +15,9 @@ import Network.HTTP.Types (Header) import Network.Wai (Request, requestHeaders) -import Servant.API.BasicAuth (BasicAuthData(BasicAuthData))-import Servant.Server.Internal.RoutingApplication-import Servant.Server.Internal.ServantErr+import Servant.API.BasicAuth (BasicAuthData(BasicAuthData))+import Servant.Server.Internal.RoutingApplication+import Servant.Server.Internal.ServantErr -- * Basic Auth @@ -64,6 +64,6 @@ Just e -> ba e >>= \res -> case res of BadPassword -> plzAuthenticate NoSuchUser -> plzAuthenticate- Unauthorized -> return $ Fail err403+ Unauthorized -> return $ FailFatal err403 Authorized usr -> return $ Route usr- where plzAuthenticate = return $ Fail err401 { errHeaders = [mkBAChallengerHdr realm] }+ where plzAuthenticate = return $ FailFatal err401 { errHeaders = [mkBAChallengerHdr realm] }
test/Servant/ServerSpec.hs view
@@ -19,8 +19,10 @@ import Control.Monad (forM_, when, unless) import Control.Monad.Trans.Except (ExceptT, throwE) import Data.Aeson (FromJSON, ToJSON, decode', encode)+import qualified Data.ByteString.Base64 as Base64 import Data.ByteString.Conversion () import Data.Char (toUpper)+import Data.Monoid import Data.Proxy (Proxy (Proxy)) import Data.String (fromString) import Data.String.Conversions (cs)@@ -30,6 +32,7 @@ methodDelete, methodGet, methodHead, methodPatch, methodPost, methodPut, ok200,+ imATeaPot418, parseQuery) import Network.Wai (Application, Request, requestHeaders, pathInfo, queryString, rawQueryString,@@ -542,20 +545,24 @@ -- * Basic Authentication {{{ ------------------------------------------------------------------------------ -type BasicAuthAPI = BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal+type BasicAuthAPI =+ BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal+ :<|> Raw basicAuthApi :: Proxy BasicAuthAPI basicAuthApi = Proxy+ basicAuthServer :: Server BasicAuthAPI-basicAuthServer = const (return jerry)+basicAuthServer =+ const (return jerry) :<|>+ (\ _ respond -> respond $ responseLBS imATeaPot418 [] "") basicAuthContext :: Context '[ BasicAuthCheck () ] basicAuthContext =- let basicHandler = BasicAuthCheck $ (\(BasicAuthData usr pass) ->+ let basicHandler = BasicAuthCheck $ \(BasicAuthData usr pass) -> if usr == "servant" && pass == "server"- then return (Authorized ())- else return Unauthorized- )+ then return (Authorized ())+ else return Unauthorized in basicHandler :. EmptyContext basicAuthSpec :: Spec@@ -564,25 +571,40 @@ with (return (serveWithContext basicAuthApi basicAuthContext basicAuthServer)) $ do context "Basic Authentication" $ do- it "returns with 401 with bad password" $ do+ let basicAuthHeaders user password =+ [("Authorization", "Basic " <> Base64.encode (user <> ":" <> password))]+ it "returns 401 when no credentials given" $ do get "/basic" `shouldRespondWith` 401++ it "returns 403 when invalid credentials given" $ do+ THW.request methodGet "/basic" (basicAuthHeaders "servant" "wrong") ""+ `shouldRespondWith` 403+ it "returns 200 with the right password" $ do- THW.request methodGet "/basic" [("Authorization","Basic c2VydmFudDpzZXJ2ZXI=")] "" `shouldRespondWith` 200+ THW.request methodGet "/basic" (basicAuthHeaders "servant" "server") ""+ `shouldRespondWith` 200 + it "plays nice with subsequent Raw endpoints" $ do+ get "/foo" `shouldRespondWith` 418+ -- }}} ------------------------------------------------------------------------------ -- * General Authentication {{{ ------------------------------------------------------------------------------ type GenAuthAPI = AuthProtect "auth" :> "auth" :> Get '[JSON] Animal-authApi :: Proxy GenAuthAPI-authApi = Proxy-authServer :: Server GenAuthAPI-authServer = const (return tweety)+ :<|> Raw +genAuthApi :: Proxy GenAuthAPI+genAuthApi = Proxy++genAuthServer :: Server GenAuthAPI+genAuthServer = const (return tweety)+ :<|> (\ _ respond -> respond $ responseLBS imATeaPot418 [] "")+ type instance AuthServerData (AuthProtect "auth") = () -genAuthContext :: Context '[ AuthHandler Request () ]+genAuthContext :: Context '[AuthHandler Request ()] genAuthContext = let authHandler = (\req -> if elem ("Auth", "secret") (requestHeaders req)@@ -594,13 +616,17 @@ genAuthSpec :: Spec genAuthSpec = do describe "Servant.API.Auth" $ do- with (return (serveWithContext authApi genAuthContext authServer)) $ do+ with (return (serveWithContext genAuthApi genAuthContext genAuthServer)) $ do context "Custom Auth Protection" $ do it "returns 401 when missing headers" $ do get "/auth" `shouldRespondWith` 401+ it "returns 200 with the right header" $ do THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200++ it "plays nice with subsequent Raw endpoints" $ do+ get "/foo" `shouldRespondWith` 418 -- }}} ------------------------------------------------------------------------------