From 3cc2810d4eb00eb9e1bfc5dc3f97a9763ea0e12f Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Thu, 5 Apr 2018 00:04:39 +0000
Subject: [PATCH] Fix DB migrations and use the validating addEntities

---
 src/Vervis/Migration.hs | 39 +++++++++++++++++++++++----------------
 stack.yaml              |  1 +
 vervis.cabal            |  2 +-
 3 files changed, 25 insertions(+), 17 deletions(-)

diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index c2e0e9e..3ba06d8 100644
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@@ -25,21 +25,24 @@ 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.Default.Class
+import Data.Default.Instances.ByteString ()
 import Data.Foldable (traverse_, for_)
 import Data.Maybe (fromMaybe, listToMaybe)
 import Data.Proxy
 import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Calendar (Day (..))
 import Data.Time.Clock (UTCTime (..))
 import Database.Persist
-import Database.Persist.BackendDataType (backendDataType)
+import Database.Persist.BackendDataType (backendDataType, PersistDefault (..))
 import Database.Persist.Migration
 import Database.Persist.Schema (SchemaT, Migration)
 import Database.Persist.Schema.Types
 import Database.Persist.Schema.PostgreSQL (schemaBackend)
 import Database.Persist.Sql (SqlBackend, toSqlKey)
+--import Text.Email.QuasiQuotation (email
+import Text.Email.Validate (unsafeEmailAddress)
 import Web.PathPieces (toPathPiece)
 
 import qualified Database.Persist.Schema as U (addEntity, unsetFieldDefault)
@@ -49,6 +52,9 @@ import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Model.Workflow
 
+instance PersistDefault ByteString where
+    pdef = def
+
 type Apply m = SchemaT 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 =
     [ -- 1
-      unchecked $ traverse_ U.addEntity model_2016_08_04
+      addEntities model_2016_08_04
       -- 2
     , unchecked $ U.unsetFieldDefault "Sharer" "created"
       -- 3
@@ -75,9 +81,9 @@ changes =
       -- 7
     , addFieldPrimRequired "Ticket" ("TSNew" :: Text) "status"
       -- 8
-    , unchecked $ traverse_ U.addEntity model_2016_09_01_just_workflow
+    , addEntities model_2016_09_01_just_workflow
       -- 9
-    , unchecked $ traverse_ U.addEntity model_2016_09_01_rest
+    , addEntities model_2016_09_01_rest
       -- 10
     , let key = fromBackendKey defaultBackendKey :: Key Workflow2016
       in  withPrepare
@@ -94,30 +100,31 @@ changes =
                         selectKeysList [] [Asc SharerId, LimitTo 1]
                     for_ msid $ \ sid -> do
                         let ident = text2wfl "dummy"
-                            w = Workflow2016 sid ident Nothing Nothing WSPublic
+                            w = Workflow2016 sid ident Nothing Nothing
                         insertKey key w
       -- 11
     , addFieldPrimRequired "Workflow" ("WSSharer" :: Text) "scope"
       -- 12
-    , changeFieldType "Person" "hash" $
-        backendDataType (Proxy :: Proxy ByteString)
+    , unsetFieldPrimMaybe "Person" "hash" ("" :: Text)
       -- 13
+    , changeFieldTypePrimRequiredFreeHs "Person" "hash" encodeUtf8
+      -- 14
     --, unsetFieldPrimMaybe "Person" "email" [email|noreply@no.such.email|]
     , unsetFieldPrimMaybe "Person" "email" $
         unsafeEmailAddress "noreply" "no.such.email"
-      -- 14
-    , addFieldPrimRequired "Person" True "verified"
       -- 15
-    , addFieldPrimRequired "Person" ("" :: Text) "verifiedKey"
+    , addFieldPrimRequired "Person" True "verified"
       -- 16
-    , addFieldPrimRequired "Person" ("" :: Text) "resetPassphraseKey"
+    , addFieldPrimRequired "Person" ("" :: Text) "verifiedKey"
       -- 17
-    , renameField "Person" "hash" "passphraseHash"
+    , addFieldPrimRequired "Person" ("" :: Text) "resetPassphraseKey"
       -- 18
-    , renameField "Person" "resetPassphraseKey" "resetPassKey"
+    , renameField "Person" "hash" "passphraseHash"
       -- 19
-    , addFieldPrimRequired "Person" defaultTime "verifiedKeyCreated"
+    , renameField "Person" "resetPassphraseKey" "resetPassKey"
       -- 20
+    , addFieldPrimRequired "Person" defaultTime "verifiedKeyCreated"
+      -- 21
     , addFieldPrimRequired "Person" defaultTime "resetPassKeyCreated"
     ]
 
diff --git a/stack.yaml b/stack.yaml
index 6024e8e..5220534 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -25,6 +25,7 @@ packages:
 # Packages to be pulled from upstream that are not in the resolver (e.g.,
 # acme-missiles-0.3)
 extra-deps:
+  - data-default-instances-bytestring-0.0.1
   - diagrams-svg-1.4.0.2
   - highlighter2-0.2.5
   - libravatar-0.4
diff --git a/vervis.cabal b/vervis.cabal
index 8f40681..410b734 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -231,8 +231,8 @@ library
                      , darcs
                      , darcs-rev
                      , data-default
-                       -- for Data.Paginate.Local
                      , data-default-class
+                     , data-default-instances-bytestring
                        -- for drawing DAGs: RBAC role inheritance, etc.
                        , diagrams-core
                        , diagrams-lib