diff --git a/config/models b/config/models index a87fdfd..883722e 100644 --- a/config/models +++ b/config/models @@ -24,13 +24,15 @@ Sharer UniqueSharer ident Person - ident SharerId - login Text - passphraseHash ByteString - email EmailAddress - verified Bool - verifiedKey Text - resetPassphraseKey Text + ident SharerId + login Text + passphraseHash ByteString + email EmailAddress + verified Bool + verifiedKey Text + verifiedKeyCreated UTCTime + resetPassKey Text + resetPassKeyCreated UTCTime UniquePersonIdent ident UniquePersonLogin login diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index be70e82..4d7a31d 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -19,6 +19,8 @@ import Prelude (init, last) import Control.Monad.Logger (logWarn) import Control.Monad.Trans.Maybe +import Data.Time.Interval (fromTimeUnit) +import Data.Time.Units (Day) import Database.Persist.Sql (ConnectionPool, runSqlPool) import Text.Shakespeare.Text (textFile) import Text.Hamlet (hamletFile) @@ -41,7 +43,7 @@ import Data.Text as T (pack, intercalate, concat) --import qualified Data.Text.Encoding as TE import Text.Jasmine.Local (discardm) -import Vervis.Import.NoFoundation hiding (last) +import Vervis.Import.NoFoundation hiding (Day, last) import Vervis.Model.Group import Vervis.Model.Ident import Vervis.Model.Role @@ -458,7 +460,8 @@ instance AccountDB AccountPersistDB' where mr <- getMessageRender return $ Left $ mr $ MsgUsernameExists name Right sid -> do - let person = Person sid name pwd email False key "" + let defTime = UTCTime (ModifiedJulianDay 0) 0 + person = Person sid name pwd email False key now "" defTime pid <- insert person return $ Right $ Entity pid person @@ -493,8 +496,10 @@ instance YesodAuthVerify App where verificationRoute _ = ResendVerifyEmailR instance YesodAuthAccount AccountPersistDB' App where - runAccountDB = unAccountPersistDB' - unregisteredLogin u = do + emailVerifyKeyDuration _ = Just $ fromTimeUnit (1 :: Day) + passphraseResetKeyDuration _ = Just $ fromTimeUnit (1 :: Day) + runAccountDB = unAccountPersistDB' + unregisteredLogin u = do lift $ setUnverifiedCreds True $ Creds "account" (username u) [] return mempty diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index b62ac30..e8dbca8 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -29,6 +29,7 @@ import Data.Foldable (traverse_, for_) import Data.Maybe (fromMaybe, listToMaybe) import Data.Proxy import Data.Text (Text) +import Data.Time.Clock (UTCTime) import Database.Persist import Database.Persist.BackendDataType (backendDataType) import Database.Persist.Migration @@ -125,6 +126,18 @@ changes = } -- 17 , renameField "Person" "hash" "passphraseHash" + -- 18 + , renameField "Person" "resetPassphraseKey" "resetPassKey" + -- 19 + , addField "Person" (Just "'1970-01-01 00:00:00'") $ Field + "verifiedKeyCreated" + (FTPrim $ backendDataType (Proxy :: Proxy UTCTime)) + FieldRequired + -- 20 + , addField "Person" (Just "'1970-01-01 00:00:00'") $ Field + "resetPassKeyCreated" + (FTPrim $ backendDataType (Proxy :: Proxy UTCTime)) + FieldRequired ] migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int)) diff --git a/src/Vervis/Model.hs b/src/Vervis/Model.hs index 913ce50..70996e3 100644 --- a/src/Vervis/Model.hs +++ b/src/Vervis/Model.hs @@ -39,13 +39,15 @@ import Vervis.Model.Workflow makeEntities $(modelFile "config/models") instance PersistUserCredentials Person where - userUsernameF = PersonLogin - userPasswordHashF = PersonPassphraseHash - userEmailF = PersonEmail - userEmailVerifiedF = PersonVerified - userEmailVerifyKeyF = PersonVerifiedKey - userResetPwdKeyF = PersonResetPassphraseKey - uniqueUsername = UniquePersonLogin + userUsernameF = PersonLogin + userPasswordHashF = PersonPassphraseHash + userEmailF = PersonEmail + userEmailVerifiedF = PersonVerified + userEmailVerifyKeyF = PersonVerifiedKey + userEmailVerifyKeyCreatedF = Just PersonVerifiedKeyCreated + userResetPwdKeyF = PersonResetPassKey + userResetPwdKeyCreatedF = Just PersonResetPassKeyCreated + uniqueUsername = UniquePersonLogin -- 'Person' contains a sharer ID, so we can't let yesod-auth-account use -- 'userCreate' to create a new user. Instead, override the default -- implementation, where we can make sure to create a 'Sharer' and then a diff --git a/vervis.cabal b/vervis.cabal index 8977225..8f40681 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -298,6 +298,8 @@ library , template-haskell , text , time + , time-interval + , time-units , transformers -- probably should be replaced with lenses once I learn , tuple