haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1011 from geraldus/email-nonce

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
yesod-auth/Yesod/Auth/BrowserId.hs
View File

@ -16,11 +16,10 @@ import Yesod.Auth
import Web.Authenticate.BrowserId import Web.Authenticate.BrowserId
import Data.Text (Text) import Data.Text (Text)
import Yesod.Core import Yesod.Core
import Text.Hamlet (hamlet)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Control.Monad (when, unless) import Control.Monad (when, unless)
import Text.Julius (julius, rawJS) import Text.Julius (rawJS)
import Network.URI (uriPath, parseURI) import Network.URI (uriPath, parseURI)
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)

1
yesod-auth/Yesod/Auth/Dummy.hs
View File

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

63
yesod-auth/Yesod/Auth/Email.hs
View File

@ -1,9 +1,10 @@
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE QuasiQuotes, TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternGuards #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
-- | A Yesod plugin for Authentication via e-mail -- | 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 -- 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 , defaultSetPasswordHandler
) where ) where
import Network.Mail.Mime (randomString) import Yesod.Auth
import Yesod.Auth import qualified Yesod.Auth.Message as Msg
import System.Random import Yesod.Core
import qualified Data.Text as TS import Yesod.Form
import qualified Data.Text as T import qualified Yesod.PasswordStore as PS
import qualified Data.Text.Encoding as TE
import qualified Crypto.Hash.MD5 as H import Control.Applicative ((<$>), (<*>))
import Data.ByteString.Base16 as B16 import qualified Crypto.Hash.MD5 as H
import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import qualified Crypto.Nonce as Nonce
import Data.Text.Encoding.Error (lenientDecode) import Data.ByteString.Base16 as B16
import Data.Text (Text) import Data.Text (Text)
import Yesod.Core import qualified Data.Text as TS
import qualified Yesod.PasswordStore as PS 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 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, registerR, forgotPasswordR, setpassR :: AuthRoute
loginR = PluginR "email" ["login"] loginR = PluginR "email" ["login"]
@ -98,11 +100,11 @@ type Identifier = Text
-- | Data stored in a database for each e-mail address. -- | Data stored in a database for each e-mail address.
data EmailCreds site = EmailCreds data EmailCreds site = EmailCreds
{ emailCredsId :: AuthEmailId site { emailCredsId :: AuthEmailId site
, emailCredsAuthId :: Maybe (AuthId site) , emailCredsAuthId :: Maybe (AuthId site)
, emailCredsStatus :: VerStatus , emailCredsStatus :: VerStatus
, emailCredsVerkey :: Maybe VerKey , emailCredsVerkey :: Maybe VerKey
, emailCredsEmail :: Email , emailCredsEmail :: Email
} }
class ( YesodAuth site class ( YesodAuth site
@ -163,9 +165,7 @@ class ( YesodAuth site
-- --
-- Since 1.1.0 -- Since 1.1.0
randomKey :: site -> IO Text randomKey :: site -> IO Text
randomKey _ = do randomKey _ = Nonce.nonce128urlT defaultNonceGen
stdgen <- newStdGen
return $ TS.pack $ fst $ randomString 10 stdgen
-- | Route to send user to after password has been set correctly. -- | 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 setLoginLinkKey aid = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now) setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
defaultNonceGen :: Nonce.Generator
defaultNonceGen = unsafePerformIO (Nonce.new)
{-# NOINLINE defaultNonceGen #-}

62
yesod-auth/Yesod/Auth/GoogleEmail2.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
-- | Use an email address as an identifier via Google's login system. -- | Use an email address as an identifier via Google's login system.
-- --
@ -47,10 +47,24 @@ module Yesod.Auth.GoogleEmail2
, EmailType(..) , EmailType(..)
) where ) 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 Blaze.ByteString.Builder (fromByteString, toByteString)
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
import Control.Arrow (second) import Control.Arrow (second)
import Control.Monad (liftM, unless, when) import Control.Monad (liftM, unless, when)
import qualified Crypto.Nonce as Nonce
import Data.Aeson ((.:?)) import Data.Aeson ((.:?))
import qualified Data.Aeson as A import qualified Data.Aeson as A
import qualified Data.Aeson.Encode 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 Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TL import qualified Data.Text.Lazy.Builder as TL
import Network.HTTP.Client (parseUrl, requestHeaders, import Network.HTTP.Client (Manager, parseUrl, requestHeaders,
responseBody, urlEncodedBody, Manager) responseBody, urlEncodedBody)
import Network.HTTP.Conduit (http) import Network.HTTP.Conduit (http)
import Network.HTTP.Types (renderQueryText) import Network.HTTP.Types (renderQueryText)
import Network.Mail.Mime (randomString) import System.IO.Unsafe (unsafePerformIO)
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)
pid :: Text pid :: Text
pid = "googleemail2" pid = "googleemail2"
@ -113,8 +115,7 @@ getCreateCsrfToken = do
case mtoken of case mtoken of
Just token -> return token Just token -> return token
Nothing -> do Nothing -> do
stdgen <- liftIO newStdGen token <- Nonce.nonce128urlT defaultNonceGen
let token = T.pack $ fst $ randomString 10 stdgen
setSession csrfKey token setSession csrfKey token
return token return token
@ -315,10 +316,10 @@ instance FromJSON PersonURIType where
-- --
-- Since 1.4.3 -- Since 1.4.3
data Organization = data Organization =
Organization { orgName :: Maybe Text Organization { orgName :: Maybe Text
-- ^ The person's job title or role within the organization -- ^ The person's job title or role within the organization
, orgTitle :: Maybe Text , orgTitle :: Maybe Text
, orgType :: Maybe OrganizationType , orgType :: Maybe OrganizationType
-- ^ The date that the person joined this organization. -- ^ The date that the person joined this organization.
, orgStartDate :: Maybe Text , orgStartDate :: Maybe Text
-- ^ The date that the person left this organization. -- ^ The date that the person left this organization.
@ -357,7 +358,7 @@ instance FromJSON OrganizationType where
-- Since 1.4.3 -- Since 1.4.3
data Place = data Place =
Place { -- | A place where this person has lived. For example: "Seattle, WA", "Near Toronto". 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. -- | If @True@, this place of residence is this person's primary residence.
, placePrimary :: Maybe Bool , placePrimary :: Maybe Bool
} deriving (Show, Eq) } deriving (Show, Eq)
@ -371,13 +372,13 @@ instance FromJSON Place where
-- Since 1.4.3 -- Since 1.4.3
data Name = data Name =
Name { -- | The full name of this person, including middle names, suffixes, etc 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 -- | The family name (last name) of this person
, nameFamily :: Maybe Text , nameFamily :: Maybe Text
-- | The given name (first name) of this person -- | The given name (first name) of this person
, nameGiven :: Maybe Text , nameGiven :: Maybe Text
-- | The middle name of this person. -- | The middle name of this person.
, nameMiddle :: Maybe Text , nameMiddle :: Maybe Text
-- | The honorific prefixes (such as "Dr." or "Mrs.") for this person -- | The honorific prefixes (such as "Dr." or "Mrs.") for this person
, nameHonorificPrefix :: Maybe Text , nameHonorificPrefix :: Maybe Text
-- | The honorific suffixes (such as "Jr.") for this person -- | The honorific suffixes (such as "Jr.") for this person
@ -445,7 +446,7 @@ resizePersonImage (PersonImage uri) size =
-- --
-- Since 1.4.3 -- Since 1.4.3
data Person = Person data Person = Person
{ personId :: Text { personId :: Text
-- | The name of this person, which is suitable for display -- | The name of this person, which is suitable for display
, personDisplayName :: Maybe Text , personDisplayName :: Maybe Text
, personName :: Maybe Name , personName :: Maybe Name
@ -549,3 +550,8 @@ allPersonInfo (A.Object o) = map enc $ M.toList o
where enc (key, A.String s) = (key, s) where enc (key, A.String s) = (key, s)
enc (key, v) = (key, TL.toStrict $ TL.toLazyText $ A.encodeToTextBuilder v) enc (key, v) = (key, TL.toStrict $ TL.toLazyText $ A.encodeToTextBuilder v)
allPersonInfo _ = [] allPersonInfo _ = []
defaultNonceGen :: Nonce.Generator
defaultNonceGen = unsafePerformIO (Nonce.new)
{-# NOINLINE defaultNonceGen #-}

1
yesod-auth/Yesod/Auth/OpenId.hs
View File

@ -17,7 +17,6 @@ import qualified Web.Authenticate.OpenId as OpenId
import Yesod.Form import Yesod.Form
import Yesod.Core import Yesod.Core
import Text.Cassius (cassius)
import Data.Text (Text, isPrefixOf) import Data.Text (Text, isPrefixOf)
import qualified Yesod.Auth.Message as Msg import qualified Yesod.Auth.Message as Msg
import Control.Exception.Lifted (SomeException, try) import Control.Exception.Lifted (SomeException, try)

1
yesod-auth/Yesod/Auth/Rpxnow.hs
View File

@ -11,7 +11,6 @@ import qualified Web.Authenticate.Rpxnow as Rpxnow
import Control.Monad (mplus) import Control.Monad (mplus)
import Yesod.Core import Yesod.Core
import Text.Hamlet (hamlet)
import Data.Text (pack, unpack) import Data.Text (pack, unpack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)

3
yesod-auth/yesod-auth.cabal
View File

@ -1,5 +1,5 @@
name: yesod-auth name: yesod-auth
version: 1.4.5.1 version: 1.4.6
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin author: Michael Snoyman, Patrick Brisbin
@ -58,6 +58,7 @@ library
, blaze-builder , blaze-builder
, conduit , conduit
, conduit-extra , conduit-extra
, nonce >= 1.0.2 && < 1.1
if flag(network-uri) if flag(network-uri)
build-depends: network-uri >= 2.6 build-depends: network-uri >= 2.6