Refactor and simplify SharedState n k

* Use the new address pool data structure from `Cardano.Wallet.Address.Pool`
* Remove `ParentContextShared` constructor from sequential state
* Merge `SharedStateFields` and `SharedStatePending` types into `SharedSate`.

lib/core/src/Cardano/Wallet.hs

@@ -285,20 +285,13 @@ import Cardano.Wallet.Primitive.AddressDiscovery
 import Cardano.Wallet.Primitive.AddressDiscovery.Random
     ( ErrImportAddress (..), RndStateLike )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( ParentContext (..)
-    , SeqState
-    , defaultAddressPoolGap
-    , mkSeqStateFromRootXPrv
-    , purposeBIP44
-    )
+    ( SeqState, defaultAddressPoolGap, mkSeqStateFromRootXPrv, purposeBIP44 )
 import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     ( CredentialType (..)
     , ErrAddCosigner (..)
     , ErrScriptTemplate (..)
     , SharedState (..)
-    , SharedStateFields (..)
     , addCosignerAccXPub
-    , isShared
     )
 import Cardano.Wallet.Primitive.CoinSelection
     ( Selection
@@ -743,7 +736,6 @@ createIcarusWallet
         , PaymentAddress n k
         , k ~ IcarusKey
         , s ~ SeqState n k
-        , Typeable n
         )
     => ctx
     -> WalletId
@@ -2910,11 +2902,11 @@ updateCosigner
     -> Cosigner
     -> CredentialType
     -> ExceptT ErrAddCosignerKey IO ()
-updateCosigner ctx wid accXPub cosigner cred = db & \DBLayer{..} -> do
+updateCosigner ctx wid cosignerXPub cosigner cred = db & \DBLayer{..} -> do
     mapExceptT atomically $ do
         cp <- withExceptT ErrAddCosignerKeyNoSuchWallet $ withNoSuchWallet wid $
               readCheckpoint wid
