add VerificationKeyPool and extend SeqState

lib/core/src/Cardano/Wallet.hs

@@ -642,6 +642,7 @@ createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
             (Seq.rewardAccountKey s)
             (Seq.derivationPrefix s)
             Map.empty
+            (Seq.multisigPool s)
     now <- lift getCurrentTime
     let meta = WalletMetadata
             { name = wname

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

@@ -1701,6 +1701,7 @@ instance
     , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
     , PaymentAddress n k
     , SoftDerivation k
+    , WalletKey k
     ) => PersistState (Seq.SeqState n k) where
     insertState (wid, sl) st = do
         let (intPool, extPool) =
@@ -1733,8 +1734,10 @@ instance
         let rewardXPub = unsafeDeserializeXPub rewardBytes
         intPool <- lift $ selectAddressPool @n wid sl iGap accountXPub
         extPool <- lift $ selectAddressPool @n wid sl eGap accountXPub
+        --TO-DO
+        let multiPool = Seq.mkVerificationKeyPool accountXPub iGap Map.empty
         pendingChangeIxs <- lift $ selectSeqStatePendingIxs wid
-        pure $ Seq.SeqState intPool extPool pendingChangeIxs rewardXPub prefix Map.empty
+        pure $ Seq.SeqState intPool extPool pendingChangeIxs rewardXPub prefix Map.empty multiPool
 
 insertAddressPool
     :: forall n k c. (PaymentAddress n k, Typeable c)

lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs

@@ -15,6 +15,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 -- |
 -- Copyright: © 2018-2020 IOHK
 -- License: Apache-2.0
@@ -47,6 +49,11 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , lookupAddress
     , shrinkPool
 
+    -- ** Verification Keys
+    , VerificationKeyPool (..)
+    , mkVerificationKeyPool
+    , toVerKeyHash
+
     -- * Pending Change Indexes
     , PendingIxs
     , emptyPendingIxs
@@ -69,8 +76,10 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Sequential
 
 import Prelude
 
+import Cardano.Address.Derivation
+    ( xpubPublicKey )
 import Cardano.Address.Script
-    ( ScriptHash )
+    ( KeyHash (..), ScriptHash )
 import Cardano.Crypto.Wallet
     ( XPrv, XPub )
 import Cardano.Wallet.Primitive.AddressDerivation
@@ -112,6 +121,8 @@ import Control.DeepSeq
     ( NFData, deepseq )
 import Control.Monad
     ( unless )
+import Crypto.Hash.Utils
+    ( blake2b224 )
 import Data.Bifunctor
     ( first )
 import Data.Digest.CRC32
@@ -122,12 +133,16 @@ import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Map.Strict
     ( Map )
+import Data.Maybe
+    ( fromJust )
 import Data.Proxy
     ( Proxy (..) )
 import Data.Text.Class
     ( FromText (..), TextDecodingError (..), ToText (..) )
 import Data.Text.Read
     ( decimal )
+import Data.Typeable
+    ( cast )
 import Data.Typeable
     ( Typeable, typeRep )
 import Data.Word
