cardano-foundation · iohk-bors · May 7, 2021 · Mar 12, 2021 · May 7, 2021
diff --git a/lib/core-integration/src/Test/Integration/Faucet.hs b/lib/core-integration/src/Test/Integration/Faucet.hs
@@ -31,7 +31,6 @@ module Test.Integration.Faucet
 
       -- * Internals
     , genByronFaucets
-    , genIcarusFaucets
     , genShelleyFaucets
     , genMAFaucets
     , genMnemonics
@@ -2014,31 +2013,21 @@ genByronFaucets = genFaucet encodeAddress genAddresses
             | ix <- [minBound..maxBound]
             ]
 
--- | Generate faucet addresses and mnemonics to a file.
---
--- >>> genMnemonics 100 >>= genIcarusFaucets "icarus-faucets.yaml"
-genIcarusFaucets :: FilePath -> [Mnemonic 15] -> IO  [[Text]]
-genIcarusFaucets = genFaucet encodeAddress genAddresses
-  where
-    encodeAddress :: Address -> Text
-    encodeAddress (Address bytes) =
-        T.decodeUtf8 $ encodeBase58 bitcoinAlphabet bytes
-
-    genAddresses :: Mnemonic 15 -> [Address]
-    genAddresses mw =
-        let
-            (seed, pwd) =
-                (SomeMnemonic mw, mempty)
-            rootXPrv =
-                Icarus.generateKeyFromSeed seed pwd
-            accXPrv =
-                deriveAccountPrivateKey pwd rootXPrv minBound
-            addrXPrv =
-                deriveAddressPrivateKey pwd accXPrv UtxoExternal
-        in
-            [ paymentAddress @'Mainnet $ publicKey $ addrXPrv ix
-            | ix <- [minBound..maxBound]
-            ]
+icaAddresses :: Mnemonic 15 -> [Address]
+icaAddresses mw =
+    let
+        (seed, pwd) =
+            (SomeMnemonic mw, mempty)
+        rootXPrv =
+            Icarus.generateKeyFromSeed seed pwd
+        accXPrv =
+            deriveAccountPrivateKey pwd rootXPrv minBound
+        addrXPrv =
+            deriveAddressPrivateKey pwd accXPrv UtxoExternal
+    in
+        [ paymentAddress @'Mainnet $ publicKey $ addrXPrv ix
+        | ix <- [minBound..maxBound]
+        ]
 
 -- | Generate faucet addresses and mnemonics to a file.
 --
@@ -2147,6 +2136,8 @@ shelleyIntegrationTestFunds :: [(Address, Coin)]
 shelleyIntegrationTestFunds = mconcat
     [ seqMnemonics >>= take 10 . map (, defaultAmt) . addresses . SomeMnemonic
 
+    , icaMnemonics >>= take 10 . map (, defaultAmt) . icaAddresses
+
     , zip
          (addresses $ SomeMnemonic onlyDustWallet)
          (map Coin

diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs
@@ -444,30 +444,6 @@ spec = describe "BYRON_TRANSACTIONS" $ do
             , expectErrorMessage (errMsg404NoWallet wid)
             ]
 
-    it "BYRON_RESTORE_08 - Icarus wallet with high indexes" $ \ctx -> runResourceT $ do
-        -- NOTE
-        -- Special Icarus mnemonic where address indexes are all after the index
-        -- 500. Because we don't have the whole history, restoring sequential
-        -- wallets like Icarus ones is tricky from just a snapshot and we need
-        -- to use arbitrarily big address pool gaps.
-        let mnemonics =
-                [ "erosion", "ahead", "vibrant", "air", "day"
-                , "timber", "thunder", "general", "dice", "into"
-                , "chest", "enrich", "social", "neck", "shine"
-                ] :: [T.Text]
-        let payload = Json [json| {
-                    "name": "High Index Wallet",
-                    "mnemonic_sentence": #{mnemonics},
-                    "passphrase": #{fixturePassphrase},
-                    "style": "icarus"
-                    } |]
-
-        r <- postByronWallet ctx payload
-        verify r
-            [ expectResponseCode HTTP.status201
-            , expectField (#balance . #available) (`shouldBe` Quantity faucetAmt)
-            ]
-
     it "BYRON_RESTORE_09 - Ledger wallet" $ \ctx -> runResourceT $ do
         -- NOTE
         -- Special legacy wallets where addresses have been generated from a
@@ -500,16 +476,23 @@ spec = describe "BYRON_TRANSACTIONS" $ do
                 , expectListSize 0
                 ]
 
-    it "BYRON_TX_LIST_01 - Can list transactions on Byron Wallet"
-        $ \ctx -> runResourceT @IO $ forM_ [fixtureRandomWallet, fixtureIcarusWallet]
-        $ \fixtureByronWallet -> do
-            w <- fixtureByronWallet ctx
-            let link = Link.listTransactions @'Byron w
-            r <- request @([ApiTransaction n]) ctx link Default Empty
-            verify r
-                [ expectResponseCode HTTP.status200
-                , expectListSize 10
-                ]
+    it "BYRON_TX_LIST_01 - Can list transactions on Byron Wallet" $ \ctx -> runResourceT @IO $ do
+        w <- fixtureRandomWallet ctx
+        let link = Link.listTransactions @'Byron w
+        r <- request @([ApiTransaction n]) ctx link Default Empty
+        verify r
+            [ expectResponseCode HTTP.status200
+            , expectListSize 10
+            ]
+
+    it "BYRON_TX_LIST_01 - Can list transactions on Icarus Wallet" $ \ctx -> runResourceT @IO $ do
+        w <- fixtureIcarusWallet ctx
+        let link = Link.listTransactions @'Byron w
+        r <- request @([ApiTransaction n]) ctx link Default Empty
+        verify r
+            [ expectResponseCode HTTP.status200
+            , expectListSize 1 -- Now funded through a tx in the cluster setup
+            ]
 
     describe "BYRON_TX_LIST_01 - Faulty start, end, order values" $ do
         let orderErr = "Please specify one of the following values:\

diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -260,9 +260,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , defaultAddressPoolGap
     , derivationPrefix
     , mkSeqStateFromRootXPrv
-    , mkUnboundedAddressPoolGap
     , purposeBIP44
-    , shrinkPool
     )
 import Cardano.Wallet.Primitive.AddressDiscovery.SharedState
     ( ErrAddCosigner (..), SharedState, addCosignerAccXPub )