-        case addCosignerAccXPub accXPub cosigner cred (getState cp) of
+        case addCosignerAccXPub (cosigner, cosignerXPub) cred (getState cp) of
             Left err -> throwE (ErrAddCosignerKey err)
             Right st' -> withExceptT ErrAddCosignerKeyNoSuchWallet $
                 putCheckpoint wid (updateState st' cp)
@@ -2926,23 +2918,16 @@ updateCosigner ctx wid accXPub cosigner cred = db & \DBLayer{..} -> do
 -- base addresses (containing both payment and delegation credentials).
 -- So we normalize them all to be base addresses to make sure that we compare them correctly.
 normalizeSharedAddress
-    :: forall s k n.
-        ( MkKeyFingerprint k Address
-        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , s ~ SharedState n k
-        , k ~ SharedKey
-        , SoftDerivation k
-        , Typeable n
-        )
-    => s
+    :: forall n k. ( Shared.SupportsDiscovery n k, k ~ SharedKey )
+    => SharedState n k
     -> Address
     -> Maybe Address
-normalizeSharedAddress s@(SharedState _ state') addr = case state' of
-    PendingFields _ -> Nothing
-    ReadyFields pool -> do
-        let (ParentContextShared _ _ dTM) = Seq.context pool
+normalizeSharedAddress st addr = case Shared.ready st of
+    Shared.Pending -> Nothing
+    Shared.Active _ -> do
+        let dTM = Shared.delegationTemplate st
         fingerprint <- eitherToMaybe (paymentKeyFingerprint @k addr)
-        let (ixM, _) = isShared addr s
+        let (ixM, _) = Shared.isShared addr st
         case (dTM, ixM) of
             (Just dT, Just ix) ->
                 pure $ Shared.liftDelegationAddress @n ix dT fingerprint

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -349,10 +349,8 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random
     ( RndState, mkRndState )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( DerivationPrefix (..)
-    , ParentContext (..)
     , SeqState (..)
     , defaultAddressPoolGap
-    , gap
     , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
     , purposeCIP1852
@@ -362,8 +360,6 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     , ErrAddCosigner (..)
     , ErrScriptTemplate (..)
     , SharedState (..)
-    , SharedStateFields (..)
-    , SharedStatePending (..)
     , mkSharedStateFromAccountXPub
     , mkSharedStateFromRootXPrv
     , validateScriptTemplates
@@ -599,6 +595,7 @@ import qualified Cardano.Wallet.Api.Types as Api
 import qualified Cardano.Wallet.Network as NW
 import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron
 import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus
+import qualified Cardano.Wallet.Primitive.AddressDiscovery.Shared as Shared
 import qualified Cardano.Wallet.Primitive.CoinSelection.Balance as Balance
 import qualified Cardano.Wallet.Primitive.CoinSelection.Collateral as Collateral
 import qualified Cardano.Wallet.Primitive.Types as W
@@ -815,7 +812,6 @@ postAccountWallet
         , WalletKey k
         , HasWorkerRegistry s k ctx
         , IsOurs s RewardAccount
-        , Typeable n
         , (k == SharedKey) ~ 'False
         )
     => ctx
@@ -1045,23 +1041,19 @@ mkSharedWallet
         ( ctx ~ ApiLayer s k
         , s ~ SharedState n k
         , HasWorkerRegistry s k ctx
-        , SoftDerivation k
-        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , Typeable n
+        , Shared.SupportsDiscovery n k
         )
     => MkApiWallet ctx s ApiSharedWallet
-mkSharedWallet ctx wid cp meta pending progress = case getState cp of
-    SharedState (DerivationPrefix (_,_,accIx)) (PendingFields (SharedStatePending _ pTemplate dTemplateM g)) ->
-        pure $ ApiSharedWallet $ Left $ ApiPendingSharedWallet
+mkSharedWallet ctx wid cp meta pending progress = case Shared.ready st of
+    Shared.Pending -> pure $ ApiSharedWallet $ Left $ ApiPendingSharedWallet
         { id = ApiT wid
         , name = ApiT $ meta ^. #name
         , accountIndex = ApiT $ DerivationIndex $ getIndex accIx
-        , addressPoolGap = ApiT g
-        , paymentScriptTemplate = pTemplate
-        , delegationScriptTemplate = dTemplateM
+        , addressPoolGap = ApiT $ Shared.poolGap st
+        , paymentScriptTemplate = Shared.paymentTemplate st
+        , delegationScriptTemplate = Shared.delegationTemplate st
         }
-    SharedState (DerivationPrefix (_,_,accIx)) (ReadyFields pool) -> do
+    Shared.Active _ -> do
         reward <- withWorkerCtx @_ @s @k ctx wid liftE liftE $ \wrk ->
             -- never fails - returns zero if balance not found
             liftIO $ W.fetchRewardBalance @_ @s @k wrk wid
@@ -1075,16 +1067,15 @@ mkSharedWallet ctx wid cp meta pending progress = case getState cp of
             cp
         let available = availableBalance pending cp
         let total = totalBalance pending reward cp
-        let (ParentContextShared _ pTemplate dTemplateM) = pool ^. #context
         pure $ ApiSharedWallet $ Right $ ApiActiveSharedWallet
             { id = ApiT wid
             , name = ApiT $ meta ^. #name
             , accountIndex = ApiT $ DerivationIndex $ getIndex accIx
-            , addressPoolGap = ApiT $ gap pool
+            , addressPoolGap = ApiT $ Shared.poolGap st
             , passphrase = ApiWalletPassphraseInfo
                 <$> fmap (view #lastUpdatedAt) (meta ^. #passphraseInfo)
-            , paymentScriptTemplate = pTemplate
-            , delegationScriptTemplate = dTemplateM
+            , paymentScriptTemplate = Shared.paymentTemplate st
+            , delegationScriptTemplate = Shared.delegationTemplate st
             , delegation = apiDelegation
             , balance = ApiWalletBalance
                 { available = coinToQuantity (available ^. #coin)
@@ -1098,6 +1089,9 @@ mkSharedWallet ctx wid cp meta pending progress = case getState cp of
             , state = ApiT progress
             , tip = tip'
             }
+  where
+    st = getState cp
+    DerivationPrefix (_,_,accIx) = Shared.derivationPrefix st
 
 patchSharedWallet
     :: forall ctx s k n.
@@ -1272,7 +1266,6 @@ postIcarusWallet
         , k ~ IcarusKey
         , HasWorkerRegistry s k ctx
         , PaymentAddress n IcarusKey
-        , Typeable n
         )
     => ctx
     -> ByronWalletPostData '[12,15,18,21,24]
@@ -1293,7 +1286,6 @@ postTrezorWallet
         , k ~ IcarusKey
         , HasWorkerRegistry s k ctx
         , PaymentAddress n IcarusKey
-        , Typeable n
         )
     => ctx
     -> ByronWalletPostData '[12,15,18,21,24]
@@ -1314,7 +1306,6 @@ postLedgerWallet
         , k ~ IcarusKey
         , HasWorkerRegistry s k ctx
         , PaymentAddress n IcarusKey
-        , Typeable n
         )
     => ctx
     -> ByronWalletPostData '[12,15,18,21,24]

lib/core/src/Cardano/Wallet/DB/Sqlite/AddressBook.hs

@@ -28,6 +28,10 @@ import Cardano.Address.Derivation
     ( XPub )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (..)
+    , DerivationType (..)
+    , Index (..)
+    , KeyFingerprint (..)
+    , MkKeyFingerprint (..)
     , MkKeyFingerprint (..)
     , NetworkDiscriminant (..)
     , PaymentAddress (..)
@@ -53,6 +57,7 @@ import Data.Type.Equality
 import Data.Typeable
     ( Typeable )
 
+import qualified Cardano.Wallet.Address.Pool as AddressPool
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Random as Rnd
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Shared as Shared
@@ -99,7 +104,6 @@ instance
     , GetPurpose key
     , SoftDerivation key
     , PaymentAddress n key
-    , Typeable n
     , (key == SharedKey) ~ 'False
     ) => AddressBookIso (Seq.SeqState n key)
   where
@@ -130,24 +134,12 @@ toDiscoveries
 toDiscoveries pool = SeqAddressList
     [ (a,st) | (a,st,_) <- Seq.addresses (liftPaymentAddress @n) pool ]
 
--- | Variant of 'toDiscoveries' that can be used with 'SharedKey'
-toDiscoveriesShared
-    :: forall (n :: NetworkDiscriminant) (c :: Role) key.
-    ( GetPurpose key
-    , Typeable c
-    , Typeable n
-    , key ~ SharedKey
-    ) => Seq.AddressPool c key -> SeqAddressList c
-toDiscoveriesShared pool = SeqAddressList
-    [ (a,st) | (a,st,_) <- Seq.addresses (Shared.liftPaymentAddress @n) pool ]
-
 -- | Fill an empty address pool with addresses.
 fromDiscoveries
     :: forall (n :: NetworkDiscriminant) (c :: Role) key.
     ( MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
     , MkKeyFingerprint key Address
     , SoftDerivation key
-    , Typeable n
     , Typeable c
     ) => Seq.AddressPool c key -> SeqAddressList c -> Seq.AddressPool c key
 fromDiscoveries ctx (SeqAddressList addrs) =
@@ -162,41 +154,33 @@ emptyPool pool = pool{ Seq.indexedKeys = Map.empty }
     Shared key address book
 -------------------------------------------------------------------------------}
 -- | Isomorphism for multi-sig address book.
