yesod-auth 1.6.11.3 → 1.6.12.0
raw patch · 13 files changed
+107/−96 lines, 13 filesdep +cryptondep −cryptonitedep ~basenew-uploader
Dependencies added: crypton
Dependencies removed: cryptonite
Dependency ranges changed: base
Files
- ChangeLog.md +7/−0
- Yesod/Auth.hs +7/−5
- Yesod/Auth/BrowserId.hs +3/−2
- Yesod/Auth/Dummy.hs +6/−5
- Yesod/Auth/Email.hs +28/−22
- Yesod/Auth/GoogleEmail2.hs +11/−11
- Yesod/Auth/Hardcoded.hs +9/−10
- Yesod/Auth/Message.hs +4/−6
- Yesod/Auth/OpenId.hs +3/−3
- Yesod/Auth/Routes.hs +5/−2
- Yesod/Auth/Rpxnow.hs +4/−3
- Yesod/Auth/Util/PasswordStore.hs +17/−24
- yesod-auth.cabal +3/−3
ChangeLog.md view
@@ -1,5 +1,12 @@ # ChangeLog for yesod-auth +## 1.6.12.0++* Add `afterPasswordRouteHandler` [#1863](https://github.com/yesodweb/yesod/pull/1863)+* Use crypton instead of cryptonite [#1838](https://github.com/yesodweb/yesod/pull/1838)+* Set `base >= 4.11` for less CPP and imports [#1876](https://github.com/yesodweb/yesod/pull/1876)++ ## 1.6.11.3 * Add Romanian translation [#1809](https://github.com/yesodweb/yesod/pull/1809)
Yesod/Auth.hs view
@@ -1,15 +1,18 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+ module Yesod.Auth ( -- * Subsite Auth@@ -49,7 +52,6 @@ import Control.Monad (when) import Control.Monad.Trans.Maybe-import UnliftIO (withRunInIO, MonadUnliftIO) import Yesod.Auth.Routes import Data.Text.Encoding (decodeUtf8With)
Yesod/Auth/BrowserId.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+ -- | NOTE: Mozilla Persona will be shut down by the end of 2016, therefore this -- module is no longer recommended for use. module Yesod.Auth.BrowserId
Yesod/Auth/Dummy.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-}+ -- | Provides a dummy authentication module that simply lets a user specify -- their identifier. This is not intended for real world use, just for -- testing. This plugin supports form submissions via JSON (since 1.6.8).
Yesod/Auth/Email.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE ConstrainedClassMethods #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+ -- | A Yesod plugin for Authentication via e-mail -- -- This plugin works out of the box by only setting a few methods on@@ -117,7 +118,6 @@ , defaultRegisterHelper ) where -import Control.Applicative ((<$>), (<*>)) import qualified Crypto.Hash as H import qualified Crypto.Nonce as Nonce import Data.Aeson.Types (Parser, Result (..), parseMaybe,@@ -139,7 +139,6 @@ import qualified Yesod.Auth.Message as Msg import qualified Yesod.Auth.Util.PasswordStore as PS import Yesod.Core-import Yesod.Core.Types (TypedContent (TypedContent)) import Yesod.Form loginR, registerR, forgotPasswordR, setpassR :: AuthRoute@@ -295,6 +294,14 @@ -- @since 1.2.0 afterPasswordRoute :: site -> Route site + -- | Same as @afterPasswordRoute@ but allows you to run Handler code+ --+ -- If this function is overridden then @afterPasswordRoute@ is ignored.+ --+ -- @since 1.6.12.0+ afterPasswordRouteHandler :: AuthHandler site (Route site)+ afterPasswordRouteHandler = getYesod >>= pure . afterPasswordRoute+ -- | Route to send user to after verification with a password -- -- @since 1.6.4@@ -485,8 +492,7 @@ passwordMsg <- renderMessage' Msg.Password (passwordRes, passwordView) <- mreq passwordField (passwordSettings passwordMsg) Nothing - let userRes = UserLoginForm Control.Applicative.<$> emailRes- Control.Applicative.<*> passwordRes+ let userRes = UserLoginForm <$> emailRes <*> passwordRes let widget = do [whamlet| #{extra}@@ -617,13 +623,13 @@ return $ Just (lid, False, key, identifier) case registerCreds of Nothing -> loginErrorMessageI dest (Msg.IdentifierNotFound identifier)- Just creds@(_, False, _, _) -> sendConfirmationEmail creds- Just creds@(_, True, _, _) -> do+ Just regCreds@(_, False, _, _) -> sendConfirmationEmail regCreds+ Just regCreds@(_, True, _, _) -> do if forgotPassword- then sendConfirmationEmail creds+ then sendConfirmationEmail regCreds else case emailPreviouslyRegisteredResponse identifier of Just response -> response- Nothing -> sendConfirmationEmail creds+ Nothing -> sendConfirmationEmail regCreds where sendConfirmationEmail (lid, _, verKey, email) = do render <- getUrlRender tp <- getRouteToParent@@ -927,16 +933,16 @@ Left e -> loginErrorMessage (tm setpassR) e Right () -> do salted <- hashAndSaltPassword new- y <- do- setPassword aid salted- deleteSession loginLinkKey- addMessageI "success" msgOk- getYesod+ setPassword aid salted+ deleteSession loginLinkKey+ addMessageI "success" msgOk+ _ <- getYesod mr <- getMessageRender selectRep $ do- provideRep $- fmap asHtml $ redirect $ afterPasswordRoute y+ provideRep $ do+ route <- afterPasswordRouteHandler+ fmap asHtml $ redirect route provideJsonMessage (mr msgOk) saltLength :: Int
Yesod/Auth/GoogleEmail2.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+ -- | Use an email address as an identifier via Google's login system. -- -- Note that this is a replacement for "Yesod.Auth.GoogleEmail", which depends@@ -70,7 +71,6 @@ import Blaze.ByteString.Builder (fromByteString, toByteString)-import Control.Applicative ((<$>), (<*>)) import Control.Arrow (second) import Control.Monad (unless, when) import Control.Monad.IO.Class (MonadIO)@@ -88,7 +88,6 @@ import Data.Conduit import Data.Conduit.Attoparsec (sinkParser) import Data.Maybe (fromMaybe)-import Data.Monoid (mappend) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8)@@ -188,7 +187,7 @@ return $ decodeUtf8 $ toByteString $ fromByteString "https://accounts.google.com/o/oauth2/auth"- `Data.Monoid.mappend` renderQueryText True qs+ `mappend` renderQueryText True qs login tm = do [whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]@@ -308,9 +307,10 @@ } deriving (Show, Eq) instance FromJSON Token where- parseJSON = withObject "Tokens" $ \o -> Token- Control.Applicative.<$> o .: "access_token"- Control.Applicative.<*> o .: "token_type"+ parseJSON = withObject "Tokens" $ \o ->+ Token+ <$> o .: "access_token"+ <*> o .: "token_type" -------------------------------------------------------------------------------- -- | Gender of the person
Yesod/Auth/Hardcoded.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+ {-| Module : Yesod.Auth.Hardcoded Description : Very simple auth plugin for hardcoded auth pairs.@@ -137,8 +138,6 @@ import qualified Yesod.Auth.Message as Msg import Yesod.Core import Yesod.Form (ireq, runInputPost, textField)--import Control.Applicative ((<$>), (<*>)) import Data.Text (Text) @@ -187,8 +186,8 @@ => AuthHandler site TypedContent postLoginR = do (username, password) <- runInputPost- ((,) Control.Applicative.<$> ireq textField "username"- Control.Applicative.<*> ireq textField "password")+ ((,) <$> ireq textField "username"+ <*> ireq textField "password") isValid <- validatePassword username password if isValid then setCredsRedirect (Creds "hardcoded" username [])
Yesod/Auth/Message.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+ module Yesod.Auth.Message ( AuthMessage (..) , defaultMessage@@ -23,8 +24,7 @@ , romanianMessage ) where -import Data.Monoid (mappend, (<>))-import Data.Text (Text)+import Data.Text (Text) data AuthMessage = NoOpenID@@ -92,9 +92,7 @@ englishMessage EnterEmail = "Enter your e-mail address below, and a confirmation e-mail will be sent to you." englishMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent" englishMessage (ConfirmationEmailSent email) =- "A confirmation e-mail has been sent to " `Data.Monoid.mappend`- email `mappend`- "."+ "A confirmation e-mail has been sent to " `mappend` email `mappend` "." englishMessage AddressVerified = "Email address verified, please set a new password" englishMessage EmailVerifiedChangePass = "Email address verified, please set a new password" englishMessage EmailVerified = "Email address verified"@@ -885,7 +883,7 @@ romanianMessage EnterEmail = "Introduceți adresa dvs. de e-mail pentru a primi un e-mail de confirmare." romanianMessage ConfirmationEmailSentTitle = "Un mesaj de confirmare a fost trimis la adresa dvs. de e-mail" romanianMessage (ConfirmationEmailSent email) =- "Un mesaj de confirmare a fost trimis la " `Data.Monoid.mappend` email `mappend` "."+ "Un mesaj de confirmare a fost trimis la " `mappend` email `mappend` "." romanianMessage AddressVerified = "Adresa de e-mail a fost verificată, vă rugăm să setați o parolă nouă" romanianMessage EmailVerifiedChangePass = "Adresa de e-mail a fost verificată, vă rugăm să setați o parolă nouă" romanianMessage EmailVerified = "Adresa de e-mail a fost verificată"
Yesod/Auth/OpenId.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GADTs #-}+ module Yesod.Auth.OpenId ( authOpenId , forwardUrl
Yesod/Auth/Routes.hs view
@@ -1,10 +1,13 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}+ module Yesod.Auth.Routes where import Yesod.Core
Yesod/Auth/Rpxnow.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+ module Yesod.Auth.Rpxnow ( authRpxnow ) where
Yesod/Auth/Util/PasswordStore.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE OverloadedStrings, BangPatterns #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+ -- | -- This is a fork of pwstore-fast, originally copyright (c) Peter Scott, 2011, -- and released under a BSD-style licence.@@ -169,7 +170,7 @@ let hLen = 32 dkLen = hLen in go hLen dkLen where- go hLen dkLen | dkLen > (2^(32 :: Int) - 1) * hLen = error "Derived key too long."+ go hLen dkLen | dkLen > (2 ^ (32 :: Int) - 1) * hLen = error "Derived key too long." | otherwise = let !l = ceiling ((fromIntegral dkLen / fromIntegral hLen) :: Double) !r = dkLen - (l - 1) * hLen@@ -233,15 +234,16 @@ -- | Try to parse a password hash. readPwHash :: ByteString -> Maybe (Int, Salt, ByteString)-readPwHash pw | length broken /= 4- || algorithm /= "sha256"- || B.length hash /= 44 = Nothing- | otherwise = case B.readInt strBS of- Just (strength, _) -> Just (strength, SaltBS salt, hash)- Nothing -> Nothing- where broken = B.split '|' pw- [algorithm, strBS, salt, hash] = broken+readPwHash pw+ | ["sha256", strBS, salt, hash] <- broken+ , B.length hash == 44 =+ (\(strength, _) -> (strength, SaltBS salt, hash))+ <$> B.readInt strBS+ | otherwise = Nothing+ where+ broken = B.split '|' pw + -- | Encode a password hash, from a @(strength, salt, hash)@ tuple, where -- strength is an 'Int', and both @salt@ and @hash@ are base64-encoded -- 'ByteString's.@@ -280,7 +282,7 @@ -> IO ByteString makePasswordWith algorithm password strength = do salt <- genSaltIO- return $ makePasswordSaltWith algorithm (2^) password salt strength+ return $ makePasswordSaltWith algorithm (2 ^) password salt strength -- | A generic version of 'makePasswordSalt', meant to give the user -- the maximum control over the generation parameters.@@ -314,7 +316,7 @@ -- @since 1.4.18 -- makePasswordSalt :: ByteString -> Salt -> Int -> ByteString-makePasswordSalt = makePasswordSaltWith pbkdf1 (2^)+makePasswordSalt = makePasswordSaltWith pbkdf1 (2 ^) -- | 'verifyPasswordWith' @algorithm userInput pwHash@ verifies -- the password @userInput@ given by the user against the stored password@@ -351,7 +353,7 @@ -- @since 1.4.18 -- verifyPassword :: ByteString -> ByteString -> Bool-verifyPassword = verifyPasswordWith pbkdf1 (2^)+verifyPassword = verifyPasswordWith pbkdf1 (2 ^) -- | Try to strengthen a password hash, by hashing it some more -- times. @'strengthenPassword' pwHash new_strength@ will return a new password@@ -376,7 +378,7 @@ else pwHash where newHash = encode $ hashRounds hash extraRounds- extraRounds = (2^newstr) - (2^oldstr)+ extraRounds = (2 ^ newstr) - (2 ^ oldstr) hash = decodeLenient hashB64 -- | Return the strength of a password hash.@@ -453,12 +455,3 @@ where (a, g') = randomR ('\NUL', '\255') g salt = makeSalt $ B.pack $ map fst (rands gen 16) newgen = snd $ last (rands gen 16)--#if !MIN_VERSION_base(4, 6, 0)--- | Strict version of 'modifySTRef'-modifySTRef' :: STRef s a -> (a -> a) -> ST s ()-modifySTRef' ref f = do- x <- readSTRef ref- let x' = f x- x' `seq` writeSTRef ref x'-#endif
yesod-auth.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: yesod-auth-version: 1.6.11.3+version: 1.6.12.0 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin@@ -21,7 +21,7 @@ library default-language: Haskell2010- build-depends: base >= 4.10 && < 5+ build-depends: base >= 4.11 && < 5 , aeson >= 0.7 , attoparsec-aeson >= 2.1 , authenticate >= 1.3.4@@ -35,7 +35,7 @@ , conduit >= 1.3 , conduit-extra , containers- , cryptonite+ , crypton , data-default , email-validate >= 1.0 , file-embed