happstack-authenticate 2.3.4.15 → 2.3.4.16
raw patch · 3 files changed
+84/−21 lines, 3 filesdep ~jwtdep ~mime-mail
Dependency ranges changed: jwt, mime-mail
Files
- Happstack/Authenticate/Core.hs +40/−8
- Happstack/Authenticate/Password/Core.hs +41/−10
- happstack-authenticate.cabal +3/−3
Happstack/Authenticate/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeOperators, TypeFamilies, TypeSynonymInstances, UndecidableInstances, OverloadedStrings #-}+{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeOperators, TypeFamilies, TypeSynonymInstances, UndecidableInstances, OverloadedStrings #-} {- A user is uniquely identified by their 'UserId'. A user can have one@@ -135,7 +135,7 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe, maybeToList)-import Data.Monoid ((<>), mconcat)+import Data.Monoid ((<>), mconcat, mempty) import Data.SafeCopy (SafeCopy, base, deriveSafeCopy) import Data.IxSet.Typed import qualified Data.IxSet.Typed as IxSet@@ -156,12 +156,24 @@ import System.Random (randomRIO) import Text.Boomerang.TH (makeBoomerangs) import Text.Shakespeare.I18N (RenderMessage(renderMessage), mkMessageFor)-import Web.JWT (Algorithm(HS256), JWT, VerifiedJWT, JWTClaimsSet(..), encodeSigned, claims, decode, decodeAndVerifySignature, secondsSinceEpoch, intDate, secret, verify)+import Web.JWT (Algorithm(HS256), JWT, VerifiedJWT, JWTClaimsSet(..), encodeSigned, claims, decode, decodeAndVerifySignature, secondsSinceEpoch, intDate, verify)+#if MIN_VERSION_jwt(0,8,0)+import Web.JWT (ClaimsMap(..), hmacSecret)+#else+import Web.JWT (secret)+#endif+ import Web.Routes (RouteT, PathInfo(..), nestURL) import Web.Routes.Boomerang import Web.Routes.Happstack () import Web.Routes.TH (derivePathInfo) +#if MIN_VERSION_jwt(0,8,0)+#else+unClaimsMap = id+#endif++ -- | when creating JSON field names, drop the first character. Since -- we are using lens, the leading character should always be _. jsonOptions :: Options@@ -626,13 +638,29 @@ do ssecret <- getOrGenSharedSecret authenticateState (user ^. userId) admin <- liftIO $ (authenticateConfig ^. isAuthAdmin) (user ^. userId) now <- liftIO getCurrentTime- let claims = def { exp = intDate $ utcTimeToPOSIXSeconds (addUTCTime (60*60*24*30) now)- , unregisteredClaims =+ let claims = JWTClaimsSet+ { iss = Nothing+ , sub = Nothing+ , aud = Nothing+ , exp = intDate $ utcTimeToPOSIXSeconds (addUTCTime (60*60*24*30) now)+ , nbf = Nothing+ , iat = Nothing+ , jti = Nothing+ , unregisteredClaims =+#if MIN_VERSION_jwt(0,8,0)+ ClaimsMap $+#endif Map.fromList [ ("user" , toJSON user) , ("authAdmin", toJSON admin) ]- }+ }+#if MIN_VERSION_jwt(0,10,0)+ return $ encodeSigned (hmacSecret $ _unSharedSecret ssecret) mempty claims+#elif MIN_VERSION_jwt(0,9,0)+ return $ encodeSigned (hmacSecret $ _unSharedSecret ssecret) claims+#else return $ encodeSigned HS256 (secret $ _unSharedSecret ssecret) claims+#endif -- | decode and verify the `TokenText`. If successful, return the -- `Token` otherwise `Nothing`.@@ -648,7 +676,7 @@ Nothing -> return Nothing (Just unverified) -> -- check that token has user claim- case Map.lookup "user" (unregisteredClaims (claims unverified)) of+ case Map.lookup "user" (unClaimsMap (unregisteredClaims (claims unverified))) of Nothing -> return Nothing (Just uv) -> -- decode user json value@@ -661,7 +689,11 @@ Nothing -> return Nothing (Just ssecret) -> -- finally we can verify all the claims+#if MIN_VERSION_jwt(0,8,0)+ case verify (hmacSecret (_unSharedSecret ssecret)) unverified of+#else case verify (secret (_unSharedSecret ssecret)) unverified of+#endif Nothing -> return Nothing (Just verified) -> -- check expiration case exp (claims verified) of@@ -670,7 +702,7 @@ (Just exp') -> if (utcTimeToPOSIXSeconds now) > (secondsSinceEpoch exp') then return Nothing- else case Map.lookup "authAdmin" (unregisteredClaims (claims verified)) of+ else case Map.lookup "authAdmin" (unClaimsMap (unregisteredClaims (claims verified))) of Nothing -> return (Just (Token u False, verified)) (Just a) -> case fromJSON a of
Happstack/Authenticate/Password/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, TemplateHaskell, TypeFamilies, TypeSynonymInstances, OverloadedStrings #-}+{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, TemplateHaskell, TypeFamilies, TypeSynonymInstances, OverloadedStrings #-} module Happstack.Authenticate.Password.Core where import Control.Applicative ((<$>), optional)@@ -20,7 +20,7 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe, fromJust)-import Data.Monoid ((<>))+import Data.Monoid ((<>), mempty) import Data.SafeCopy (SafeCopy, base, deriveSafeCopy) import Data.Text (Text) import qualified Data.Text as Text@@ -41,10 +41,20 @@ import qualified Text.Email.Validate as Email import Text.Shakespeare.I18N (RenderMessage(..), Lang, mkMessageFor) import qualified Web.JWT as JWT-import Web.JWT (Algorithm(HS256), JWT, VerifiedJWT, JWTClaimsSet(..), encodeSigned, claims, decode, decodeAndVerifySignature, intDate, secret, secondsSinceEpoch, verify)+import Web.JWT (Algorithm(HS256), JWT, VerifiedJWT, JWTClaimsSet(..), encodeSigned, claims, decode, decodeAndVerifySignature, intDate, secondsSinceEpoch, verify)+#if MIN_VERSION_jwt(0,8,0)+import Web.JWT (ClaimsMap(..), hmacSecret)+#else+import Web.JWT (secret)+#endif import Web.Routes import Web.Routes.TH +#if MIN_VERSION_jwt(0,8,0)+#else+unClaimsMap = id+#endif+ ------------------------------------------------------------------------------ -- PasswordConfig ------------------------------------------------------------------------------@@ -246,7 +256,7 @@ -> PasswordConfig -> Maybe (UserId, AccountURL) -> m (Either PasswordError UserId)--- handle new account creation via POST to /account+-- handle new account creation via POST to \/account -- FIXME: check that password and password confirmation match account authenticateState passwordState authenticateConfig passwordConfig Nothing = do method POST@@ -281,7 +291,7 @@ (False, Nothing) -> Nothing (_, Just email) -> if Email.isValid (Text.encodeUtf8 (email ^. unEmail)) then Nothing else Just $ CoreError InvalidEmail --- handle updates to /account/<userId>/*+-- handle updates to '/account/<userId>/*' account authenticateState passwordState authenticateConfig passwordConfig (Just (uid, url)) = case url of Password ->@@ -358,7 +368,7 @@ issueResetToken :: (MonadIO m) => AcidState AuthenticateState -> User- -> m (Either PasswordError JWT.JSON)+ -> m (Either PasswordError Text) issueResetToken authenticateState user = case user ^. email of Nothing -> return (Left NoEmailAddress)@@ -366,10 +376,27 @@ do ssecret <- getOrGenSharedSecret authenticateState (user ^. userId) -- FIXME: add expiration time now <- liftIO getPOSIXTime- let claims = JWT.def { unregisteredClaims = Map.singleton "reset-password" (toJSON user)- , JWT.exp = intDate $ now + 60- }+ let claims = JWT.JWTClaimsSet+ { JWT.iss = Nothing+ , JWT.sub = Nothing+ , JWT.aud = Nothing+ , JWT.exp = intDate $ now + 60+ , JWT.nbf = Nothing+ , JWT.iat = Nothing+ , JWT.jti = Nothing+ , JWT.unregisteredClaims =+#if MIN_VERSION_jwt(0,8,0)+ JWT.ClaimsMap $+#endif+ Map.singleton "reset-password" (toJSON user)+ }+#if MIN_VERSION_jwt(0,10,0)+ return $ Right $ encodeSigned (hmacSecret $ _unSharedSecret ssecret) mempty claims+#elif MIN_VERSION_jwt(0,9,0)+ return $ Right $ encodeSigned (hmacSecret $ _unSharedSecret ssecret) claims+#else return $ Right $ encodeSigned HS256 (secret $ _unSharedSecret ssecret) claims+#endif -- FIXME: I18N -- FIXME: call renderSendMail@@ -450,7 +477,7 @@ case mUnverified of Nothing -> return Nothing (Just unverified) ->- case Map.lookup "reset-password" (unregisteredClaims (claims unverified)) of+ case Map.lookup "reset-password" (unClaimsMap (unregisteredClaims (claims unverified))) of Nothing -> return Nothing (Just uv) -> case fromJSON uv of@@ -460,7 +487,11 @@ case mssecret of Nothing -> return Nothing (Just ssecret) ->+#if MIN_VERSION_jwt(0,8,0)+ case verify (hmacSecret (_unSharedSecret ssecret)) unverified of+#else case verify (secret (_unSharedSecret ssecret)) unverified of+#endif Nothing -> return Nothing (Just verified) -> do now <- liftIO getPOSIXTime
happstack-authenticate.cabal view
@@ -1,5 +1,5 @@ Name: happstack-authenticate-Version: 2.3.4.15+Version: 2.3.4.16 Synopsis: Happstack Authentication Library Description: A themeable authentication library with support for username+password and OpenId. Homepage: http://www.happstack.com/@@ -54,7 +54,7 @@ filepath >= 1.3 && < 1.5, hsx2hs >= 0.13 && < 0.15, jmacro >= 0.6.11 && < 0.7,- jwt >= 0.3 && < 0.8,+ jwt >= 0.3 && < 0.11, ixset-typed >= 0.3 && < 0.5, happstack-jmacro >= 7.0 && < 7.1, happstack-server >= 6.0 && < 7.6,@@ -64,7 +64,7 @@ hsp >= 0.10 && < 0.11, hsx-jmacro >= 7.3 && < 7.4, safecopy >= 0.8 && < 0.10,- mime-mail >= 0.4 && < 0.5,+ mime-mail >= 0.4 && < 0.6, mtl >= 2.0 && < 2.3, lens >= 4.2 && < 4.18, pwstore-purehaskell == 2.1.*,