-instance
-    ( MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
-    , MkKeyFingerprint key Address
-    , GetPurpose key
-    , SoftDerivation key
-    , Typeable n
-    , key ~ SharedKey
-    ) => AddressBookIso (Shared.SharedState n key)
+instance ( key ~ SharedKey ) => AddressBookIso (Shared.SharedState n key)
   where
     data Prologue (Shared.SharedState n key)
         = SharedPrologue (Shared.SharedState n key)
         -- Trick: We keep the type, but we empty the discovered addresses
     data Discoveries (Shared.SharedState n key)
-        = SharedDiscoveries (SeqAddressList 'UtxoExternal)
+        = SharedDiscoveries
+            ( Map
+                (KeyFingerprint "payment" SharedKey)
+                (Index 'Soft 'ScriptK, AddressState)
+            )
 
     addressIso = iso from to
       where
-        from st@(Shared.SharedState a b) = case b of
-            Shared.PendingFields{} ->
-                ( SharedPrologue st
-                , SharedDiscoveries (SeqAddressList [])
-                )
-            Shared.ReadyFields pool ->
-                let b0 = Shared.ReadyFields $ emptyPool pool
-                in  ( SharedPrologue (Shared.SharedState a b0)
-                    , SharedDiscoveries (toDiscoveriesShared @n pool)
+        from st = case Shared.ready st of
+            Shared.Pending -> (SharedPrologue st, SharedDiscoveries Map.empty)
+            Shared.Active pool ->
+                let pool0 = AddressPool.clear pool
+                in  ( SharedPrologue st{ Shared.ready = Shared.Active pool0 }
+                    , SharedDiscoveries $ AddressPool.addresses pool
                     )
-        to  ( SharedPrologue st@(Shared.SharedState a b0)
-            , SharedDiscoveries addrs
-            )
-          = case b0 of
-            Shared.PendingFields{} -> st
-            Shared.ReadyFields pool0
-                -> Shared.SharedState a $ Shared.ReadyFields
-                $ fromDiscoveries @n pool0 addrs
+        to (SharedPrologue st, SharedDiscoveries addrs)
+          = case Shared.ready st of
+            Shared.Pending -> st
+            Shared.Active pool0 ->
+                let pool = AddressPool.loadUnsafe pool0 addrs
+                in  st{ Shared.ready = Shared.Active pool }
 
 {-------------------------------------------------------------------------------
     HD Random address book