data type for the database migration strategy

cardano-foundation · Feb 4, 2022 · 9871125 · 9871125
1 parent 2f677ee
commit 9871125
Show file tree

Hide file tree

Showing 2 changed files with 29 additions and 3 deletions.
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs
@@ -32,7 +32,7 @@ import Cardano.Address.Script
 import Cardano.Slotting.Slot
     ( SlotNo )
 import Cardano.Wallet.DB.Sqlite.Types
-    ( BlockId, HDPassphrase, TxId, sqlSettings' )
+    ( BlockId, DatabaseFormatMigration, HDPassphrase, TxId, sqlSettings' )
 import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     ( CredentialType )
 import Data.Quantity
@@ -432,4 +432,8 @@ CosignerKey
         cosignerKeyIndex
     Foreign Wallet OnDeleteCascade cosigner_key cosignerKeyWalletId
     deriving Show Generic
+
+FileFormat
+    fileFormatVersion   Text    sql=version
+    fileFormatMigrate   DatabaseFormatMigration    sql=migrate
 |]
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs
@@ -332,7 +332,7 @@ hashOfNoParent :: Hash "BlockHeader"
 hashOfNoParent = Hash . BS.pack $ replicate 32 0
 
 fromMaybeHash :: Maybe (Hash "BlockHeader") -> BlockId
-fromMaybeHash = BlockId . fromMaybe hashOfNoParent 
+fromMaybeHash = BlockId . fromMaybe hashOfNoParent
 
 toMaybeHash :: BlockId -> Maybe (Hash "BlockHeader")
 toMaybeHash (BlockId h) = if h == hashOfNoParent then Nothing else Just h
@@ -850,7 +850,6 @@ instance PersistField POSIXTime where
 instance PersistFieldSql POSIXTime where
     sqlType _ = sqlType (Proxy @Text)
 
-
 -- | Newtype to get a MonadFail instance for @Either Text@.
 --
 -- We need it to use @parseTimeM@.
@@ -859,3 +858,26 @@ newtype EitherText a = EitherText { getEitherText :: Either Text a }
 
 instance MonadFail EitherText where
     fail = EitherText . Left . T.pack
+
+-- | Database migration strategy
+data DatabaseFormatMigration
+    = DatabaseMigrationAuto
+    -- ^ Default migration strategy
+    | DatabaseMigrationKill
+    -- ^ Indicates that the wallet database may be in an inconsistent state
+    -- and the wallet software should attempt to salvage all user data
+    -- (private keys, cosigner public keys, passphrases, …)
+    -- and rebuild a new wallet state from genesis.
+    deriving Eq
+
+instance PersistField DatabaseFormatMigration where
+    toPersistValue = \case
+        DatabaseMigrationAuto -> PersistText "auto"
+        DatabaseMigrationKill -> PersistText "kill_me"
+    fromPersistValue = \case
+        PersistText "auto" -> Right DatabaseMigrationAuto
+        PersistText "kill_me" -> Right DatabaseMigrationKill
+        _ -> Left "Unknown database format migration"
+
+instance PersistFieldSql DatabaseFormatMigration where
+    sqlType _ = sqlType (Proxy @Text)