diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index e8dbca8..c2e0e9e 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -25,11 +25,14 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Data.ByteString (ByteString) +--import Text.Email.QuasiQuotation (email) +import Text.Email.Validate (unsafeEmailAddress) import Data.Foldable (traverse_, for_) import Data.Maybe (fromMaybe, listToMaybe) import Data.Proxy import Data.Text (Text) -import Data.Time.Clock (UTCTime) +import Data.Time.Calendar (Day (..)) +import Data.Time.Clock (UTCTime (..)) import Database.Persist import Database.Persist.BackendDataType (backendDataType) import Database.Persist.Migration @@ -49,6 +52,9 @@ import Vervis.Model.Workflow type Apply m = SchemaT SqlBackend m () type Mig m = Migration SqlBackend m +defaultTime :: UTCTime +defaultTime = UTCTime (ModifiedJulianDay 0) 0 + withPrepare :: Monad m => Mig m -> Apply m -> Mig m withPrepare (validate, apply) prepare = (validate, prepare >> apply) @@ -67,10 +73,7 @@ changes = -- 6 , removeField "Ticket" "done" -- 7 - , addField "Ticket" (Just "'TSNew'") $ Field - "status" - (FTPrim $ backendDataType (Proxy :: Proxy Text)) - FieldRequired + , addFieldPrimRequired "Ticket" ("TSNew" :: Text) "status" -- 8 , unchecked $ traverse_ U.addEntity model_2016_09_01_just_workflow -- 9 @@ -78,10 +81,10 @@ changes = -- 10 , let key = fromBackendKey defaultBackendKey :: Key Workflow2016 in withPrepare - (addField "Project" (Just $ toPathPiece key) $ Field + (addFieldRefRequired "Project" + (toBackendKey key) "workflow" - (FTRef "Workflow") - FieldRequired + "Workflow" ) $ do noProjects <- lift $ null <$> selectKeysList [] [LimitTo 1 :: SelectOpt Project] @@ -94,50 +97,28 @@ changes = w = Workflow2016 sid ident Nothing Nothing WSPublic insertKey key w -- 11 - , addField "Workflow" - (Just "'WSSharer'") - (Field - "scope" - (FTPrim $ backendDataType (Proxy :: Proxy Text)) - FieldRequired - ) + , addFieldPrimRequired "Workflow" ("WSSharer" :: Text) "scope" -- 12 , changeFieldType "Person" "hash" $ backendDataType (Proxy :: Proxy ByteString) -- 13 - , unsetFieldMaybe "Person" "email" "'no@email'" + --, unsetFieldPrimMaybe "Person" "email" [email|noreply@no.such.email|] + , unsetFieldPrimMaybe "Person" "email" $ + unsafeEmailAddress "noreply" "no.such.email" -- 14 - , addField "Person" (Just "TRUE") Field - { fieldName = "verified" - , fieldType = FTPrim $ backendDataType (Proxy :: Proxy Bool) - , fieldMaybe = FieldRequired - } + , addFieldPrimRequired "Person" True "verified" -- 15 - , addField "Person" (Just "''") Field - { fieldName = "verifiedKey" - , fieldType = FTPrim $ backendDataType (Proxy :: Proxy Text) - , fieldMaybe = FieldRequired - } + , addFieldPrimRequired "Person" ("" :: Text) "verifiedKey" -- 16 - , addField "Person" (Just "''") Field - { fieldName = "resetPassphraseKey" - , fieldType = FTPrim $ backendDataType (Proxy :: Proxy Text) - , fieldMaybe = FieldRequired - } + , addFieldPrimRequired "Person" ("" :: Text) "resetPassphraseKey" -- 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 + , addFieldPrimRequired "Person" defaultTime "verifiedKeyCreated" -- 20 - , addField "Person" (Just "'1970-01-01 00:00:00'") $ Field - "resetPassKeyCreated" - (FTPrim $ backendDataType (Proxy :: Proxy UTCTime)) - FieldRequired + , addFieldPrimRequired "Person" defaultTime "resetPassKeyCreated" ] migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int))