Add delegation state to wallet state.

lib/wallet/cardano-wallet.cabal

@@ -115,6 +115,7 @@ library
     , filepath
     , fmt
     , foldl
+    , formatting
     , free
     , generic-arbitrary
     , generic-lens
@@ -265,9 +266,7 @@ library
     Cardano.Wallet.DB.Sqlite.Migration
     Cardano.Wallet.DB.Sqlite.Schema
     Cardano.Wallet.DB.Sqlite.Types
-    Cardano.Wallet.DB.Store.Checkpoints
     Cardano.Wallet.DB.Store.Checkpoints.Store
-    Cardano.Wallet.DB.Store.Delegations
     Cardano.Wallet.DB.Store.Delegations.Layer
     Cardano.Wallet.DB.Store.Delegations.Model
     Cardano.Wallet.DB.Store.Delegations.Store

lib/wallet/src/Cardano/Wallet/DB/Store/Delegations/Model.hs

@@ -1,19 +1,35 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 module Cardano.Wallet.DB.Store.Delegations.Model
     ( Delegations
     , DeltaDelegations
     ) where
 
 
+import Prelude
+
 import Cardano.Pool.Types
     ( PoolId )
 import Cardano.Wallet.Delegation.Model
-    ( History, Operation )
+    ( History, Operation (..) )
 import Cardano.Wallet.Primitive.Types
     ( SlotNo )
+import Formatting
+    ( bformat, intercalated, later )
+import Formatting.Buildable
+    ( Buildable (..) )
 
 -- | Wallet delegation history
 type Delegations = History SlotNo PoolId
 
 -- | Delta of wallet delegation history. As always with deltas, the
 -- order of the operations matters and it's reversed! (ask the architects)
 type DeltaDelegations = [Operation SlotNo PoolId]
+
+instance Buildable DeltaDelegations where
+    build = bformat $ intercalated ", " $ later $ \case
+        Register slot -> "Register " <> build slot
+        Deregister slot -> "Deregister " <> build slot
+        Delegate pool slot -> "Delegate " <> build pool <> " " <> build slot
+        Rollback slot -> "Rollback " <> build slot

lib/wallet/src/Cardano/Wallet/DB/Store/WalletState/Store.hs

@@ -37,13 +37,16 @@ import Database.Persist.Sqlite
     ( SqlPersistT )
 import UnliftIO.Exception
     ( toException )
+import Cardano.Wallet.DB.Store.Delegations.Store
+    ( mkStoreDelegations )
 
 import qualified Cardano.Wallet.Primitive.Types as W
 
 {-------------------------------------------------------------------------------
     WalletState Store
 -------------------------------------------------------------------------------}
 
+
 -- | Store for 'WalletState' of a single wallet.
 mkStoreWallet
     :: PersistAddressBook s
@@ -56,6 +59,7 @@ mkStoreWallet wF wid = mkUpdateStore load write update
     submissionsStore = mkStoreSubmissions wid
     infoStore = mkStoreInfo
     pkStore = mkStorePrivateKey (keyOfWallet wF) wid
+    delegationsStore = mkStoreDelegations
 
     load = do
         eprologue <-
@@ -65,24 +69,27 @@ mkStoreWallet wF wid = mkUpdateStore load write update
         esubmissions <- loadS submissionsStore
         einfo <- loadS infoStore
         ecredentials <- loadS pkStore
+        edelegations <- loadS delegationsStore
         pure
             $ WalletState
                 <$> eprologue
                 <*> echeckpoints
                 <*> esubmissions
                 <*> einfo
                 <*> ecredentials
+                <*> edelegations
 
     write wallet = do
         writeS infoStore (wallet ^. #info)
         insertPrologue wid (wallet ^. #prologue)
         writeS checkpointsStore (wallet ^. #checkpoints)
         writeS submissionsStore (wallet ^. #submissions)
         writeS pkStore (wallet ^. #credentials)
+        writeS delegationsStore (wallet ^. #delegations)
 
     update = updateLoad load throwIO $ updateSequence update1
       where
-        update1 _ (ReplacePrologue prologue') = insertPrologue wid prologue'
+        update1 _ (ReplacePrologue prologue) = insertPrologue wid prologue
         update1 s (UpdateCheckpoints delta) =
             updateS checkpointsStore (Just $ checkpoints s) delta
         update1 s (UpdateSubmissions deltas) =
@@ -93,3 +100,8 @@ mkStoreWallet wF wid = mkUpdateStore load write update
         update1 _ (UpdateInfo delta) = updateS infoStore Nothing delta
         update1 _ (UpdateCredentials delta) = do
             updateS pkStore Nothing delta
+        update1 s (UpdateDelegations deltas) = do
+            updateSequence
+                (updateS delegationsStore . Just)
+                (delegations s)
+                deltas

lib/wallet/src/Cardano/Wallet/DB/WalletState.hs

@@ -50,6 +50,8 @@ import Cardano.Wallet.Address.Derivation
     ( Depth (RootK) )
 import Cardano.Wallet.Checkpoints
     ( Checkpoints )
+import Cardano.Wallet.DB.Store.Delegations.Model
+    ( Delegations, DeltaDelegations )
 import Cardano.Wallet.DB.Store.Info.Store
     ( DeltaWalletInfo, WalletInfo (..) )
 import Cardano.Wallet.DB.Store.PrivateKey.Store
@@ -135,6 +137,7 @@ data WalletState s = WalletState
     , submissions :: !TxSubmissions
     , info :: !WalletInfo
     , credentials :: Maybe (HashedCredentials (KeyOf s))
+    , delegations :: Delegations
     } deriving (Generic)
 
 deriving instance
@@ -156,6 +159,7 @@ fromGenesis cp winfo
                 , submissions = emptyTxSubmissions
                 , info = winfo
                 , credentials = Nothing
+                , delegations = mempty
                 }
     | otherwise = Nothing
   where
@@ -184,6 +188,7 @@ data DeltaWalletState1 s
     | UpdateSubmissions DeltaTxSubmissions
     | UpdateInfo DeltaWalletInfo
     | UpdateCredentials (DeltaPrivateKey (KeyOf s))
+    | UpdateDelegations DeltaDelegations
 
 instance Delta (DeltaWalletState1 s) where
     type Base (DeltaWalletState1 s) = WalletState s
@@ -192,13 +197,15 @@ instance Delta (DeltaWalletState1 s) where
     apply (UpdateSubmissions d) = over #submissions $ apply d
     apply (UpdateInfo d) = over #info $ apply d
     apply (UpdateCredentials d) = over #credentials $ apply d
+    apply (UpdateDelegations d) = over #delegations $ apply d
 
 instance Buildable (DeltaWalletState1 s) where
     build (ReplacePrologue _) = "ReplacePrologue …"
     build (UpdateCheckpoints d) = "UpdateCheckpoints (" <> build d <> ")"
     build (UpdateSubmissions d) = "UpdateSubmissions (" <> build d <> ")"
     build (UpdateInfo d) = "UpdateInfo (" <> build d <> ")"
     build (UpdateCredentials _d) = "UpdatePrivateKey"
+    build (UpdateDelegations d) = "UpdateDelegations (" <> build d <> ")"
 
 instance Show (DeltaWalletState1 s) where
     show = pretty