@@ -645,17 +643,9 @@ createIcarusWallet
     -> (k 'RootK XPrv, Passphrase "encryption")
     -> ExceptT ErrWalletAlreadyExists IO WalletId
 createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
-    let s = mkSeqStateFromRootXPrv @n credentials purposeBIP44 $
-            mkUnboundedAddressPoolGap 10000
-    let (hist, cp) = initWallet block0 s
-    let addrs = map (view #address) . concatMap (view #outputs . fst) $ hist
     let g  = defaultAddressPoolGap
-    let s' = Seq.SeqState
-            (shrinkPool @n (liftPaymentAddress @n) addrs g (Seq.internalPool s))
-            (shrinkPool @n (liftPaymentAddress @n) addrs g (Seq.externalPool s))
-            (Seq.pendingChangeIxs s)
-            (Seq.rewardAccountKey s)
-            (Seq.derivationPrefix s)
+    let s = mkSeqStateFromRootXPrv @n credentials purposeBIP44 g
+    let (hist, cp) = initWallet block0 s
     now <- lift getCurrentTime
     let meta = WalletMetadata
             { name = wname
@@ -664,7 +654,7 @@ createIcarusWallet ctx wid wname credentials = db & \DBLayer{..} -> do
             , delegation = WalletDelegation NotDelegating []
             }
     mapExceptT atomically $
-        initializeWallet wid (updateState s' cp) meta hist gp $> wid
+        initializeWallet wid (updateState s cp) meta hist gp $> wid
   where
     db = ctx ^. dbLayer @IO @s @k
     (block0, NetworkParameters gp _sp _pp, _) = ctx ^. genesisData

diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs
@@ -49,7 +49,6 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , context
     , mkAddressPool
     , lookupAddress
-    , shrinkPool
     , unsafePaymentKeyFingerprint
 
     -- * Pending Change Indexes
@@ -168,7 +167,6 @@ import Type.Reflection
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 
@@ -436,59 +434,6 @@ mkAddressPool ctx g addrs = AddressPool
         ]
     }
 
--- When discovering sequential wallets from a snapshot, we have to use
--- arbitrarily big pools for scanning the genesis block. However, keeping such
--- big pools with huge gaps makes for poor storage, memory and time performances.
--- So, once the genesis block has been scanned, we try to shrink the pool back
--- to something sensible.
-shrinkPool
-    :: forall (n :: NetworkDiscriminant) c key.
-        ( Typeable c
-        , MkKeyFingerprint key Address
-        , MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
-        , SoftDerivation key
-        , Typeable n
-        )
-    => (KeyFingerprint "payment" key -> Address)
-        -- ^ A way to lift fingerprint back into an 'Address'
-    -> [Address]
-        -- ^ A set of known addresses. Will shrink the pool down to the latest
-        -- known address from this list, while respecting the new gap.
-    -> AddressPoolGap
-        -- ^ A new address pool gap for this pool
-    -> AddressPool c key
-        -- ^ Original pool
-    -> AddressPool c key
-shrinkPool mkAddress knownAddrs newGap pool =
-    let
-        keys  = indexedKeys pool
-        maxV  = maximumValue
-            (unsafePaymentKeyFingerprint <$> knownAddrs)
-            (Map.map fst keys)
-        addrs = map (withAddressState . fst)
-            . L.sortOn (fst . snd)
-            . Map.toList
-            . Map.filter (\(v, _) -> Just v <= maxV)
-            $ keys
-    in
-        mkAddressPool @n (context pool) newGap addrs
-  where
-    withAddressState :: KeyFingerprint "payment" key -> (Address, AddressState)
-    withAddressState fingerprint =
-        (addr, if addr `elem` knownAddrs then Used else Unused)
-      where
-        addr = mkAddress fingerprint
-
-    maximumValue
-        :: (Ord k, Ord v)
-        => [k]
-        -> Map k v
-        -> Maybe v
-    maximumValue ks =
-        Map.foldl' keepHighest Nothing . (`Map.restrictKeys` (Set.fromList ks))
-      where
-        keepHighest highest v = if Just v > highest then Just v else highest
-
 -- | Lookup an address in the pool. When we find an address in a pool, the pool
 -- may be amended if the address was discovered near the edge. It is also
 -- possible that the pool is not amended at all - this happens in the case that

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs
@@ -71,7 +71,6 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , mkUnboundedAddressPoolGap
     , purposeCIP1852
     , role
-    , shrinkPool
     )
 import Cardano.Wallet.Primitive.Types
     ( ShowFmt (..) )
