diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.6 + +* Use nonce package to generate verification keys and CSRF tokens [#1011](https://github.com/yesodweb/yesod/pull/1011) + ## 1.4.5 * Adds export of email verify route [#980](https://github.com/yesodweb/yesod/pull/980) diff --git a/Yesod/Auth/BrowserId.hs b/Yesod/Auth/BrowserId.hs --- a/Yesod/Auth/BrowserId.hs +++ b/Yesod/Auth/BrowserId.hs @@ -16,11 +16,10 @@ import Web.Authenticate.BrowserId import Data.Text (Text) import Yesod.Core -import Text.Hamlet (hamlet) import qualified Data.Text as T import Data.Maybe (fromMaybe) import Control.Monad (when, unless) -import Text.Julius (julius, rawJS) +import Text.Julius (rawJS) import Network.URI (uriPath, parseURI) import Data.FileEmbed (embedFile) import Data.ByteString (ByteString) diff --git a/Yesod/Auth/Dummy.hs b/Yesod/Auth/Dummy.hs --- a/Yesod/Auth/Dummy.hs +++ b/Yesod/Auth/Dummy.hs @@ -9,7 +9,6 @@ import Yesod.Auth import Yesod.Form (runInputPost, textField, ireq) -import Text.Hamlet (hamlet) import Yesod.Core authDummy :: YesodAuth m => AuthPlugin m diff --git a/Yesod/Auth/Email.hs b/Yesod/Auth/Email.hs --- a/Yesod/Auth/Email.hs +++ b/Yesod/Auth/Email.hs @@ -1,9 +1,10 @@ {-# LANGUAGE ConstrainedClassMethods #-} -{-# LANGUAGE QuasiQuotes, TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeFamilies #-} -- | A Yesod plugin for Authentication via e-mail -- -- This plugin works out of the box by only setting a few methods on the type class @@ -49,27 +50,28 @@ , defaultSetPasswordHandler ) where -import Network.Mail.Mime (randomString) -import Yesod.Auth -import System.Random -import qualified Data.Text as TS -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import qualified Crypto.Hash.MD5 as H -import Data.ByteString.Base16 as B16 -import Data.Text.Encoding (encodeUtf8, decodeUtf8With) -import Data.Text.Encoding.Error (lenientDecode) -import Data.Text (Text) -import Yesod.Core -import qualified Yesod.PasswordStore as PS +import Yesod.Auth +import qualified Yesod.Auth.Message as Msg +import Yesod.Core +import Yesod.Form +import qualified Yesod.PasswordStore as PS + +import Control.Applicative ((<$>), (<*>)) +import qualified Crypto.Hash.MD5 as H +import qualified Crypto.Nonce as Nonce +import Data.ByteString.Base16 as B16 +import Data.Text (Text) +import qualified Data.Text as TS +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +import qualified Data.Text.Encoding as TE +import Data.Text.Encoding.Error (lenientDecode) +import Data.Time (addUTCTime, getCurrentTime) +import Safe (readMay) +import System.IO.Unsafe (unsafePerformIO) import qualified Text.Email.Validate -import qualified Yesod.Auth.Message as Msg -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (void) -import Yesod.Form -import Data.Time (getCurrentTime, addUTCTime) -import Safe (readMay) + loginR, registerR, forgotPasswordR, setpassR :: AuthRoute loginR = PluginR "email" ["login"] registerR = PluginR "email" ["register"] @@ -98,11 +100,11 @@ -- | Data stored in a database for each e-mail address. data EmailCreds site = EmailCreds - { emailCredsId :: AuthEmailId site + { emailCredsId :: AuthEmailId site , emailCredsAuthId :: Maybe (AuthId site) , emailCredsStatus :: VerStatus , emailCredsVerkey :: Maybe VerKey - , emailCredsEmail :: Email + , emailCredsEmail :: Email } class ( YesodAuth site @@ -163,9 +165,7 @@ -- -- Since 1.1.0 randomKey :: site -> IO Text - randomKey _ = do - stdgen <- newStdGen - return $ TS.pack $ fst $ randomString 10 stdgen + randomKey _ = Nonce.nonce128urlT defaultNonceGen -- | Route to send user to after password has been set correctly. -- @@ -586,3 +586,8 @@ setLoginLinkKey aid = do now <- liftIO getCurrentTime setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now) + + +defaultNonceGen :: Nonce.Generator +defaultNonceGen = unsafePerformIO (Nonce.new) +{-# NOINLINE defaultNonceGen #-} diff --git a/Yesod/Auth/GoogleEmail2.hs b/Yesod/Auth/GoogleEmail2.hs --- a/Yesod/Auth/GoogleEmail2.hs +++ b/Yesod/Auth/GoogleEmail2.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE QuasiQuotes #-} -- | Use an email address as an identifier via Google's login system. -- @@ -47,10 +47,24 @@ , EmailType(..) ) where +import Yesod.Auth (Auth, AuthPlugin (AuthPlugin), + AuthRoute, Creds (Creds), + Route (PluginR), YesodAuth, + authHttpManager, setCredsRedirect) +import qualified Yesod.Auth.Message as Msg +import Yesod.Core (HandlerSite, HandlerT, MonadHandler, + TypedContent, getRouteToParent, + getUrlRender, getYesod, invalidArgs, + lift, liftIO, lookupGetParam, + lookupSession, notFound, redirect, + setSession, whamlet, (.:)) + + import Blaze.ByteString.Builder (fromByteString, toByteString) import Control.Applicative ((<$>), (<*>)) import Control.Arrow (second) import Control.Monad (liftM, unless, when) +import qualified Crypto.Nonce as Nonce import Data.Aeson ((.:?)) import qualified Data.Aeson as A import qualified Data.Aeson.Encode as A @@ -67,25 +81,13 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TL -import Network.HTTP.Client (parseUrl, requestHeaders, - responseBody, urlEncodedBody, Manager) +import Network.HTTP.Client (Manager, parseUrl, requestHeaders, + responseBody, urlEncodedBody) import Network.HTTP.Conduit (http) import Network.HTTP.Types (renderQueryText) -import Network.Mail.Mime (randomString) -import System.Random (newStdGen) -import Yesod.Auth (Auth, AuthPlugin (AuthPlugin), - AuthRoute, Creds (Creds), - Route (PluginR), YesodAuth, - authHttpManager, setCredsRedirect) -import qualified Yesod.Auth.Message as Msg -import Yesod.Core (HandlerSite, MonadHandler, - getRouteToParent, getUrlRender, - getYesod, invalidArgs, lift, - lookupGetParam, - lookupSession, notFound, redirect, - setSession, whamlet, (.:), - TypedContent, HandlerT, liftIO) +import System.IO.Unsafe (unsafePerformIO) + pid :: Text pid = "googleemail2" @@ -113,8 +115,7 @@ case mtoken of Just token -> return token Nothing -> do - stdgen <- liftIO newStdGen - let token = T.pack $ fst $ randomString 10 stdgen + token <- Nonce.nonce128urlT defaultNonceGen setSession csrfKey token return token @@ -315,10 +316,10 @@ -- -- Since 1.4.3 data Organization = - Organization { orgName :: Maybe Text + Organization { orgName :: Maybe Text -- ^ The person's job title or role within the organization - , orgTitle :: Maybe Text - , orgType :: Maybe OrganizationType + , orgTitle :: Maybe Text + , orgType :: Maybe OrganizationType -- ^ The date that the person joined this organization. , orgStartDate :: Maybe Text -- ^ The date that the person left this organization. @@ -357,7 +358,7 @@ -- Since 1.4.3 data Place = Place { -- | A place where this person has lived. For example: "Seattle, WA", "Near Toronto". - placeValue :: Maybe Text + placeValue :: Maybe Text -- | If @True@, this place of residence is this person's primary residence. , placePrimary :: Maybe Bool } deriving (Show, Eq) @@ -371,13 +372,13 @@ -- Since 1.4.3 data Name = Name { -- | The full name of this person, including middle names, suffixes, etc - nameFormatted :: Maybe Text + nameFormatted :: Maybe Text -- | The family name (last name) of this person - , nameFamily :: Maybe Text + , nameFamily :: Maybe Text -- | The given name (first name) of this person - , nameGiven :: Maybe Text + , nameGiven :: Maybe Text -- | The middle name of this person. - , nameMiddle :: Maybe Text + , nameMiddle :: Maybe Text -- | The honorific prefixes (such as "Dr." or "Mrs.") for this person , nameHonorificPrefix :: Maybe Text -- | The honorific suffixes (such as "Jr.") for this person @@ -445,7 +446,7 @@ -- -- Since 1.4.3 data Person = Person - { personId :: Text + { personId :: Text -- | The name of this person, which is suitable for display , personDisplayName :: Maybe Text , personName :: Maybe Name @@ -549,3 +550,8 @@ where enc (key, A.String s) = (key, s) enc (key, v) = (key, TL.toStrict $ TL.toLazyText $ A.encodeToTextBuilder v) allPersonInfo _ = [] + + +defaultNonceGen :: Nonce.Generator +defaultNonceGen = unsafePerformIO (Nonce.new) +{-# NOINLINE defaultNonceGen #-} diff --git a/Yesod/Auth/OpenId.hs b/Yesod/Auth/OpenId.hs --- a/Yesod/Auth/OpenId.hs +++ b/Yesod/Auth/OpenId.hs @@ -17,7 +17,6 @@ import Yesod.Form import Yesod.Core -import Text.Cassius (cassius) import Data.Text (Text, isPrefixOf) import qualified Yesod.Auth.Message as Msg import Control.Exception.Lifted (SomeException, try) @@ -92,7 +91,7 @@ eres <- try $ OpenId.authenticateClaimed gets' (authHttpManager master) either onFailure onSuccess eres where - onFailure err = do + onFailure err = do tm <- getRouteToParent lift $ loginErrorMessage (tm LoginR) $ T.pack $ show (err :: SomeException) diff --git a/Yesod/Auth/Rpxnow.hs b/Yesod/Auth/Rpxnow.hs --- a/Yesod/Auth/Rpxnow.hs +++ b/Yesod/Auth/Rpxnow.hs @@ -11,7 +11,6 @@ import Control.Monad (mplus) import Yesod.Core -import Text.Hamlet (hamlet) import Data.Text (pack, unpack) import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) diff --git a/yesod-auth.cabal b/yesod-auth.cabal --- a/yesod-auth.cabal +++ b/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.4.5.1 +version: 1.4.6 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin @@ -58,6 +58,7 @@ , blaze-builder , conduit , conduit-extra + , nonce >= 1.0.2 && < 1.1 if flag(network-uri) build-depends: network-uri >= 2.6