Merge pull request #1011 from geraldus/email-nonce

Use nonce package to generate verification keys and CSRF tokens

yesod-auth/Yesod/Auth/BrowserId.hs

@@ -16,11 +16,10 @@ import Yesod.Auth
 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)

yesod-auth/Yesod/Auth/Dummy.hs

@@ -9,7 +9,6 @@ module Yesod.Auth.Dummy
 
 import Yesod.Auth
 import Yesod.Form (runInputPost, textField, ireq)
-import Text.Hamlet (hamlet)
 import Yesod.Core
 
 authDummy :: YesodAuth m => AuthPlugin m

yesod-auth/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,26 +50,27 @@ module Yesod.Auth.Email
     , 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"]
@@ -98,11 +100,11 @@ type Identifier = Text
 
 -- | 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 @@ class ( YesodAuth site
     --
     -- 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 :: (YesodAuthEmail site, MonadHandler m, HandlerSite m ~ site) =
 setLoginLinkKey aid = do
     now <- liftIO getCurrentTime
     setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
+
+
+defaultNonceGen :: Nonce.Generator
+defaultNonceGen = unsafePerformIO (Nonce.new)
+{-# NOINLINE defaultNonceGen #-}

yesod-auth/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 @@ module Yesod.Auth.GoogleEmail2
     , 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,24 +81,12 @@ import qualified Data.Text                as T
 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 @@ getCreateCsrfToken = do
     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 @@ instance FromJSON PersonURIType where
 --
 -- 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 @@ instance FromJSON OrganizationType where
 -- 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 @@ instance FromJSON Place where
 -- 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 @@ resizePersonImage (PersonImage uri) size =
 --
 -- 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 @@ allPersonInfo (A.Object o) = map enc $ M.toList o
     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 #-}

yesod-auth/Yesod/Auth/OpenId.hs

@@ -17,7 +17,6 @@ import qualified Web.Authenticate.OpenId as OpenId
 
 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 @@ completeHelper idType gets' = do
     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)

yesod-auth/Yesod/Auth/Rpxnow.hs

@@ -11,7 +11,6 @@ import qualified Web.Authenticate.Rpxnow as Rpxnow
 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)

yesod-auth/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 @@ library
                    , blaze-builder
                    , conduit
                    , conduit-extra
+                   , nonce                   >= 1.0.2     && < 1.1
 
     if flag(network-uri)
       build-depends: network-uri >= 2.6