@@ -110,12 +109,10 @@ import Test.Hspec.Extra
 import Test.QuickCheck
     ( Arbitrary (..)
     , InfiniteList (..)
-    , Positive (..)
     , Property
     , arbitraryBoundedEnum
     , checkCoverage
     , choose
-    , classify
     , conjoin
     , counterexample
     , cover
@@ -177,10 +174,6 @@ spec = do
                     (property (prop_poolAtLeastGapAddresses (proxyS, proxyK)))
                 it "Our addresses are eventually discovered"
                     (property (prop_poolEventuallyDiscoverOurs (proxyS, proxyK)))
-                it "Known addresses are still in a shrunk pool"
-                    (property (prop_shrinkPreserveKnown (proxyS, proxyK)))
-                it "Last address from a shrunk is the last known"
-                    (property (prop_shrinkMaxIndex (proxyS, proxyK)))
 
     parallel $ describe "AddressPoolGap - Text Roundtrip" $ do
         textRoundtrip $ Proxy @AddressPoolGap
@@ -543,57 +536,6 @@ prop_oursAreUsed s =
         & label (show status)
         & counterexample (show (ShowFmt addr') <> ": " <> show status')
 
-{-------------------------------------------------------------------------------
-                        Properties for shrinkPool
--------------------------------------------------------------------------------}
-
--- Make sure that, for any cut we take from an existing pool, the addresses
--- from the cut are all necessarily in the pool.
-prop_shrinkPreserveKnown
-    :: forall (chain :: Role) k.
-        ( Typeable chain
-        , MkKeyFingerprint k (Proxy 'Mainnet, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , SoftDerivation k
-        , AddressPoolTest k
-        , GetPurpose k
-        )
-    => (Proxy chain, Proxy k)
-    -> Positive Int
-    -> AddressPool chain k
-    -> Property
-prop_shrinkPreserveKnown _proxy (Positive size) pool =
-    property
-        $ classify (length addrs' < length addrs) "pool is smaller"
-        $ all (`elem` addrs') cut
-  where
-    pool'  = shrinkPool @'Mainnet liftAddress cut minBound pool
-    addrs  = fst' <$> addresses liftAddress pool
-    addrs' = fst' <$> addresses liftAddress pool'
-    cut    = take size addrs
-
--- There's no address after the address from the cut with the highest index
-prop_shrinkMaxIndex
-    :: forall (chain :: Role) k.
-        ( Typeable chain
-        , MkKeyFingerprint k (Proxy 'Mainnet, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , SoftDerivation k
-        , AddressPoolTest k
-        , GetPurpose k
-        )
-    => (Proxy chain, Proxy k)
-    -> Positive Int
-    -> AddressPool chain k
-    -> Property
-prop_shrinkMaxIndex _proxy (Positive size) pool =
-    fromIntegral size > getAddressPoolGap minBound ==> last cut === last addrs'
-  where
-    pool'  = shrinkPool @'Mainnet liftAddress cut minBound pool
-    addrs  = fst' <$> addresses liftAddress pool
-    addrs' = fst' <$> addresses liftAddress pool'
-    cut    = take size addrs
-
 {-------------------------------------------------------------------------------
                                  Helpers
 -------------------------------------------------------------------------------}

diff --git a/lib/shelley/exe/local-cluster.hs b/lib/shelley/exe/local-cluster.hs
@@ -146,13 +146,6 @@ import qualified Data.Text as T
 --     , "omit", "time", "tiger", "leave", "load"
 --     ]
 --
--- - (Icarus) Has only addresses that start at index 500
---
---     [ "erosion", "ahead", "vibrant", "air", "day"
---     , "timber", "thunder", "general", "dice", "into"
---     , "chest", "enrich", "social", "neck", "shine"
---     ]
---
 -- - (Byron) Has only 5 UTxOs of 1,2,3,4,5 Lovelace
 --
 --     [ "suffer", "decorate", "head", "opera"