some formatting and refactoring
This commit is contained in:
parent
933a2c4445
commit
4224c20bff
4 changed files with 25 additions and 19 deletions
|
@ -1,6 +1,6 @@
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Servant.Server.Internal.BasicAuth where
|
module Servant.Server.Internal.BasicAuth where
|
||||||
|
|
|
@ -546,16 +546,16 @@ type BasicAuthAPI = BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal
|
||||||
|
|
||||||
basicAuthApi :: Proxy BasicAuthAPI
|
basicAuthApi :: Proxy BasicAuthAPI
|
||||||
basicAuthApi = Proxy
|
basicAuthApi = Proxy
|
||||||
|
|
||||||
basicAuthServer :: Server BasicAuthAPI
|
basicAuthServer :: Server BasicAuthAPI
|
||||||
basicAuthServer = const (return jerry)
|
basicAuthServer = const (return jerry)
|
||||||
|
|
||||||
basicAuthContext :: Context '[ BasicAuthCheck () ]
|
basicAuthContext :: Context '[ BasicAuthCheck () ]
|
||||||
basicAuthContext =
|
basicAuthContext =
|
||||||
let basicHandler = BasicAuthCheck $ (\(BasicAuthData usr pass) ->
|
let basicHandler = BasicAuthCheck $ \(BasicAuthData usr pass) ->
|
||||||
if usr == "servant" && pass == "server"
|
if usr == "servant" && pass == "server"
|
||||||
then return (Authorized ())
|
then return (Authorized ())
|
||||||
else return Unauthorized
|
else return Unauthorized
|
||||||
)
|
|
||||||
in basicHandler :. EmptyContext
|
in basicHandler :. EmptyContext
|
||||||
|
|
||||||
basicAuthSpec :: Spec
|
basicAuthSpec :: Spec
|
||||||
|
@ -564,10 +564,13 @@ basicAuthSpec = do
|
||||||
with (return (serveWithContext basicAuthApi basicAuthContext basicAuthServer)) $ do
|
with (return (serveWithContext basicAuthApi basicAuthContext basicAuthServer)) $ do
|
||||||
|
|
||||||
context "Basic Authentication" $ do
|
context "Basic Authentication" $ do
|
||||||
it "returns with 401 with bad password" $ do
|
it "returns 401 with bad password" $ do
|
||||||
get "/basic" `shouldRespondWith` 401
|
get "/basic" `shouldRespondWith` 401
|
||||||
|
|
||||||
it "returns 200 with the right password" $ do
|
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,8 +578,10 @@ basicAuthSpec = do
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
type GenAuthAPI = AuthProtect "auth" :> "auth" :> Get '[JSON] Animal
|
type GenAuthAPI = AuthProtect "auth" :> "auth" :> Get '[JSON] Animal
|
||||||
|
|
||||||
authApi :: Proxy GenAuthAPI
|
authApi :: Proxy GenAuthAPI
|
||||||
authApi = Proxy
|
authApi = Proxy
|
||||||
|
|
||||||
authServer :: Server GenAuthAPI
|
authServer :: Server GenAuthAPI
|
||||||
authServer = const (return tweety)
|
authServer = const (return tweety)
|
||||||
|
|
||||||
|
@ -599,6 +604,7 @@ genAuthSpec = do
|
||||||
context "Custom Auth Protection" $ do
|
context "Custom Auth Protection" $ do
|
||||||
it "returns 401 when missing headers" $ do
|
it "returns 401 when missing headers" $ do
|
||||||
get "/auth" `shouldRespondWith` 401
|
get "/auth" `shouldRespondWith` 401
|
||||||
|
|
||||||
it "returns 200 with the right header" $ do
|
it "returns 200 with the right header" $ do
|
||||||
THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200
|
THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE KindSignatures #-}
|
{-# LANGUAGE KindSignatures #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
|
|
||||||
module Servant.API.BasicAuth where
|
module Servant.API.BasicAuth where
|
||||||
|
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
|
|
|
@ -11,4 +11,3 @@ import Data.Typeable (Typeable)
|
||||||
--
|
--
|
||||||
-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE.
|
-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE.
|
||||||
data AuthProtect (tag :: k) deriving (Typeable)
|
data AuthProtect (tag :: k) deriving (Typeable)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue