Fix DB migrations and use the validating addEntities
This commit is contained in:
parent
28f6cbaf5a
commit
3cc2810d4e
3 changed files with 25 additions and 17 deletions
|
@ -25,21 +25,24 @@ import Control.Monad.IO.Class (MonadIO)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
|
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
--import Text.Email.QuasiQuotation (email)
|
import Data.Default.Class
|
||||||
import Text.Email.Validate (unsafeEmailAddress)
|
import Data.Default.Instances.ByteString ()
|
||||||
import Data.Foldable (traverse_, for_)
|
import Data.Foldable (traverse_, for_)
|
||||||
import Data.Maybe (fromMaybe, listToMaybe)
|
import Data.Maybe (fromMaybe, listToMaybe)
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import Data.Text.Encoding (encodeUtf8)
|
||||||
import Data.Time.Calendar (Day (..))
|
import Data.Time.Calendar (Day (..))
|
||||||
import Data.Time.Clock (UTCTime (..))
|
import Data.Time.Clock (UTCTime (..))
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.BackendDataType (backendDataType)
|
import Database.Persist.BackendDataType (backendDataType, PersistDefault (..))
|
||||||
import Database.Persist.Migration
|
import Database.Persist.Migration
|
||||||
import Database.Persist.Schema (SchemaT, Migration)
|
import Database.Persist.Schema (SchemaT, Migration)
|
||||||
import Database.Persist.Schema.Types
|
import Database.Persist.Schema.Types
|
||||||
import Database.Persist.Schema.PostgreSQL (schemaBackend)
|
import Database.Persist.Schema.PostgreSQL (schemaBackend)
|
||||||
import Database.Persist.Sql (SqlBackend, toSqlKey)
|
import Database.Persist.Sql (SqlBackend, toSqlKey)
|
||||||
|
--import Text.Email.QuasiQuotation (email
|
||||||
|
import Text.Email.Validate (unsafeEmailAddress)
|
||||||
import Web.PathPieces (toPathPiece)
|
import Web.PathPieces (toPathPiece)
|
||||||
|
|
||||||
import qualified Database.Persist.Schema as U (addEntity, unsetFieldDefault)
|
import qualified Database.Persist.Schema as U (addEntity, unsetFieldDefault)
|
||||||
|
@ -49,6 +52,9 @@ import Vervis.Model
|
||||||
import Vervis.Model.Ident
|
import Vervis.Model.Ident
|
||||||
import Vervis.Model.Workflow
|
import Vervis.Model.Workflow
|
||||||
|
|
||||||
|
instance PersistDefault ByteString where
|
||||||
|
pdef = def
|
||||||
|
|
||||||
type Apply m = SchemaT SqlBackend m ()
|
type Apply m = SchemaT SqlBackend m ()
|
||||||
type Mig m = Migration SqlBackend m
|
type Mig m = Migration SqlBackend m
|
||||||
|
|
||||||
|
@ -61,7 +67,7 @@ withPrepare (validate, apply) prepare = (validate, prepare >> apply)
|
||||||
changes :: MonadIO m => [Mig m]
|
changes :: MonadIO m => [Mig m]
|
||||||
changes =
|
changes =
|
||||||
[ -- 1
|
[ -- 1
|
||||||
unchecked $ traverse_ U.addEntity model_2016_08_04
|
addEntities model_2016_08_04
|
||||||
-- 2
|
-- 2
|
||||||
, unchecked $ U.unsetFieldDefault "Sharer" "created"
|
, unchecked $ U.unsetFieldDefault "Sharer" "created"
|
||||||
-- 3
|
-- 3
|
||||||
|
@ -75,9 +81,9 @@ changes =
|
||||||
-- 7
|
-- 7
|
||||||
, addFieldPrimRequired "Ticket" ("TSNew" :: Text) "status"
|
, addFieldPrimRequired "Ticket" ("TSNew" :: Text) "status"
|
||||||
-- 8
|
-- 8
|
||||||
, unchecked $ traverse_ U.addEntity model_2016_09_01_just_workflow
|
, addEntities model_2016_09_01_just_workflow
|
||||||
-- 9
|
-- 9
|
||||||
, unchecked $ traverse_ U.addEntity model_2016_09_01_rest
|
, addEntities model_2016_09_01_rest
|
||||||
-- 10
|
-- 10
|
||||||
, let key = fromBackendKey defaultBackendKey :: Key Workflow2016
|
, let key = fromBackendKey defaultBackendKey :: Key Workflow2016
|
||||||
in withPrepare
|
in withPrepare
|
||||||
|
@ -94,30 +100,31 @@ changes =
|
||||||
selectKeysList [] [Asc SharerId, LimitTo 1]
|
selectKeysList [] [Asc SharerId, LimitTo 1]
|
||||||
for_ msid $ \ sid -> do
|
for_ msid $ \ sid -> do
|
||||||
let ident = text2wfl "dummy"
|
let ident = text2wfl "dummy"
|
||||||
w = Workflow2016 sid ident Nothing Nothing WSPublic
|
w = Workflow2016 sid ident Nothing Nothing
|
||||||
insertKey key w
|
insertKey key w
|
||||||
-- 11
|
-- 11
|
||||||
, addFieldPrimRequired "Workflow" ("WSSharer" :: Text) "scope"
|
, addFieldPrimRequired "Workflow" ("WSSharer" :: Text) "scope"
|
||||||
-- 12
|
-- 12
|
||||||
, changeFieldType "Person" "hash" $
|
, unsetFieldPrimMaybe "Person" "hash" ("" :: Text)
|
||||||
backendDataType (Proxy :: Proxy ByteString)
|
|
||||||
-- 13
|
-- 13
|
||||||
|
, changeFieldTypePrimRequiredFreeHs "Person" "hash" encodeUtf8
|
||||||
|
-- 14
|
||||||
--, unsetFieldPrimMaybe "Person" "email" [email|noreply@no.such.email|]
|
--, unsetFieldPrimMaybe "Person" "email" [email|noreply@no.such.email|]
|
||||||
, unsetFieldPrimMaybe "Person" "email" $
|
, unsetFieldPrimMaybe "Person" "email" $
|
||||||
unsafeEmailAddress "noreply" "no.such.email"
|
unsafeEmailAddress "noreply" "no.such.email"
|
||||||
-- 14
|
|
||||||
, addFieldPrimRequired "Person" True "verified"
|
|
||||||
-- 15
|
-- 15
|
||||||
, addFieldPrimRequired "Person" ("" :: Text) "verifiedKey"
|
, addFieldPrimRequired "Person" True "verified"
|
||||||
-- 16
|
-- 16
|
||||||
, addFieldPrimRequired "Person" ("" :: Text) "resetPassphraseKey"
|
, addFieldPrimRequired "Person" ("" :: Text) "verifiedKey"
|
||||||
-- 17
|
-- 17
|
||||||
, renameField "Person" "hash" "passphraseHash"
|
, addFieldPrimRequired "Person" ("" :: Text) "resetPassphraseKey"
|
||||||
-- 18
|
-- 18
|
||||||
, renameField "Person" "resetPassphraseKey" "resetPassKey"
|
, renameField "Person" "hash" "passphraseHash"
|
||||||
-- 19
|
-- 19
|
||||||
, addFieldPrimRequired "Person" defaultTime "verifiedKeyCreated"
|
, renameField "Person" "resetPassphraseKey" "resetPassKey"
|
||||||
-- 20
|
-- 20
|
||||||
|
, addFieldPrimRequired "Person" defaultTime "verifiedKeyCreated"
|
||||||
|
-- 21
|
||||||
, addFieldPrimRequired "Person" defaultTime "resetPassKeyCreated"
|
, addFieldPrimRequired "Person" defaultTime "resetPassKeyCreated"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
|
@ -25,6 +25,7 @@ packages:
|
||||||
# Packages to be pulled from upstream that are not in the resolver (e.g.,
|
# Packages to be pulled from upstream that are not in the resolver (e.g.,
|
||||||
# acme-missiles-0.3)
|
# acme-missiles-0.3)
|
||||||
extra-deps:
|
extra-deps:
|
||||||
|
- data-default-instances-bytestring-0.0.1
|
||||||
- diagrams-svg-1.4.0.2
|
- diagrams-svg-1.4.0.2
|
||||||
- highlighter2-0.2.5
|
- highlighter2-0.2.5
|
||||||
- libravatar-0.4
|
- libravatar-0.4
|
||||||
|
|
|
@ -231,8 +231,8 @@ library
|
||||||
, darcs
|
, darcs
|
||||||
, darcs-rev
|
, darcs-rev
|
||||||
, data-default
|
, data-default
|
||||||
-- for Data.Paginate.Local
|
|
||||||
, data-default-class
|
, data-default-class
|
||||||
|
, data-default-instances-bytestring
|
||||||
-- for drawing DAGs: RBAC role inheritance, etc.
|
-- for drawing DAGs: RBAC role inheritance, etc.
|
||||||
, diagrams-core
|
, diagrams-core
|
||||||
, diagrams-lib
|
, diagrams-lib
|
||||||
|
|
Loading…
Reference in a new issue