From 4224c20bffc96ccef17a4d7048d0a87d4324162e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B6nke=20Hahn?= Date: Wed, 6 Apr 2016 10:59:49 +0800 Subject: [PATCH] some formatting and refactoring --- .../src/Servant/Server/Internal/BasicAuth.hs | 12 +++++------ servant-server/test/Servant/ServerSpec.hs | 20 ++++++++++++------- servant/src/Servant/API/BasicAuth.hs | 7 ++++--- servant/src/Servant/API/Experimental/Auth.hs | 5 ++--- 4 files changed, 25 insertions(+), 19 deletions(-) diff --git a/servant-server/src/Servant/Server/Internal/BasicAuth.hs b/servant-server/src/Servant/Server/Internal/BasicAuth.hs index f941f401..2f430417 100644 --- a/servant-server/src/Servant/Server/Internal/BasicAuth.hs +++ b/servant-server/src/Servant/Server/Internal/BasicAuth.hs @@ -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 GHC.Generics 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 diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 5499c804..2e066582 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -546,16 +546,16 @@ type BasicAuthAPI = BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal basicAuthApi :: Proxy BasicAuthAPI basicAuthApi = Proxy + basicAuthServer :: Server BasicAuthAPI basicAuthServer = const (return jerry) 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,10 +564,13 @@ basicAuthSpec = do with (return (serveWithContext basicAuthApi basicAuthContext basicAuthServer)) $ do context "Basic Authentication" $ do - it "returns with 401 with bad password" $ do + it "returns 401 with bad password" $ do get "/basic" `shouldRespondWith` 401 + it "returns 200 with the right password" $ do - THW.request methodGet "/basic" [("Authorization","Basic c2VydmFudDpzZXJ2ZXI=")] "" `shouldRespondWith` 200 + let validCredentials = [("Authorization", "Basic c2VydmFudDpzZXJ2ZXI=")] + THW.request methodGet "/basic" validCredentials "" + `shouldRespondWith` 200 -- }}} ------------------------------------------------------------------------------ @@ -575,14 +578,16 @@ basicAuthSpec = do ------------------------------------------------------------------------------ type GenAuthAPI = AuthProtect "auth" :> "auth" :> Get '[JSON] Animal + authApi :: Proxy GenAuthAPI authApi = Proxy + authServer :: Server GenAuthAPI authServer = const (return tweety) type instance AuthServerData (AuthProtect "auth") = () -genAuthContext :: Context '[ AuthHandler Request () ] +genAuthContext :: Context '[AuthHandler Request ()] genAuthContext = let authHandler = (\req -> if elem ("Auth", "secret") (requestHeaders req) @@ -599,6 +604,7 @@ genAuthSpec = 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 diff --git a/servant/src/Servant/API/BasicAuth.hs b/servant/src/Servant/API/BasicAuth.hs index cc38ddb3..307c21aa 100644 --- a/servant/src/Servant/API/BasicAuth.hs +++ b/servant/src/Servant/API/BasicAuth.hs @@ -1,12 +1,13 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} + module Servant.API.BasicAuth where import Data.ByteString (ByteString) import Data.Typeable (Typeable) -import GHC.TypeLits (Symbol) +import GHC.TypeLits (Symbol) -- | Combinator for . diff --git a/servant/src/Servant/API/Experimental/Auth.hs b/servant/src/Servant/API/Experimental/Auth.hs index ce330287..fa79bfc7 100644 --- a/servant/src/Servant/API/Experimental/Auth.hs +++ b/servant/src/Servant/API/Experimental/Auth.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} module Servant.API.Experimental.Auth where import Data.Typeable (Typeable) @@ -11,4 +11,3 @@ import Data.Typeable (Typeable) -- -- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE. data AuthProtect (tag :: k) deriving (Typeable) -