servant-auth-server 0.3.1.0 → 0.3.2.0
raw patch · 8 files changed
+77/−51 lines, 8 filesdep ~QuickCheckdep ~entropydep ~http-types
Dependency ranges changed: QuickCheck, entropy, http-types, servant-server
Files
- executables/README.lhs +1/−1
- servant-auth-server.cabal +12/−10
- src/Servant/Auth/Server.hs +3/−0
- src/Servant/Auth/Server/Internal/AddSetCookie.hs +10/−8
- src/Servant/Auth/Server/Internal/BasicAuth.hs +3/−2
- src/Servant/Auth/Server/Internal/ConfigTypes.hs +3/−0
- src/Servant/Auth/Server/Internal/Cookie.hs +5/−3
- test/Servant/Auth/ServerSpec.hs +40/−27
executables/README.lhs view
@@ -1,6 +1,6 @@ # servant-auth -[](https://travis-ci.org/plow-technologies/servant-auth)+[](https://travis-ci.org/haskell-servant/servant-auth) This package provides safe and easy-to-use authentication options for `servant`. The same API can be protected via login and cookies, or API tokens,
servant-auth-server.cabal view
@@ -1,27 +1,27 @@ name: servant-auth-server-version: 0.3.1.0+version: 0.3.2.0 synopsis: servant-server/servant-auth compatibility description: This package provides the required instances for using the @Auth@ combinator in your 'servant' server. . Both cookie- and token- (REST API) based authentication is provided. .- For a quick overview of the usage, see the <http://github.com/plow-technologies/servant-auth#readme README>.+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant-auth#readme README>. category: Web, Servant, Authentication-homepage: http://github.com/plow-technologies/servant-auth#readme-bug-reports: https://github.com/plow-technologies/servant-auth/issues+homepage: http://github.com/haskell-servant/servant-auth#readme+bug-reports: https://github.com/haskell-servant/servant-auth/issues author: Julian K. Arni maintainer: jkarni@gmail.com copyright: (c) Julian K. Arni license: BSD3 license-file: LICENSE-tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1+tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2 build-type: Simple cabal-version: >= 1.10 source-repository head type: git- location: https://github.com/plow-technologies/servant-auth+ location: https://github.com/haskell-servant/servant-auth library hs-source-dirs:@@ -39,15 +39,15 @@ , cookie >= 0.4 && < 0.4.4 , crypto-api >= 0.13 && < 0.14 , data-default-class >= 0.0 && < 0.2- , entropy >= 0.3 && < 0.4+ , entropy >= 0.3 && < 0.5 , http-api-data >= 0.3 && < 0.3.8- , http-types >= 0.9 && < 0.11+ , http-types >= 0.9 && < 0.13 , jose >= 0.6 && < 0.7 , lens >= 4 && < 5 , monad-time >= 0.2 && < 0.3 , mtl >= 2.2 && < 2.3 , servant-auth == 0.3.*- , servant-server >= 0.9.1 && < 0.13+ , servant-server >= 0.9.1 && < 0.14 , tagged >= 0.7.3 && < 0.9 , text >= 1 && < 2 , time >= 1.5 && < 1.9@@ -86,6 +86,8 @@ , transformers , markdown-unlit default-language: Haskell2010+ if impl(ghcjs)+ buildable: False test-suite spec type: exitcode-stdio-1.0@@ -114,7 +116,7 @@ build-depends: servant-auth-server , hspec > 2 && < 3- , QuickCheck >= 2.8 && < 2.11+ , QuickCheck >= 2.8 && < 2.12 , http-client >= 0.4 && < 0.6 , lens-aeson , warp
src/Servant/Auth/Server.hs view
@@ -97,6 +97,9 @@ , BasicAuthData(..) , IsPasswordCorrect(..) + -- ** Authentication request+ , wwwAuthenticatedErr+ ---------------------------------------------------------------------------- -- * Utilies , ThrowAll(throwAll)
src/Servant/Auth/Server/Internal/AddSetCookie.hs view
@@ -27,14 +27,16 @@ AddSetCookiesApi ('S 'Z) a = AddSetCookieApi a AddSetCookiesApi ('S n) a = AddSetCookiesApi n (AddSetCookieApi a) -type family AddSetCookieApi a where- AddSetCookieApi (a :> b) = a :> AddSetCookieApi b- AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b- AddSetCookieApi (Verb method stat ctyps (Headers ls a))- = Verb method stat ctyps (Headers ((Header "Set-Cookie" SetCookie) ': ls) a)- AddSetCookieApi (Verb method stat ctyps a)- = Verb method stat ctyps (Headers '[Header "Set-Cookie" SetCookie] a)- AddSetCookieApi Raw = Raw+type family AddSetCookieApiVerb a where+ AddSetCookieApiVerb (Headers ls a) = Headers ((Header "Set-Cookie" SetCookie) ': ls) a+ AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a++type family AddSetCookieApi a :: *+type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b+type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b+type instance AddSetCookieApi (Verb method stat ctyps a)+ = Verb method stat ctyps (AddSetCookieApiVerb a)+type instance AddSetCookieApi Raw = Raw data SetCookieList (n :: Nat) :: * where SetCookieNil :: SetCookieList 'Z
src/Servant/Auth/Server/Internal/BasicAuth.hs view
@@ -9,8 +9,9 @@ import Servant.Auth.Server.Internal.Types --- | A 'ServantErr' that asks the client to authenticated via Basic--- Authentication. The argument is the realm.+-- | A 'ServantErr' that asks the client to authenticate via Basic+-- Authentication, should be invoked by an application whenever+-- appropriate. The argument is the realm. wwwAuthenticatedErr :: BS.ByteString -> ServantErr wwwAuthenticatedErr realm = err401 { errHeaders = [mkBAChallengerHdr realm] }
src/Servant/Auth/Server/Internal/ConfigTypes.hs view
@@ -65,6 +65,8 @@ , xsrfCookiePath :: Maybe BS.ByteString -- | What name to use for the header used for CSRF protection. , xsrfHeaderName :: BS.ByteString+ -- | Exclude GET request method from CSRF protection.+ , xsrfExcludeGet :: Bool } deriving (Eq, Show, Generic) instance Default CookieSettings where@@ -81,6 +83,7 @@ , xsrfCookieName = "XSRF-TOKEN" , xsrfCookiePath = Just "/" , xsrfHeaderName = "X-XSRF-TOKEN"+ , xsrfExcludeGet = False }
src/Servant/Auth/Server/Internal/Cookie.hs view
@@ -10,7 +10,8 @@ import qualified Data.ByteString.Base64 as BS64 import qualified Data.ByteString.Lazy as BSL import Data.CaseInsensitive (mk)-import Network.Wai (requestHeaders)+import Network.HTTP.Types (methodGet)+import Network.Wai (requestHeaders, requestMethod) import Servant (AddHeader, addHeader) import System.Entropy (getEntropy) import Web.Cookie@@ -28,8 +29,9 @@ cookies' <- lookup "Cookie" $ requestHeaders req let cookies = parseCookies cookies' xsrfCookie <- lookup (xsrfCookieName ccfg) cookies- xsrfHeader <- lookup (mk $ xsrfHeaderName ccfg) $ requestHeaders req- guard $ xsrfCookie `constTimeEq` xsrfHeader+ when (((requestMethod req) /= methodGet) || not (xsrfExcludeGet ccfg)) $ do+ xsrfHeader <- lookup (mk $ xsrfHeaderName ccfg) $ requestHeaders req+ guard $ xsrfCookie `constTimeEq` xsrfHeader -- session cookie *must* be HttpOnly and Secure lookup (sessionCookieName ccfg) cookies verifiedJWT <- liftIO $ runExceptT $ do
test/Servant/Auth/ServerSpec.hs view
@@ -41,7 +41,7 @@ responseHeader, responseStatus) import Servant hiding (BasicAuth,- IsSecure (..))+ IsSecure (..), header) import Servant.Auth.Server import Servant.Auth.Server.SetCookieOrphan () import System.IO.Unsafe (unsafePerformIO)@@ -160,33 +160,43 @@ cookieAuthSpec :: Spec cookieAuthSpec- = describe "The Auth combinator"- $ around (testWithApplication . return $ app cookieOnlyApi) $ do+ = describe "The Auth combinator" $ do+ around (testWithApplication . return $ app cookieOnlyApi) $ do - it "fails if CSRF header and cookie don't match" $ \port -> property- $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)- opts' <- addJwtToCookie jwt- let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"])- (xsrfCookieName cookieCfg <> "=blerg")- getWith opts (url port) `shouldHTTPErrorWith` status401+ it "fails if CSRF header and cookie don't match" $ \port -> property+ $ \(user :: User) -> do+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)+ opts' <- addJwtToCookie jwt+ let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"])+ (xsrfCookieName cookieCfg <> "=blerg")+ getWith opts (url port) `shouldHTTPErrorWith` status401 - it "fails if there is no CSRF header and cookie" $ \port -> property- $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)- opts <- addJwtToCookie jwt- getWith opts (url port) `shouldHTTPErrorWith` status401+ it "fails if there is no CSRF header and cookie" $ \port -> property+ $ \(user :: User) -> do+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)+ opts <- addJwtToCookie jwt+ getWith opts (url port) `shouldHTTPErrorWith` status401 - it "succeeds if CSRF header and cookie match, and JWT is valid" $ \port -> property- $ \(user :: User) -> do- jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)- opts' <- addJwtToCookie jwt- let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"])- (xsrfCookieName cookieCfg <> "=blah")- resp <- getWith opts (url port)- resp ^? responseBody . _JSON `shouldBe` Just (length $ name user)+ it "succeeds if CSRF header and cookie match, and JWT is valid" $ \port -> property+ $ \(user :: User) -> do+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)+ opts' <- addJwtToCookie jwt+ let opts = addCookie (opts' & header (mk (xsrfHeaderName cookieCfg)) .~ ["blah"])+ (xsrfCookieName cookieCfg <> "=blah")+ resp <- getWith opts (url port)+ resp ^? responseBody . _JSON `shouldBe` Just (length $ name user) + around (testWithApplication . return $ appWithCookie cookieOnlyApi cookieCfg{xsrfExcludeGet = True}) $ do+ it "succeeds without CSRF header for GET when enabled, and JWT is valid"+ $ \port -> property+ $ \(user :: User) -> do+ jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)+ opts' <- addJwtToCookie jwt+ let opts = addCookie opts' (xsrfCookieName cookieCfg <> "=blah")+ resp <- getWith opts (url port)+ resp ^? responseBody . _JSON `shouldBe` Just (length $ name user) + -- }}} ------------------------------------------------------------------------------ -- * JWT Auth {{{@@ -345,13 +355,16 @@ -- have to add it type instance BasicAuthCfg = JWK +appWithCookie :: AreAuths auths '[CookieSettings, JWTSettings, JWK] User+ => Proxy (API auths) -> CookieSettings -> Application+appWithCookie api ccfg = serveWithContext api ctx server+ where+ ctx = ccfg :. jwtCfg :. theKey :. EmptyContext+ -- | Takes a proxy parameter indicating which authentication systems to enable. app :: AreAuths auths '[CookieSettings, JWTSettings, JWK] User => Proxy (API auths) -> Application-app api = serveWithContext api ctx server- where- ctx = cookieCfg :. jwtCfg :. theKey :. EmptyContext-+app api = appWithCookie api cookieCfg server :: Server (API auths) server authResult = case authResult of