Merge pull request #1011 from geraldus/email-nonce

Use nonce package to generate verification keys and CSRF tokens
This commit is contained in:
Michael Snoyman 2015-06-30 06:48:31 +03:00
commit aa273c6092
7 changed files with 72 additions and 64 deletions

View File

@ -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)

View File

@ -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

View File

@ -1,9 +1,10 @@
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE QuasiQuotes, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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 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 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 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 Data.Time (addUTCTime, getCurrentTime)
import Safe (readMay)
import System.IO.Unsafe (unsafePerformIO)
import qualified Text.Email.Validate
loginR, registerR, forgotPasswordR, setpassR :: AuthRoute
loginR = PluginR "email" ["login"]
@ -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 #-}

View File

@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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
@ -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 #-}

View File

@ -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)

View File

@ -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)

View File

@ -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