@@ -260,6 +275,74 @@ instance ((PersistPublicKey (key 'AccountK)), Typeable chain)
         xpubF = hexF $ serializeXPub acct
         acctF = prefixF 8 xpubF <> "..." <> suffixF 8 xpubF
 
+data VerificationKeyPool (key :: Depth -> * -> *) = VerificationKeyPool {
+      accountXPub
+        :: !(key 'AccountK XPub)
+    -- ^ Corresponding key for the pool (a pool is tied to only one account)
+    , keyNum
+        :: !AddressPoolGap
+    -- ^ The actual gap for the pool. This can't change for a given pool.
+    , indexedVerKeys
+        :: !(Map KeyHash (Index 'Soft 'ScriptK, AddressState))
+    } deriving (Generic)
+
+deriving instance (Show (key 'AccountK XPub))
+    => Show (VerificationKeyPool key)
+
+deriving instance (Eq (key 'AccountK XPub))
+    => Eq (VerificationKeyPool key)
+
+instance (NFData (key 'AccountK XPub))
+    => NFData (VerificationKeyPool key)
+
+instance ((PersistPublicKey (key 'AccountK)))
+    => Buildable (VerificationKeyPool key) where
+    build (VerificationKeyPool acct (AddressPoolGap g) _) = mempty
+       <> ccF <> " " <> acctF <> " (gap=" <> build g <> ")\n"
+      where
+        ccF = build $ toText MultisigScript
+        xpubF = hexF $ serializeXPub acct
+        acctF = prefixF 8 xpubF <> "..." <> suffixF 8 xpubF
+
+instance Ord KeyHash where
+    compare (KeyHash kh1) (KeyHash kh2) =
+        compare kh1 kh2
+
+toVerKeyHash
+    :: WalletKey k
+    => k 'AddressK XPub
+    -> KeyHash
+toVerKeyHash = KeyHash . blake2b224 . xpubPublicKey . getRawKey
+
+-- | Create a new VerificationKey pool.
+-- The extension to the pool is done by adding next adjacent indices,
+-- marking them as unused and their corresponding public keys.
+--
+mkVerificationKeyPool
+    :: (SoftDerivation k, WalletKey k)
+    => k 'AccountK XPub
+    -> AddressPoolGap
+    -> Map KeyHash (Index 'Soft 'ScriptK, AddressState)
+    -> VerificationKeyPool k
+mkVerificationKeyPool accXPub num@(AddressPoolGap g) vkPoolMap = VerificationKeyPool
+    { accountXPub = accXPub
+    , keyNum = num
+    , indexedVerKeys =
+            Map.union vkPoolMap vkPoolMap'
+    }
+  where
+    minIndex = fromIntegral $ toInteger $ getIndex @'Soft minBound
+    firstIndexToAdd = minIndex + L.length (Map.keys vkPoolMap)
+    deriveScriptXPub = deriveAddressPublicKey accXPub MultisigScript
+    deriveVerKeyH = toVerKeyHash . deriveScriptXPub
+    toIndex = toEnum . fromInteger . toInteger
+    indices =
+        [firstIndexToAdd .. (firstIndexToAdd + (fromInteger $ toInteger g) - 1)]
+    vkPoolMap' =
+        Map.fromList $
+        map (\ix -> (deriveVerKeyH (toIndex ix), (fromJust $ cast $ toIndex ix, Unused) ) )
+        indices
+
 -- | Bring a 'Role' type back to the term-level. This requires a type
 -- application and either a scoped type variable, or an explicit passing of a
 -- 'Role'.
@@ -572,6 +655,7 @@ data SeqState (n :: NetworkDiscriminant) k = SeqState
         -- ^ Derivation path prefix from a root key up to the internal account
     , knownScripts :: !(Map ScriptHash [k 'ScriptK XPub])
         -- ^ Known script hashes that contain our verification key hashes
+    , multisigPool :: !(VerificationKeyPool k)
     }
     deriving stock (Generic)
 
@@ -591,10 +675,11 @@ instance
     => NFData (SeqState n k)
 
 instance PersistPublicKey (k 'AccountK) => Buildable (SeqState n k) where
-    build (SeqState intP extP chgs _ path _) = "SeqState:\n"
+    build (SeqState intP extP chgs _ path _ multiP) = "SeqState:\n"
         <> indentF 4 ("Derivation prefix: " <> build (toText path))
         <> indentF 4 (build intP)
         <> indentF 4 (build extP)
+        <> indentF 4 (build multiP)
         <> indentF 4 ("Change indexes: " <> indentF 4 chgsF)
       where
         chgsF = blockListF' "-" build (pendingIxsToList chgs)
@@ -659,18 +744,22 @@ mkSeqStateFromRootXPrv (rootXPrv, pwd) purpose g =
             mkAddressPool @n (publicKey accXPrv) g []
         intPool =
             mkAddressPool @n (publicKey accXPrv) g []
-        scripts = Map.empty
+        scripts =
+            Map.empty
+        multiPool =
+            mkVerificationKeyPool (publicKey accXPrv) g Map.empty
         prefix =
             DerivationPrefix ( purpose, coinTypeAda, minBound )
     in
-        SeqState intPool extPool emptyPendingIxs rewardXPub prefix scripts
+        SeqState intPool extPool emptyPendingIxs rewardXPub prefix scripts multiPool
 
 -- | Construct a Sequential state for a wallet from public account key.
 mkSeqStateFromAccountXPub
     :: forall (n :: NetworkDiscriminant) k.
         ( SoftDerivation k
         , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
         , MkKeyFingerprint k Address
+        , WalletKey k
         )
     => k 'AccountK XPub
     -> Index 'Hardened 'PurposeK
@@ -686,11 +775,14 @@ mkSeqStateFromAccountXPub accXPub purpose g =
             mkAddressPool @n accXPub g []
         intPool =
             mkAddressPool @n accXPub g []
-        scripts = Map.empty
+        scripts =
+            Map.empty
+        multiPool =
+            mkVerificationKeyPool accXPub g Map.empty
         prefix =
             DerivationPrefix ( purpose, coinTypeAda, minBound )
     in
-        SeqState intPool extPool emptyPendingIxs rewardXPub prefix scripts
+        SeqState intPool extPool emptyPendingIxs rewardXPub prefix scripts multiPool
 
 -- NOTE
 -- We have to scan both the internal and external chain. Note that, the
@@ -703,7 +795,7 @@ instance
     , MkKeyFingerprint k Address
     ) => IsOurs (SeqState n k) Address
   where
-    isOurs addr (SeqState !s1 !s2 !ixs !rpk !prefix !scripts) =
+    isOurs addr (SeqState !s1 !s2 !ixs !rpk !prefix !scripts !s3) =
         let
             DerivationPrefix (purpose, coinType, accountIx) = prefix
             (internal, !s1') = lookupAddress @n (const Used) addr s1
@@ -732,7 +824,7 @@ instance
 
                 _ -> Nothing
         in
-            (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs' rpk prefix scripts)
+            (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs' rpk prefix scripts s3)
 
 instance
     ( SoftDerivation k
@@ -746,14 +838,14 @@ instance
     type ArgGenChange (SeqState n k) =
         (k 'AddressK XPub -> k 'AddressK XPub -> Address)
 
-    genChange mkAddress (SeqState intPool extPool pending rpk path scripts) =
+    genChange mkAddress (SeqState intPool extPool pending rpk path scripts multiPool) =
         let
             (ix, pending') = nextChangeIndex intPool pending
-            accountXPub = accountPubKey intPool
-            addressXPub = deriveAddressPublicKey accountXPub UtxoInternal ix
+            accountXPub' = accountPubKey intPool
+            addressXPub = deriveAddressPublicKey accountXPub' UtxoInternal ix
             addr = mkAddress addressXPub rpk
         in
-            (addr, SeqState intPool extPool pending' rpk path scripts)
+            (addr, SeqState intPool extPool pending' rpk path scripts multiPool)
 
 instance
     ( IsOurs (SeqState n k) Address
@@ -763,7 +855,7 @@ instance
     , AddressIndexDerivationType k ~ 'Soft
     )
     => IsOwned (SeqState n k) k where
-    isOwned (SeqState !s1 !s2 _ _ _ _) (rootPrv, pwd) addr =
+    isOwned (SeqState !s1 !s2 _ _ _ _ _) (rootPrv, pwd) addr =
         let
             xPrv1 = lookupAndDeriveXPrv s1
             xPrv2 = lookupAndDeriveXPrv s2
@@ -789,7 +881,7 @@ instance
     , MkKeyFingerprint k Address
     , SoftDerivation k
     ) => CompareDiscovery (SeqState n k) where
-    compareDiscovery (SeqState !s1 !s2 _ _ _ _) a1 a2 =
+    compareDiscovery (SeqState !s1 !s2 _ _ _ _ _) a1 a2 =
         case (ix a1 s1 <|> ix a1 s2, ix a2 s1 <|> ix a2 s2) of
             (Nothing, Nothing) -> EQ
             (Nothing, Just _)  -> GT

lib/core/src/Cardano/Wallet/Primitive/Scripts.hs

@@ -22,13 +22,10 @@
 module Cardano.Wallet.Primitive.Scripts
     ( isShared
     , retrieveAllVerKeyHashes
-    , toKeyHash
     ) where
 
 import Prelude
 
-import Cardano.Address.Derivation
-    ( xpubPublicKey )
 import Cardano.Address.Script
     ( KeyHash (..), Script (..), ScriptHash (..), toScriptHash )
 import Cardano.Crypto.Wallet
@@ -44,9 +41,7 @@ import Cardano.Wallet.Primitive.AddressDerivation
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
     ( ShelleyKey (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( SeqState (..), accountPubKey )
-import Crypto.Hash.Utils
-    ( blake2b224 )
+    ( SeqState (..), accountPubKey, toVerKeyHash )
 
 import qualified Data.List as L
 import qualified Data.Map.Strict as Map
@@ -61,7 +56,7 @@ isShared
     => Script
     -> SeqState n k
     -> ([k 'ScriptK XPub], SeqState n k)
-isShared script s@(SeqState !s1 !s2 !ixs !rpk !prefix !scripts) =
+isShared script s@(SeqState !s1 !s2 !ixs !rpk !prefix !scripts !s3) =
     let verKeysInScript = retrieveAllVerKeyHashes script
         accXPub = accountPubKey s2
         toVerKey = deriveAddressPublicKey accXPub MultisigScript
@@ -71,15 +66,15 @@ isShared script s@(SeqState !s1 !s2 !ixs !rpk !prefix !scripts) =
             map (\ix -> toVerKey (toEnum (fromInteger $ toInteger $ minIndex + ix)))
             [0 .. scriptAddressGap]
         ourVerKeyHashesInScript =
-            filter (\keyH -> toKeyHash keyH `elem` verKeysInScript)
+            filter (\keyH -> toVerKeyHash keyH `elem` verKeysInScript)
             ourVerKeys
         toScriptXPub (ShelleyKey k) = ShelleyKey k
         scriptXPubs = L.nub $ map toScriptXPub ourVerKeyHashesInScript
     in if null ourVerKeyHashesInScript then
         ([], s)
        else
         ( scriptXPubs
-        , SeqState s1 s2 ixs rpk prefix (Map.insert (toScriptHash script) scriptXPubs scripts))
+        , SeqState s1 s2 ixs rpk prefix (Map.insert (toScriptHash script) scriptXPubs scripts) s3)
 
 retrieveAllVerKeyHashes :: Script -> [KeyHash]
 retrieveAllVerKeyHashes = extractVerKey []
@@ -88,6 +83,3 @@ retrieveAllVerKeyHashes = extractVerKey []
       extractVerKey acc (RequireAllOf xs) = foldr (flip extractVerKey) acc xs
       extractVerKey acc (RequireAnyOf xs) = foldr (flip extractVerKey) acc xs
       extractVerKey acc (RequireSomeOf _ xs) = foldr (flip extractVerKey) acc xs
-
-toKeyHash :: ShelleyKey depth XPub -> KeyHash
-toKeyHash = KeyHash . blake2b224 . xpubPublicKey . getKey