diff --git a/executables/README.lhs b/executables/README.lhs --- a/executables/README.lhs +++ b/executables/README.lhs @@ -1,6 +1,6 @@ # servant-auth -[![Build Status](https://travis-ci.org/plow-technologies/servant-auth.svg?branch=master)](https://travis-ci.org/plow-technologies/servant-auth) +[![Build Status](https://travis-ci.org/haskell-servant/servant-auth.svg?branch=master)](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, diff --git a/servant-auth-server.cabal b/servant-auth-server.cabal --- a/servant-auth-server.cabal +++ b/servant-auth-server.cabal @@ -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 . + For a quick overview of the usage, see the . 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 diff --git a/src/Servant/Auth/Server.hs b/src/Servant/Auth/Server.hs --- a/src/Servant/Auth/Server.hs +++ b/src/Servant/Auth/Server.hs @@ -97,6 +97,9 @@ , BasicAuthData(..) , IsPasswordCorrect(..) + -- ** Authentication request + , wwwAuthenticatedErr + ---------------------------------------------------------------------------- -- * Utilies , ThrowAll(throwAll) diff --git a/src/Servant/Auth/Server/Internal/AddSetCookie.hs b/src/Servant/Auth/Server/Internal/AddSetCookie.hs --- a/src/Servant/Auth/Server/Internal/AddSetCookie.hs +++ b/src/Servant/Auth/Server/Internal/AddSetCookie.hs @@ -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 diff --git a/src/Servant/Auth/Server/Internal/BasicAuth.hs b/src/Servant/Auth/Server/Internal/BasicAuth.hs --- a/src/Servant/Auth/Server/Internal/BasicAuth.hs +++ b/src/Servant/Auth/Server/Internal/BasicAuth.hs @@ -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] } diff --git a/src/Servant/Auth/Server/Internal/ConfigTypes.hs b/src/Servant/Auth/Server/Internal/ConfigTypes.hs --- a/src/Servant/Auth/Server/Internal/ConfigTypes.hs +++ b/src/Servant/Auth/Server/Internal/ConfigTypes.hs @@ -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 } diff --git a/src/Servant/Auth/Server/Internal/Cookie.hs b/src/Servant/Auth/Server/Internal/Cookie.hs --- a/src/Servant/Auth/Server/Internal/Cookie.hs +++ b/src/Servant/Auth/Server/Internal/Cookie.hs @@ -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 diff --git a/test/Servant/Auth/ServerSpec.hs b/test/Servant/Auth/ServerSpec.hs --- a/test/Servant/Auth/ServerSpec.hs +++ b/test/Servant/Auth/ServerSpec.hs @@ -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