diff --git a/lib/core/bench/db-bench.hs b/lib/core/bench/db-bench.hs
index aa7c805c54a..3b0467d5aff 100644
--- a/lib/core/bench/db-bench.hs
+++ b/lib/core/bench/db-bench.hs
@@ -87,7 +87,6 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , Passphrase (..)
     , PaymentAddress (..)
     , PersistPrivateKey
-    , Role (..)
     , WalletKey (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation.Byron
@@ -97,14 +96,12 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley
 import Cardano.Wallet.Primitive.AddressDiscovery.Random
     ( DerivationPath, RndState (..), mkRndState )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( AddressPool
-    , DerivationPrefix (..)
-    , ParentContext (..)
+    ( DerivationPrefix (..)
+    , SeqAddressPool (..)
     , SeqState (..)
     , coinTypeAda
     , defaultAddressPoolGap
-    , emptyPendingIxs
-    , mkAddressPool
+    , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
     , purposeCIP1852
     )
@@ -179,6 +176,8 @@ import Data.Functor
     ( ($>) )
 import Data.Functor.Identity
     ( Identity (..) )
+import Data.List
+    ( foldl' )
 import Data.Map.Strict
     ( Map )
 import Data.Maybe
@@ -216,6 +215,7 @@ import UnliftIO.Temporary
 
 import qualified Cardano.BM.Configuration.Model as CM
 import qualified Cardano.BM.Data.BackendKind as CM
+import qualified Cardano.Wallet.Address.Pool as AddressPool
 import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
@@ -359,13 +359,7 @@ bgroupWriteSeqState db = bgroup "SeqState"
             pure cps
         cps :: [WalletBench]
         cps =
-            [ snd $ initWallet (withMovingSlot i block0) $
-                SeqState
-                    (mkIntPool a i)
-                    (mkExtPool a i)
-                    emptyPendingIxs
-                    rewardAccount
-                    defaultPrefix
+            [ snd $ initWallet (withMovingSlot i block0) $ mkSeqState a i
             | i <- [1..n]
             ]
 
@@ -373,17 +367,18 @@ benchPutSeqState :: DBLayerBench -> [WalletBench] -> IO ()
 benchPutSeqState DBLayer{..} cps = do
     unsafeRunExceptT $ mapExceptT atomically $ mapM_ (putCheckpoint testWid) cps
 
-mkExtPool :: Int -> Int -> AddressPool  'UtxoExternal ShelleyKey
-mkExtPool numAddrs i =
-    mkAddressPool @'Mainnet (ParentContextUtxo ourAccount) defaultAddressPoolGap addrs
-  where
-    addrs = [ force (mkAddress i j, Unused) | j <- [1..numAddrs] ]
-
-mkIntPool :: Int -> Int -> AddressPool 'UtxoInternal ShelleyKey
-mkIntPool numAddrs i =
-    mkAddressPool @'Mainnet (ParentContextUtxo ourAccount) defaultAddressPoolGap addrs
+mkSeqState :: Int -> Int -> SeqState 'Mainnet ShelleyKey
+mkSeqState numAddrs _ = s 
+    { internalPool = fillPool (internalPool s)
+    , externalPool = fillPool (externalPool s)
+    }
   where
-    addrs = [ force (mkAddress i j, Unused) | j <- [1..numAddrs] ]
+    s = mkSeqStateFromAccountXPub @'Mainnet
+        ourAccount purposeCIP1852 defaultAddressPoolGap
+    fillPool (SeqAddressPool pool0) = SeqAddressPool $
+        foldl' (\p ix -> AddressPool.update (gen ix) p) pool0 [0 .. numAddrs-1]
+      where
+        gen ix = AddressPool.generator pool0 $ toEnum ix
 
 ----------------------------------------------------------------------------
 -- Wallet State (Random Scheme) Benchmarks
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
index 523d971b662..92e0c78ba4d 100644
--- a/lib/core/src/Cardano/Wallet.hs
+++ b/lib/core/src/Cardano/Wallet.hs
@@ -737,6 +737,7 @@ createIcarusWallet
         , PaymentAddress n k
         , k ~ IcarusKey
         , s ~ SeqState n k
+        , Typeable n
         )
     => ctx
     -> WalletId
diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
index f3968e23598..f8ad4f434c1 100644
--- a/lib/core/src/Cardano/Wallet/Api/Server.hs
+++ b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -352,6 +352,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( DerivationPrefix (..)
     , SeqState (..)
     , defaultAddressPoolGap
+    , getGap
     , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
     , purposeCIP1852
@@ -748,7 +749,6 @@ postWallet
         , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
         , MkKeyFingerprint k Address
         , WalletKey k
-        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
         , HasDBFactory s k ctx
         , HasWorkerRegistry s k ctx
         , IsOurs s RewardAccount
@@ -776,7 +776,6 @@ postShelleyWallet
         , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
         , MkKeyFingerprint k Address
         , WalletKey k
-        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
         , HasDBFactory s k ctx
         , HasWorkerRegistry s k ctx
         , IsOurs s RewardAccount
@@ -816,6 +815,7 @@ postAccountWallet
         , HasWorkerRegistry s k ctx
         , IsOurs s RewardAccount
         , (k == SharedKey) ~ 'False
+        , Typeable n
         )
     => ctx
     -> MkApiWallet ctx s w
@@ -873,7 +873,7 @@ mkShelleyWallet ctx wid cp meta pending progress = do
     let available = availableBalance pending cp
     let total = totalBalance pending reward cp
     pure ApiWallet
-        { addressPoolGap = ApiT $ getState cp ^. #externalPool . #gap
+        { addressPoolGap = ApiT $ getGap $ getState cp ^. #externalPool
         , balance = ApiWalletBalance
             { available = coinToQuantity (available ^. #coin)
             , total = coinToQuantity (total ^. #coin)
@@ -1269,6 +1269,7 @@ postIcarusWallet
         , k ~ IcarusKey
         , HasWorkerRegistry s k ctx
         , PaymentAddress n IcarusKey
+        , Typeable n
         )
     => ctx
     -> ByronWalletPostData '[12,15,18,21,24]
@@ -1289,6 +1290,7 @@ postTrezorWallet
         , k ~ IcarusKey
         , HasWorkerRegistry s k ctx
         , PaymentAddress n IcarusKey
+        , Typeable n
         )
     => ctx
     -> ByronWalletPostData '[12,15,18,21,24]
@@ -1309,6 +1311,7 @@ postLedgerWallet
         , k ~ IcarusKey
         , HasWorkerRegistry s k ctx
         , PaymentAddress n IcarusKey
+        , Typeable n
         )
     => ctx
     -> ByronWalletPostData '[12,15,18,21,24]
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/AddressBook.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/AddressBook.hs
index 1e844c786f1..0fa097fb2b7 100644
--- a/lib/core/src/Cardano/Wallet/DB/Sqlite/AddressBook.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Sqlite/AddressBook.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -18,30 +17,21 @@ module Cardano.Wallet.DB.Sqlite.AddressBook
     ( AddressBookIso (..)
     , Prologue (..)
     , Discoveries (..)
-    , SeqAddressList (..)
+    , SeqAddressMap (..)
     )
   where
 
 import Prelude
 
-import Cardano.Address.Derivation
-    ( XPub )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (..)
     , DerivationType (..)
     , Index (..)
     , KeyFingerprint (..)
-    , MkKeyFingerprint (..)
-    , MkKeyFingerprint (..)
-    , NetworkDiscriminant (..)
-    , PaymentAddress (..)
     , Role (..)
-    , SoftDerivation (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
     ( SharedKey (..) )
-import Cardano.Wallet.Primitive.AddressDiscovery
-    ( GetPurpose )
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..), AddressState (..) )
 import Data.Generics.Internal.VL
@@ -50,18 +40,13 @@ import Data.Kind
     ( Type )
 import Data.Map.Strict
     ( Map )
-import Data.Proxy
-    ( Proxy (..) )
 import Data.Type.Equality
     ( type (==) )
-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
-import qualified Cardano.Wallet.Primitive.Types.Address as W
 import qualified Data.Map.Strict as Map
 
 {-------------------------------------------------------------------------------
@@ -83,9 +68,6 @@ class AddressBookIso s where
 {-------------------------------------------------------------------------------
     Sequential address book
 -------------------------------------------------------------------------------}
--- | Sequential list of addresses
-newtype SeqAddressList (c :: Role) = SeqAddressList [(W.Address, W.AddressState)]
-
 -- piggy-back on SeqState existing instance, to simulate the same behavior.
 instance AddressBookIso (Seq.SeqState n k)
     => AddressBookIso (Seq.SeqAnyState n k p)
@@ -99,56 +81,47 @@ instance AddressBookIso (Seq.SeqState n k)
         in  iso from2 to2
 
 -- | Isomorphism for sequential address book.
-instance 
-    ( MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
-    , GetPurpose key
-    , SoftDerivation key
-    , PaymentAddress n key
-    , (key == SharedKey) ~ 'False
-    ) => AddressBookIso (Seq.SeqState n key)
+instance ( (key == SharedKey) ~ 'False ) => AddressBookIso (Seq.SeqState n key)
   where
     data Prologue (Seq.SeqState n key)
         = SeqPrologue (Seq.SeqState n key)
         -- Trick: We keep the type, but we empty the discovered addresses
     data Discoveries (Seq.SeqState n key)
         = SeqDiscoveries
-            (SeqAddressList 'UtxoInternal)
-            (SeqAddressList 'UtxoExternal)
+            (SeqAddressMap 'UtxoInternal key)
+            (SeqAddressMap 'UtxoExternal key)
 
     addressIso = iso from to
       where
-        from (Seq.SeqState int ext a b c) =
-            ( SeqPrologue $ Seq.SeqState (emptyPool int) (emptyPool ext) a b c
-            , SeqDiscoveries (toDiscoveries @n int) (toDiscoveries @n ext)
-            )
-        to (SeqPrologue (Seq.SeqState int ext a b c), SeqDiscoveries ints exts)
-          = Seq.SeqState (fromDiscoveries @n int ints) (fromDiscoveries @n ext exts) a b c
-
--- | Extract the discovered addresses from an address pool.
-toDiscoveries
-    :: forall (n :: NetworkDiscriminant) (c :: Role) key.
-    ( GetPurpose key
-    , PaymentAddress n key
-    , Typeable c
-    ) => Seq.AddressPool c key -> SeqAddressList c
-toDiscoveries pool = SeqAddressList
-    [ (a,st) | (a,st,_) <- Seq.addresses (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 c
-    ) => Seq.AddressPool c key -> SeqAddressList c -> Seq.AddressPool c key
-fromDiscoveries ctx (SeqAddressList addrs) =
-    Seq.mkAddressPool @n (Seq.context ctx) (Seq.gap ctx) addrs
-
--- | Remove all discovered addresses from an address pool,
--- but keep context.
-emptyPool :: Seq.AddressPool c key -> Seq.AddressPool c key
-emptyPool pool = pool{ Seq.indexedKeys = Map.empty }
+        from (Seq.SeqState int ext a b c d) =
+            let int0 = clear int
+                ext0 = clear ext
+            in  ( SeqPrologue $ Seq.SeqState int0 ext0 a b c d
+                , SeqDiscoveries (addresses int) (addresses ext)
+                )
+        to (SeqPrologue (Seq.SeqState int0 ext0 a b c d), SeqDiscoveries ints exts)
+          = Seq.SeqState (loadUnsafe int0 ints) (loadUnsafe ext0 exts) a b c d
+
+-- | Address data from sequential address pool.
+-- The phantom type parameter @c@ prevents mixing up
+-- the internal with the external pool.
+newtype SeqAddressMap (c :: Role) (key :: Depth -> Type -> Type) = SeqAddressMap
+        ( Map
+            (KeyFingerprint "payment" key)
+            (Index 'Soft 'AddressK, AddressState)
+        )
+
+clear :: Seq.SeqAddressPool c k -> Seq.SeqAddressPool c k
+clear = Seq.SeqAddressPool . AddressPool.clear . Seq.getPool
+
+addresses :: Seq.SeqAddressPool c k -> SeqAddressMap c k
+addresses = SeqAddressMap . AddressPool.addresses . Seq.getPool
+
+loadUnsafe
+    :: Seq.SeqAddressPool c k
+    -> SeqAddressMap c k -> Seq.SeqAddressPool c k
+loadUnsafe (Seq.SeqAddressPool pool0) (SeqAddressMap addrs) =
+    Seq.SeqAddressPool $ AddressPool.loadUnsafe pool0 addrs
 
 {-------------------------------------------------------------------------------
     Shared key address book
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs
index 430d1697fc4..2af36d8f8d5 100644
--- a/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs
+++ b/lib/core/src/Cardano/Wallet/DB/Sqlite/CheckpointsOld.hs
@@ -54,7 +54,7 @@ import Cardano.Wallet.DB.Sqlite.AddressBook
     ( AddressBookIso (..)
     , Discoveries (..)
     , Prologue (..)
-    , SeqAddressList (..)
+    , SeqAddressMap (..)
     )
 import Cardano.Wallet.DB.Sqlite.TH
     ( Checkpoint (..)
@@ -91,16 +91,12 @@ import Cardano.Wallet.Primitive.AddressDerivation
     )
 import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
     ( SharedKey (..) )
-import Cardano.Wallet.Primitive.AddressDiscovery
-    ( GetPurpose )
 import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     ( CredentialType (..) )
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( TokenBundle )
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( AssetId (..) )
-import Cardano.Wallet.Util
-    ( invariant )
 import Control.Applicative
     ( Alternative )
 import Control.Monad
@@ -415,33 +411,22 @@ instance PersistAddressBook (Seq.SeqState n k)
     loadDiscoveries wid sl = DS <$> loadDiscoveries wid sl
 
 instance
-    ( Eq (key 'AccountK XPub)
-    , PersistPublicKey (key 'AccountK)
+    ( PersistPublicKey (key 'AccountK)
     , PersistPublicKey (key 'AddressK)
     , MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
-    , GetPurpose key
     , PaymentAddress n key
     , SoftDerivation key
+    , Typeable n
     , (key == SharedKey) ~ 'False
     ) => PersistAddressBook (Seq.SeqState n key) where
 
     insertPrologue wid (SeqPrologue st) = do
-        let (intPool, extPool) =
-                (Seq.internalPool st, Seq.externalPool st)
-        let (Seq.ParentContextUtxo accXPubInternal) = Seq.context intPool
-        let (Seq.ParentContextUtxo accXPubExternal) = Seq.context extPool
-        let (accountXPub, _) = invariant
-                "Internal & External pool use different account public keys!"
-                ( accXPubExternal, accXPubInternal )
-                (uncurry (==))
-        let eGap = Seq.gap extPool
-        let iGap = Seq.gap intPool
         repsert (SeqStateKey wid) $ SeqState
             { seqStateWalletId = wid
-            , seqStateExternalGap = eGap
-            , seqStateInternalGap = iGap
-            , seqStateAccountXPub = serializeXPub accountXPub
-            , seqStateRewardXPub = serializeXPub (Seq.rewardAccountKey st)
+            , seqStateExternalGap = Seq.getGap $ Seq.externalPool st
+            , seqStateInternalGap = Seq.getGap $ Seq.internalPool st
+            , seqStateAccountXPub = serializeXPub $ Seq.accountXPub st
+            , seqStateRewardXPub = serializeXPub $ Seq.rewardAccountKey st
             , seqStateDerivationPrefix = Seq.derivationPrefix st
             }
         deleteWhere [SeqStatePendingWalletId ==. wid]
@@ -449,33 +434,25 @@ instance
             insertMany_
             (mkSeqStatePendingIxs wid $ Seq.pendingChangeIxs st)
 
-    insertDiscoveries wid sl
-        (SeqDiscoveries (SeqAddressList ints) (SeqAddressList exts))
-      = do
-        void $ dbChunked insertMany_
-            [ SeqStateAddress wid sl addr ix UtxoInternal state
-            | (ix, (addr, state)) <- zip [0..] ints
-            ]
-        void $ dbChunked insertMany_
-            [ SeqStateAddress wid sl addr ix UtxoExternal state
-            | (ix, (addr, state)) <- zip [0..] exts
-            ]
+    insertDiscoveries wid sl (SeqDiscoveries ints exts) = do
+        insertSeqAddressMap @n wid sl ints
+        insertSeqAddressMap @n wid sl exts
 
     loadPrologue wid = runMaybeT $ do
         st <- MaybeT $ selectFirst [SeqStateWalletId ==. wid] []
         let SeqState _ eGap iGap accountBytes rewardBytes prefix = entityVal st
         let accountXPub = unsafeDeserializeXPub accountBytes
         let rewardXPub = unsafeDeserializeXPub rewardBytes
-        let intPool = Seq.mkAddressPool @n (Seq.ParentContextUtxo accountXPub) iGap []
-        let extPool = Seq.mkAddressPool @n (Seq.ParentContextUtxo accountXPub) eGap []
+        let intPool = Seq.newSeqAddressPool @n accountXPub iGap
+        let extPool = Seq.newSeqAddressPool @n accountXPub eGap
         pendingChangeIxs <- lift $ selectSeqStatePendingIxs wid
         pure $ SeqPrologue $
-            Seq.SeqState intPool extPool pendingChangeIxs rewardXPub prefix
+            Seq.SeqState intPool extPool pendingChangeIxs accountXPub rewardXPub prefix
 
     loadDiscoveries wid sl =
         SeqDiscoveries
-            <$> selectSeqAddressList wid sl
-            <*> selectSeqAddressList wid sl
+            <$> selectSeqAddressMap wid sl
+            <*> selectSeqAddressMap wid sl
 
 mkSeqStatePendingIxs :: W.WalletId -> Seq.PendingIxs -> [SeqStatePendingIx]
 mkSeqStatePendingIxs wid =
@@ -489,17 +466,34 @@ selectSeqStatePendingIxs wid =
   where
     fromRes = fmap (W.Index . seqStatePendingIxIndex . entityVal)
 
-selectSeqAddressList
-    :: forall c. Typeable c
-    => W.WalletId -> W.SlotNo -> SqlPersistT IO (SeqAddressList c)
-selectSeqAddressList wid sl = do
-    SeqAddressList . map (toPair . entityVal) <$> selectList
+insertSeqAddressMap
+    :: forall n c key. (PaymentAddress n key, Typeable c)
+    =>  W.WalletId -> W.SlotNo -> SeqAddressMap c key -> SqlPersistT IO ()
+insertSeqAddressMap wid sl (SeqAddressMap pool) = void $
+    dbChunked insertMany_
+        [ SeqStateAddress wid sl (liftPaymentAddress @n addr)
+            (W.getIndex ix) (Seq.role @c) status
+        | (addr, (ix, status)) <- Map.toList pool
+        ]
+
+-- MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
+selectSeqAddressMap :: forall (c :: Role) key.
+    ( MkKeyFingerprint key W.Address
+    , Typeable c
+    ) => W.WalletId -> W.SlotNo -> SqlPersistT IO (SeqAddressMap c key)
+selectSeqAddressMap wid sl = do
+    SeqAddressMap . Map.fromList . map (toTriple . entityVal) <$> selectList
         [ SeqStateAddressWalletId ==. wid
         , SeqStateAddressSlot ==. sl
         , SeqStateAddressRole ==. Seq.role @c
         ] [Asc SeqStateAddressIndex]
   where
-    toPair x = (seqStateAddressAddress x, seqStateAddressStatus x)
+    toTriple x =
+        ( Seq.unsafePaymentKeyFingerprint @key (seqStateAddressAddress x)
+        ,   ( toEnum $ fromIntegral $ seqStateAddressIndex x
+            , seqStateAddressStatus x
+            )
+        )
 
 {-------------------------------------------------------------------------------
     Shared key address book storage
diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs
index 4a1ad4c6859..1efcee06cde 100644
--- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs
+++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -7,6 +8,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -18,6 +20,9 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+-- We intentionally specify the constraint  (k == SharedKey) ~ 'False  
+-- in some exports.
 
 -- |
 -- Copyright: © 2018-2020 IOHK
@@ -42,14 +47,10 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     , mkUnboundedAddressPoolGap
 
     -- ** Address Pool
-    , AddressPool (indexedKeys)
-    , ParentContext (..)
-    , gap
-    , addresses
+    , SeqAddressPool (..)
     , role
-    , context
-    , mkAddressPool
-    , lookupAddress
+    , getGap
+    , newSeqAddressPool
     , unsafePaymentKeyFingerprint
 
     -- * Pending Change Indexes
@@ -96,9 +97,6 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , Role (..)
     , SoftDerivation (..)
     , WalletKey (..)
-    , deriveRewardAccount
-    , utxoExternal
-    , utxoInternal
     )
 import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
     ( SharedKey (..) )
@@ -106,7 +104,6 @@ import Cardano.Wallet.Primitive.AddressDiscovery
     ( CompareDiscovery (..)
     , GenChange (..)
     , GetAccount (..)
-    , GetPurpose (..)
     , IsOurs (..)
     , IsOwned (..)
     , KnownAddresses (..)
@@ -130,14 +127,10 @@ import Data.Bifunctor
     ( first )
 import Data.Digest.CRC32
     ( crc32 )
-import Data.Function
-    ( (&) )
 import Data.Kind
     ( Type )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
-import Data.Map.Strict
-    ( Map )
 import Data.Maybe
     ( fromMaybe )
 import Data.Proxy
@@ -163,12 +156,21 @@ import GHC.TypeLits
 import Type.Reflection
     ( Typeable, typeRep )
 
+import qualified Cardano.Wallet.Address.Pool as AddressPool
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 
+-- | Convenient constraint alias for commonly used class contexts on keys.
+type SupportsDiscovery n k =
+    ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
+    , MkKeyFingerprint k Address
+    , SoftDerivation k
+    , Typeable n
+    )
+
 {-------------------------------------------------------------------------------
                               Address Pool Gap
 -------------------------------------------------------------------------------}
@@ -239,58 +241,65 @@ defaultAddressPoolGap =
     AddressPoolGap 20
 
 {-------------------------------------------------------------------------------
-                                 Address Pool
+    Sequential address pools
 -------------------------------------------------------------------------------}
+-- | An address pool which keeps track of sequential addresses.
+-- To create a new pool, see 'newSeqAddressPool'.
+newtype SeqAddressPool (c :: Role) (key :: Depth -> Type -> Type) =
+    SeqAddressPool {
+        getPool ::
+            AddressPool.Pool
+                (KeyFingerprint "payment" key)
+                (Index 'Soft 'AddressK)
+    } deriving (Generic, Show)
 
-data ParentContext (chain :: Role) (key :: Depth -> Type -> Type) where
-    ParentContextUtxo
-        :: ((key == SharedKey) ~ 'False)
-        => key 'AccountK XPub
-        -> ParentContext chain key
-
-deriving instance Eq   (key 'AccountK XPub) => Eq   (ParentContext chain key)
-deriving instance Show (key 'AccountK XPub) => Show (ParentContext chain key)
-
-instance (WalletKey key, Typeable chain) => Buildable (ParentContext chain key) where
-    build (ParentContextUtxo acct) =
-        mempty <> "(ParentContext for "<> ccF <> " " <> build (accXPubTxt (getRawKey acct)) <>")"
-        where
-            ccF = build $ toText $ role @chain
+instance NFData (SeqAddressPool c k)
 
-instance NFData (key 'AccountK XPub) => NFData (ParentContext chain key) where
-    rnf = \case
-        ParentContextUtxo acct  -> rnf acct
+instance Buildable (SeqAddressPool c k) where
+    build (SeqAddressPool pool) = build pool
 
--- | An 'AddressPool' which keeps track of sequential addresses within a given
--- Account and change chain. See 'mkAddressPool' to create a new or existing
--- pool:
---
--- >>> mkAddressPool xpub gap role mempty
--- AddressPool { }
-data AddressPool
-    (chain :: Role)
-    (key :: Depth -> Type -> Type) = AddressPool
-    { context
-        :: ParentContext chain key
-        -- ^ Context of given address pool
-    , gap
-        :: !AddressPoolGap
-        -- ^ The actual gap for the pool. This can't change for a given pool.
-    , indexedKeys
-        :: !(Map
-                (KeyFingerprint "payment" key)
-                (Index 'Soft 'AddressK, AddressState)
+-- | Create a new Address pool from a list of addresses. Note that, the list is
+-- expected to be ordered in sequence (first indexes, first in the list).
+newSeqAddressPool
+    :: forall (n :: NetworkDiscriminant) c key.
+        ( SupportsDiscovery n key
+        , Typeable c
+        )
+    => key 'AccountK XPub
+    -> AddressPoolGap
+    -> SeqAddressPool c key
+newSeqAddressPool account g = SeqAddressPool $ AddressPool.new generator gap
+  where
+    gap = fromIntegral $ getAddressPoolGap g
+    generator ix =
+        unsafePaymentKeyFingerprint @key
+            ( Proxy @n
+            , deriveAddressPublicKey @key account (role @c) ix
             )
-    } deriving (Generic)
 
-deriving instance (Show (key 'AccountK XPub), Show (ParentContext chain key))
-    => Show (AddressPool chain key)
+getGap :: SeqAddressPool c k -> AddressPoolGap
+getGap = AddressPoolGap . fromIntegral . AddressPool.gap . getPool
 
-deriving instance (Eq (key 'AccountK XPub), Eq (ParentContext chain key))
-    => Eq (AddressPool chain key)
+-- Extract the fingerprint from an 'Address', we expect the caller to
+-- provide addresses that are compatible with the key scheme being used.
+--
+-- Actually, addresses passed as asgument should have been "generated" by
+-- the address pool itself in the past, so they ought to be valid!
+unsafePaymentKeyFingerprint
+    :: forall k from. (HasCallStack, MkKeyFingerprint k from)
+    => from
+    -> KeyFingerprint "payment" k
+unsafePaymentKeyFingerprint from = case paymentKeyFingerprint @k from of
+    Right a -> a
+    Left err -> error $ unwords
+        [ "unsafePaymentKeyFingerprint was given a source invalid with its"
+        , "key type:"
+        , show err
+        ]
 
-instance (NFData (key 'AccountK XPub), NFData (ParentContext chain key))
-    => NFData (AddressPool chain key)
+{-------------------------------------------------------------------------------
+    Pretty printing
+-------------------------------------------------------------------------------}
 
 instance PersistPublicKey (key 'AccountK) => Buildable (key 'AccountK XPub) where
     build key = prefixF 8 xpubF <> "..." <> suffixF 8 xpubF
@@ -320,12 +329,6 @@ instance Buildable ScriptTemplate where
         presentCosigners =
             Map.foldrWithKey (\c k acc -> acc <> "| " <> printCosigner c <> " " <> accXPubTxt k ) mempty
 
-instance (Typeable chain, WalletKey key) => Buildable (AddressPool chain key) where
-    build (AddressPool ctx (AddressPoolGap g) _) = mempty
-        <> ccF <> " " <> build ctx <> " (gap=" <> build g <> ")\n"
-      where
-        ccF = build $ toText $ role @chain
-
 -- | 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'.
@@ -352,148 +355,6 @@ role = fromMaybe (error $ "role: unmatched type" <> show (typeRep @c))
             Just Refl  -> Just MutableAccount
             Nothing -> Nothing
 
--- | Get all addresses in the pool, sorted from the first address discovered,
--- up until the next one.
---
--- In practice, we always have:
---
--- > mkAddressPool key g cc (addresses pool) == pool
-addresses
-    :: forall c k. (Typeable c, GetPurpose k)
-    => (KeyFingerprint "payment" k -> Address)
-    -> AddressPool c k
-    -> [(Address, AddressState, NonEmpty DerivationIndex)]
-addresses mkAddress =
-    map (\(k, (ix, st)) -> (mkAddress k, st, toDerivationPath ix))
-    . L.sortOn (fst . snd)
-    . Map.toList
-    . indexedKeys
-  where
-    toDerivationPath ix = NE.fromList $ map DerivationIndex
-        [ getIndex $ getPurpose @k
-        , getIndex coinTypeAda
-        , getIndex $ minBound @(Index 'Hardened 'AccountK)
-        , fromIntegral $ fromEnum $ role @c
-        , getIndex ix
-        ]
-
--- | Create a new Address pool from a list of addresses. Note that, the list is
--- expected to be ordered in sequence (first indexes, first in the list).
---
--- The pool will grow from the start if less than @g :: AddressPoolGap@ are
--- given, such that, there are always @g@ undiscovered addresses in the pool.
---
--- FIXME:
--- Don't construct from addresses but from fingerprints!
-mkAddressPool
-    :: forall (n :: NetworkDiscriminant) c k.
-        ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , SoftDerivation k
-        , Typeable c
-        )
-    => ParentContext c k
-    -> AddressPoolGap
-    -> [(Address, AddressState)]
-    -> AddressPool c k
-mkAddressPool ctx g addrs = AddressPool
-    { context = ctx
-    , gap = g
-    , indexedKeys = mconcat
-        [ Map.fromList $ zipWith (\(addr, status) ix -> (addr, (ix, status)))
-            (first (unsafePaymentKeyFingerprint @k) <$> addrs)
-            [minBound..maxBound]
-        , nextAddresses @n @c
-            ctx
-            g
-            minBound
-        ]
-    }
-
--- | 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
--- an address is discovered 'far' from the edge.
-lookupAddress
-    :: forall (n :: NetworkDiscriminant) c k.
-        ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , SoftDerivation k
-        , Typeable c
-        )
-    => (AddressState -> AddressState)
-    -> Address
-    -> AddressPool c k
-    -> (Maybe (Index 'Soft 'AddressK), AddressPool c k)
-lookupAddress alterSt !target !pool =
-    case paymentKeyFingerprint @k target of
-        Left _ ->
-            (Nothing, pool)
-        Right fingerprint ->
-            case Map.alterF lookupF fingerprint (indexedKeys pool) of
-                (Just ix, keys') ->
-                    ( Just ix
-                    , extendAddressPool @n ix (pool { indexedKeys = keys'})
-                    )
-                (Nothing, _) ->
-                    ( Nothing
-                    , pool
-                    )
-  where
-    lookupF = \case
-        Nothing -> (Nothing, Nothing)
-        Just (ix, st) -> (Just ix, Just (ix, alterSt st))
-
--- | If an address is discovered near the edge, we extend the address sequence,
--- otherwise we return the pool untouched.
-extendAddressPool
-    :: forall (n :: NetworkDiscriminant) c k.
-        ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , SoftDerivation k
-        , Typeable c
-        )
-    => Index 'Soft 'AddressK
-    -> AddressPool c k
-    -> AddressPool c k
-extendAddressPool !ix !pool
-    | isOnEdge  = pool { indexedKeys = indexedKeys pool <> next }
-    | otherwise = pool
-  where
-    edge = Map.size (indexedKeys pool)
-    isOnEdge = edge - fromEnum ix <= fromEnum (gap pool)
-    next = if ix == maxBound then mempty else nextAddresses @n @c
-        (context pool)
-        (gap pool)
-        (succ ix)
-
--- | Compute the pool extension from a starting index
-nextAddresses
-    :: forall (n :: NetworkDiscriminant) (c :: Role) k.
-        ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , SoftDerivation k
-        , Typeable c
-        )
-    => ParentContext c k
-    -> AddressPoolGap
-    -> Index 'Soft 'AddressK
-    -> Map (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
-nextAddresses !ctx (AddressPoolGap !g) !fromIx =
-    [fromIx .. min maxBound toIx]
-        & map (\ix -> (mkPaymentKey ix ctx, (ix, Unused)))
-        & Map.fromList
-  where
-    toIx = invariant
-        "nextAddresses: toIx should be greater than fromIx"
-        (toEnum $ fromEnum fromIx + fromEnum g - 1)
-        (>= fromIx)
-
-    mkPaymentKey ix = \case
-        ParentContextUtxo acct ->
-            unsafePaymentKeyFingerprint @k
-                ( Proxy @n
-                , deriveAddressPublicKey @k acct (role @c) ix
-                )
-
 {-------------------------------------------------------------------------------
                             Pending Change Indexes
 -------------------------------------------------------------------------------}
@@ -538,20 +399,20 @@ pendingIxsFromList = PendingIxs . reverse . map head . L.group . L.sort
 -- exchanges who care less about privacy / not-reusing addresses than
 -- regular users.
 nextChangeIndex
-    :: AddressPool c k
+    :: SeqAddressPool c k
     -> PendingIxs
     -> (Index 'Soft 'AddressK, PendingIxs)
-nextChangeIndex pool (PendingIxs ixs) =
+nextChangeIndex (SeqAddressPool pool) (PendingIxs ixs) =
     let
-        poolLen = Map.size (indexedKeys pool)
+        poolLen = AddressPool.size  pool
         (firstUnused, lastUnused) =
-            ( toEnum $ poolLen - fromEnum (gap pool)
+            ( toEnum $ poolLen - AddressPool.gap pool
             , toEnum $ poolLen - 1
             )
         (ix, ixs') = case ixs of
             [] ->
                 (firstUnused, PendingIxs [firstUnused])
-            h:_ | length ixs < fromEnum (gap pool) ->
+            h:_ | length ixs < AddressPool.gap pool ->
                 (succ h, PendingIxs (succ h:ixs))
             h:q ->
                 (h, PendingIxs (q++[h]))
@@ -559,25 +420,8 @@ nextChangeIndex pool (PendingIxs ixs) =
         invariant "index is within first unused and last unused" (ix, ixs')
             (\(i,_) -> i >= firstUnused && i <= lastUnused)
 
--- Extract the fingerprint from an 'Address', we expect the caller to
--- provide addresses that are compatible with the key scheme being used.
---
--- Actually, addresses passed as asgument should have been "generated" by
--- the address pool itself in the past, so they ought to be valid!
-unsafePaymentKeyFingerprint
-    :: forall k from. (HasCallStack, MkKeyFingerprint k from)
-    => from
-    -> KeyFingerprint "payment" k
-unsafePaymentKeyFingerprint from = case paymentKeyFingerprint @k from of
-    Right a -> a
-    Left err -> error $ unwords
-        [ "unsafePaymentKeyFingerprint was given a source invalid with its"
-        , "key type:"
-        , show err
-        ]
-
 {-------------------------------------------------------------------------------
-                                 State
+    SeqState
 -------------------------------------------------------------------------------}
 
 -- | A state to keep track of sequential addresses as described in
@@ -587,14 +431,16 @@ unsafePaymentKeyFingerprint from = case paymentKeyFingerprint @k from of
 -- parameterized by a type @n@ which captures a particular network discrimination.
 -- This enables the state to be agnostic to the underlying address format.
 data SeqState (n :: NetworkDiscriminant) k = SeqState
-    { internalPool :: !(AddressPool 'UtxoInternal k)
+    { internalPool :: !(SeqAddressPool 'UtxoInternal k)
         -- ^ Addresses living on the 'UtxoInternal'
-    , externalPool :: !(AddressPool 'UtxoExternal k)
+    , externalPool :: !(SeqAddressPool 'UtxoExternal k)
         -- ^ Addresses living on the 'UtxoExternal'
     , pendingChangeIxs :: !PendingIxs
         -- ^ Indexes from the internal pool that have been used in pending
         -- transactions. The list is maintained sorted in descending order
         -- (cf: 'PendingIxs')
+    , accountXPub :: k 'AccountK XPub
+        -- ^ The account public key associated with this state
     , rewardAccountKey :: k 'AddressK XPub
         -- ^ Reward account public key associated with this wallet
     , derivationPrefix :: DerivationPrefix
@@ -608,12 +454,6 @@ deriving instance
     , Show (KeyFingerprint "payment" k)
     ) => Show (SeqState n k)
 
-deriving instance
-    ( Eq (k 'AccountK XPub)
-    , Eq (k 'AddressK XPub)
-    , Eq (KeyFingerprint "payment" k)
-    ) => Eq (SeqState n k)
-
 instance
     ( NFData (k 'AccountK XPub)
     , NFData (k 'AddressK XPub)
@@ -621,14 +461,31 @@ instance
     )
     => NFData (SeqState n k)
 
-instance (WalletKey k) => Buildable (SeqState n k) where
-    build (SeqState intP extP chgs _ path) = "SeqState:\n"
-        <> indentF 4 ("Derivation prefix: " <> build (toText path))
-        <> indentF 4 (build intP)
-        <> indentF 4 (build extP)
+-- Hand-written, because 'AddressPool.Pool' is not an instance of 'Eq'.
+instance
+    ( Eq (k 'AccountK XPub)
+    , Eq (k 'AddressK XPub)
+    , Eq (KeyFingerprint "payment" k)
+    ) => Eq (SeqState n k)
+  where
+    SeqState ai ae a1 a2 a3 a4 == SeqState bi be b1 b2 b3 b4
+        = and
+            [a1 == b1, a2 == b2, a3 == b3, a4 == b4
+            , ae `match` be, ai `match` bi
+            ]
+      where
+        match (SeqAddressPool a) (SeqAddressPool b)
+            = AddressPool.addresses a == AddressPool.addresses b
+            && AddressPool.gap a == AddressPool.gap b
+
+instance Buildable (SeqState n k) where
+    build st = "SeqState:\n"
+        <> indentF 4 ("Derivation prefix: " <> build (toText (derivationPrefix st)))
+        <> indentF 4 (build $ internalPool st)
+        <> indentF 4 (build $ externalPool st)
         <> indentF 4 ("Change indexes: " <> indentF 4 chgsF)
       where
-        chgsF = blockListF' "-" build (pendingIxsToList chgs)
+        chgsF = blockListF' "-" build (pendingIxsToList $ pendingChangeIxs st)
 
 -- | Purpose is a constant set to 44' (or 0x8000002C) following the original
 -- BIP-44 specification.
@@ -655,100 +512,91 @@ purposeCIP1852 = toEnum 0x8000073c
 -- | Construct a Sequential state for a wallet from root private key and password.
 mkSeqStateFromRootXPrv
     :: forall n k.
-        ( SoftDerivation k
-        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , WalletKey k
-        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
+        ( WalletKey k
+        , SupportsDiscovery n k
         , (k == SharedKey) ~ 'False
         )
     => (k 'RootK XPrv, Passphrase "encryption")
     -> Index 'Hardened 'PurposeK
     -> AddressPoolGap
     -> SeqState n k
-mkSeqStateFromRootXPrv (rootXPrv, pwd) purpose g =
-    let
-        accXPrv =
-            deriveAccountPrivateKey pwd rootXPrv minBound
-        rewardXPub =
-            publicKey $ deriveRewardAccount pwd rootXPrv
-        extPool =
-            mkAddressPool @n (ParentContextUtxo $ publicKey accXPrv) g []
-        intPool =
-            mkAddressPool @n (ParentContextUtxo $ publicKey accXPrv) g []
-        prefix =
-            DerivationPrefix ( purpose, coinTypeAda, minBound )
-    in
-        SeqState intPool extPool emptyPendingIxs rewardXPub prefix
+mkSeqStateFromRootXPrv (rootXPrv, pwd) =
+    mkSeqStateFromAccountXPub $
+        publicKey $ deriveAccountPrivateKey pwd rootXPrv minBound
 
 -- | 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
+        ( SupportsDiscovery n k
         , (k == SharedKey) ~ 'False
         )
     => k 'AccountK XPub
     -> Index 'Hardened 'PurposeK
     -> AddressPoolGap
     -> SeqState n k
-mkSeqStateFromAccountXPub accXPub purpose g =
-    let
-        -- This matches the reward address for "normal wallets". The accountXPub
-        -- is the first account, minBound being the first Soft index
-        rewardXPub =
-            deriveAddressPublicKey accXPub MutableAccount minBound
-        extPool =
-            mkAddressPool @n (ParentContextUtxo accXPub) g []
-        intPool =
-            mkAddressPool @n (ParentContextUtxo accXPub) g []
-        prefix =
-            DerivationPrefix ( purpose, coinTypeAda, minBound )
-    in
-        SeqState intPool extPool emptyPendingIxs rewardXPub prefix
+mkSeqStateFromAccountXPub accXPub purpose g = SeqState
+    { internalPool = newSeqAddressPool @n accXPub g
+    , externalPool = newSeqAddressPool @n accXPub g
+    , accountXPub = accXPub
+    , rewardAccountKey = rewardXPub
+    , pendingChangeIxs = emptyPendingIxs
+    , derivationPrefix = DerivationPrefix ( purpose, coinTypeAda, minBound )
+    }
+  where
+    -- This matches the reward address for "normal wallets". The accountXPub
+    -- is the first account, minBound being the first Soft index
+    rewardXPub = deriveAddressPublicKey accXPub MutableAccount minBound
+
+-- | Decorate an index with the derivation prefix corresponding to the state.
+decoratePath
+    :: SeqState n k -> Role -> Index 'Soft 'AddressK
+    -> NE.NonEmpty DerivationIndex
+decoratePath SeqState{derivationPrefix} r ix = NE.fromList
+    [ DerivationIndex $ getIndex purpose
+    , DerivationIndex $ getIndex coinType
+    , DerivationIndex $ getIndex accountIx
+    , DerivationIndex $ fromIntegral $ fromEnum r
+    , DerivationIndex $ getIndex ix
+    ]
+  where
+    DerivationPrefix (purpose, coinType, accountIx) = derivationPrefix
 
 -- NOTE
 -- We have to scan both the internal and external chain. Note that, the
--- account discovery algorithm is only specified for the external chain so
--- in theory, there's nothing forcing a wallet to generate change
+-- BIP-44 account discovery algorithm is only specified for the external
+-- chain so in theory, there's nothing forcing a wallet to generate change
 -- addresses on the internal chain anywhere in the available range.
-instance
-    ( SoftDerivation k
-    , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-    , MkKeyFingerprint k Address
-    ) => IsOurs (SeqState n k) Address
-  where
-    isOurs addr (SeqState !s1 !s2 !ixs !rpk !prefix) =
-        let
-            DerivationPrefix (purpose, coinType, accountIx) = prefix
-            (internal, !s1') = lookupAddress @n (const Used) addr s1
-            (external, !s2') = lookupAddress @n (const Used) addr s2
-
-            !ixs' = case internal of
-                Nothing -> ixs
-                Just ix -> updatePendingIxs ix ixs
-
-            ours = case (external, internal) of
-                (Just addrIx, _) -> Just $ NE.fromList
-                    [ DerivationIndex $ getIndex purpose
-                    , DerivationIndex $ getIndex coinType
-                    , DerivationIndex $ getIndex accountIx
-                    , DerivationIndex $ getIndex utxoExternal
-                    , DerivationIndex $ getIndex addrIx
-                    ]
-
-                (_, Just addrIx) -> Just $ NE.fromList
-                    [ DerivationIndex $ getIndex purpose
-                    , DerivationIndex $ getIndex coinType
-                    , DerivationIndex $ getIndex accountIx
-                    , DerivationIndex $ getIndex utxoInternal
-                    , DerivationIndex $ getIndex addrIx
-                    ]
-
-                _ -> Nothing
-        in
-            (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs' rpk prefix)
+instance SupportsDiscovery n k => IsOurs (SeqState n k) Address where
+    isOurs addrRaw st@SeqState{pendingChangeIxs=ixs} =
+        -- FIXME LATER: Check that the network discrimant of the type
+        -- is compatible with the discriminant of the Address!
+        case paymentKeyFingerprint addrRaw of
+            Left _ -> (Nothing, st)
+            Right addr ->
+                let (internal, !int) = lookupAddress addr (internalPool st)
+                    (external, !ext) = lookupAddress addr (externalPool st)
+
+                    !ixs' = case internal of
+                        Nothing -> ixs
+                        Just ix -> updatePendingIxs ix ixs
+
+                    ours = case (external, internal) of
+                        (Just ix, _) -> Just $ decoratePath st UtxoExternal ix
+                        (_, Just ix) -> Just $ decoratePath st UtxoInternal ix
+                        _ -> Nothing
+                in
+                    ( ixs' `deepseq` ours `deepseq` ours
+                    , st
+                        { internalPool = int
+                        , externalPool = ext
+                        , pendingChangeIxs = ixs'
+                        }
+                    )
+      where
+        lookupAddress addr (SeqAddressPool pool) =
+            case AddressPool.lookup addr pool of
+                Nothing -> (Nothing, SeqAddressPool pool)
+                Just ix -> (Just ix, SeqAddressPool $ AddressPool.update addr pool)
 
 instance
     ( SoftDerivation k
@@ -761,97 +609,96 @@ instance
     -- See also: 'nextChangeIndex'
     type ArgGenChange (SeqState n k) =
         (k 'AddressK XPub -> k 'AddressK XPub -> Address)
-
-    genChange mkAddress (SeqState intPool extPool pending rpk path) =
-        let
-            (ix, pending') = nextChangeIndex intPool pending
-            ParentContextUtxo accountXPub' = context intPool
-            addressXPub = deriveAddressPublicKey accountXPub' UtxoInternal ix
-            addr = mkAddress addressXPub rpk
-        in
-            (addr, SeqState intPool extPool pending' rpk path)
+    
+    genChange mkAddress st =
+        (addr, st{ pendingChangeIxs = pending' })
+      where
+        (ix, pending') = nextChangeIndex (internalPool st) (pendingChangeIxs st)
+        addressXPub = deriveAddressPublicKey (accountXPub st) UtxoInternal ix
+        addr = mkAddress addressXPub (rewardAccountKey st)
 
 instance
     ( IsOurs (SeqState n k) Address
-    , SoftDerivation k
-    , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-    , MkKeyFingerprint k Address
+    , SupportsDiscovery n k
     , AddressIndexDerivationType k ~ 'Soft
     )
     => IsOwned (SeqState n k) k where
-    isOwned (SeqState !s1 !s2 _ _ _) (rootPrv, pwd) addr =
-        let
-            xPrv1 = lookupAndDeriveXPrv s1
-            xPrv2 = lookupAndDeriveXPrv s2
-            xPrv = xPrv1 <|> xPrv2
-        in
-            (,pwd) <$> xPrv
+    isOwned st (rootPrv, pwd) addrRaw =
+        case paymentKeyFingerprint addrRaw of
+            Left _ -> Nothing
+            Right addr -> 
+                let
+                    xPrv1 = lookupAndDeriveXPrv addr (internalPool st)
+                    xPrv2 = lookupAndDeriveXPrv addr (externalPool st)
+                    xPrv = xPrv1 <|> xPrv2
+                in
+                    (,pwd) <$> xPrv
       where
+        -- We are assuming there is only one account
+        accountPrv = deriveAccountPrivateKey pwd rootPrv minBound
+
         lookupAndDeriveXPrv
             :: forall c. (Typeable c)
-            => AddressPool c k
+            => KeyFingerprint "payment" k
+            -> SeqAddressPool c k
             -> Maybe (k 'AddressK XPrv)
-        lookupAndDeriveXPrv pool =
-            let
-                -- We are assuming there is only one account
-                accountPrv = deriveAccountPrivateKey pwd rootPrv minBound
-                (addrIx, _) = lookupAddress @n (const Used) addr pool
-                cc = role @c
-            in
-                deriveAddressPrivateKey pwd accountPrv cc <$> addrIx
+        lookupAndDeriveXPrv addr (SeqAddressPool pool) =
+                deriveAddressPrivateKey pwd accountPrv (role @c)
+            <$> AddressPool.lookup addr pool 
 
-instance
-    ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-    , MkKeyFingerprint k Address
-    , SoftDerivation k
-    ) => CompareDiscovery (SeqState n k) where
-    compareDiscovery (SeqState !s1 !s2 _ _ _) a1 a2 =
+instance SupportsDiscovery n k => CompareDiscovery (SeqState n k) where
+    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
             (Just _, Nothing)  -> LT
             (Just i1, Just i2) -> compare i1 i2
       where
-        ix :: Typeable c => Address -> AddressPool c k -> Maybe (Index 'Soft 'AddressK)
-        ix a = fst . lookupAddress @n id a
+        ix :: Address -> SeqAddressPool c k -> Maybe (Index 'Soft 'AddressK)
+        ix a (SeqAddressPool pool) = case paymentKeyFingerprint a of
+            Left _ -> Nothing
+            Right addr -> AddressPool.lookup addr pool
 
 instance
     ( PaymentAddress n k
-    , GetPurpose k
     ) => KnownAddresses (SeqState n k) where
-    knownAddresses s =
+    knownAddresses st =
         nonChangeAddresses <> usedChangeAddresses <> pendingChangeAddresses
       where
-            nonChangeAddresses =
-                addresses (liftPaymentAddress @n @k) (externalPool s)
-
-            changeAddresses =
-                addresses (liftPaymentAddress @n @k) (internalPool s)
+        -- | List addresses in order of increasing indices.
+        listAddresses
+            :: forall c. (Typeable c)
+            => SeqAddressPool c k
+            -> [(Address, AddressState, NonEmpty DerivationIndex)]
+        listAddresses (SeqAddressPool pool) =
+            map shuffle . L.sortOn idx . Map.toList
+            $ AddressPool.addresses pool
+          where
+            idx (_,(ix,_)) = ix
+            shuffle (k,(ix,s)) =
+                (liftPaymentAddress @n k, s, decoratePath st (role @c) ix)
 
-            usedChangeAddresses =
-                filter (\(_, state, _) -> state == Used) changeAddresses
+        nonChangeAddresses = listAddresses $ externalPool st
 
-            -- pick as many unused change addresses as there are pending
-            -- transactions. Note: the last `internalGap` addresses are all
-            -- unused.
-            pendingChangeAddresses =
-                let
-                    (PendingIxs ixs) =
-                        pendingChangeIxs s
+        changeAddresses = listAddresses $ internalPool st
+        usedChangeAddresses =
+            filter (\(_, status, _) -> status == Used) changeAddresses
 
-                    internalGap =
-                        fromEnum . getAddressPoolGap . gap . internalPool $ s
+        -- pick as many unused change addresses as there are pending
+        -- transactions. Note: the last `internalGap` addresses are all
+        -- unused.
+        pendingChangeAddresses = take (length ixs) edgeChangeAddresses
+          where
+            PendingIxs ixs = pendingChangeIxs st
+            internalGap = AddressPool.gap $ getPool $ internalPool st
+            edgeChangeAddresses =
+                drop (length changeAddresses - internalGap) changeAddresses
 
-                    edgeChangeAddresses =
-                        drop (length changeAddresses - internalGap) changeAddresses
-                in
-                    take (length ixs) edgeChangeAddresses
+{-------------------------------------------------------------------------------
+    SeqAnyState
 
---------------------------------------------------------------------------------
---
--- SeqAnyState
---
--- For benchmarking and testing arbitrary large sequential wallets.
+    For benchmarking and testing arbitrary large sequential wallets.
+-------------------------------------------------------------------------------}
 
 -- | An "unsound" alternative that can be used for benchmarking and stress
 -- testing. It re-uses the same underlying structure as the `SeqState` but
@@ -886,11 +733,8 @@ instance
 -- "100" means 1% and 10000 means 100%.
 mkSeqAnyState
     :: forall (p :: Nat) n k.
-        ( SoftDerivation k
-        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
+        ( SupportsDiscovery n k
         , WalletKey k
-        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
         , (k == SharedKey) ~ 'False
         )
     => (k 'RootK XPrv, Passphrase "encryption")
@@ -901,21 +745,19 @@ mkSeqAnyState credentials purpose poolGap = SeqAnyState
     { innerState = mkSeqStateFromRootXPrv credentials purpose poolGap
     }
 
-instance
-    ( SoftDerivation k
-    , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-    , KnownNat p
-    ) => IsOurs (SeqAnyState n k p) Address
-  where
+instance KnownNat p => IsOurs (SeqAnyState n k p) Address where
     isOurs (Address bytes) st@(SeqAnyState inner)
         | crc32 bytes < p =
             let
-                edge = Map.size (indexedKeys $ externalPool inner)
-                ix = toEnum (edge - fromEnum (gap $ externalPool inner))
-                pool' = extendAddressPool @n ix (externalPool inner)
+                pool = getPool $ externalPool inner
+                ix = toEnum $ AddressPool.size pool - AddressPool.gap pool
+                addr = AddressPool.generator pool ix
+                pool' = AddressPool.update addr pool
                 path = DerivationIndex (getIndex ix) :| []
             in
-                (Just path, SeqAnyState (inner { externalPool = pool' }))
+                ( Just path
+                , SeqAnyState $ inner{ externalPool = SeqAddressPool pool' }
+                )
         | otherwise =
             (Nothing, st)
       where
@@ -926,44 +768,25 @@ instance
         double :: Integral a => a -> Double
         double = fromIntegral
 
-instance IsOurs (SeqAnyState n k p) RewardAccount
-  where
+instance IsOurs (SeqAnyState n k p) RewardAccount where
     isOurs _account state = (Nothing, state)
 
 instance
-    ( SoftDerivation k
-    , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-    , AddressIndexDerivationType k ~ 'Soft
+    ( AddressIndexDerivationType k ~ 'Soft
     , KnownNat p
     ) => IsOwned (SeqAnyState n k p) k
   where
     isOwned _ _ _ = Nothing
 
-instance
-    ( SoftDerivation k
-    ) => GenChange (SeqAnyState n k p)
-  where
+instance SoftDerivation k => GenChange (SeqAnyState n k p) where
     type ArgGenChange (SeqAnyState n k p) = ArgGenChange (SeqState n k)
     genChange a (SeqAnyState s) = SeqAnyState <$> genChange a s
 
-instance
-    ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
-    , MkKeyFingerprint k Address
-    , SoftDerivation k
-    ) => CompareDiscovery (SeqAnyState n k p)
-  where
+instance SupportsDiscovery n k => CompareDiscovery (SeqAnyState n k p) where
     compareDiscovery (SeqAnyState s) = compareDiscovery s
 
-instance
-    ( PaymentAddress n k
-    , GetPurpose k
-    ) => KnownAddresses (SeqAnyState n k p)
-  where
+instance PaymentAddress n k => KnownAddresses (SeqAnyState n k p) where
     knownAddresses (SeqAnyState s) = knownAddresses s
 
 instance GetAccount (SeqState n k) k where
-    getAccount s =
-        -- NOTE: Alternatively, we could use 'internalPool', they share the same
-        --       account public key.
-        let (ParentContextUtxo acctK) = context $ externalPool s
-        in acctK
+    getAccount = accountXPub
diff --git a/lib/core/test/unit/Cardano/Wallet/Address/PoolSpec.hs b/lib/core/test/unit/Cardano/Wallet/Address/PoolSpec.hs
index 69191b9fca1..b493aeafcf5 100644
--- a/lib/core/test/unit/Cardano/Wallet/Address/PoolSpec.hs
+++ b/lib/core/test/unit/Cardano/Wallet/Address/PoolSpec.hs
@@ -1,5 +1,7 @@
 module Cardano.Wallet.Address.PoolSpec
     ( spec
+    , genPool
+    , shrinkPool
     ) where
 
 import Prelude
@@ -8,14 +10,19 @@ import Cardano.Wallet.Address.Pool
     ( Pool, addresses, generator, prop_consistent, prop_fresh, prop_gap )
 import Cardano.Wallet.Primitive.Types.Address
     ( AddressState (..) )
+import Data.List
+    ( sortOn )
 import Test.Hspec
     ( Spec, describe, it, parallel )
 import Test.QuickCheck
-    ( Gen, Property, choose, forAll, listOf, oneof, (===) )
+    ( Gen, Property, choose, forAll, listOf, oneof, sized, (===) )
 
 import qualified Cardano.Wallet.Address.Pool as AddressPool
 import qualified Data.Map.Strict as Map
 
+{-------------------------------------------------------------------------------
+    Properties
+-------------------------------------------------------------------------------}
 spec :: Spec
 spec = do
     parallel $ describe "Cardano.Wallet.Address.Pool" $ do
@@ -23,26 +30,54 @@ spec = do
             prop_consistent testPool
 
         it "generator satisfies prop_gap and prop_fresh" $
-            forAll genUsageWithGap $ \usage ->
-                let pool = fromUsage usage
+            forAll (genUsageForGap $ AddressPool.gap testPool) $ \usage ->
+                let pool = fromUsage testPool usage
                 in  all ($ pool) [prop_gap, prop_fresh]
 
-        it "sequence of updates preserves invariants"
-            prop_updates
+        it "sequence of updates preserves invariants" $
+            prop_updates testPool
+
+        it "order of updates (within range) is irrelevant for pool content" $
+            prop_updates_order $ AddressPool.new (id :: Int -> Int) 3
 
         it "update does nothing on addresses outside the gap" $
             let p1 = testPool
                 p2 = AddressPool.update (AddressPool.gap p1 + 1) p1
             in  addresses p1 === addresses p2
 
-prop_updates :: Property
-prop_updates = forAll genUsageWithGap $ \usage ->
-    let addr ix = AddressPool.generator testPool ix
-        g       = AddressPool.gap testPool
-        addrs1  = [ addr ix | (ix,Used) <- zip [0..] usage ]
-        addrs2  = map addr [0..2*g]
-        pool    = foldl (flip AddressPool.update) testPool (addrs1 <> addrs2)
-    in  prop_consistent pool
+prop_updates :: (Ord addr, Ord ix, Enum ix) => Pool addr ix -> Property
+prop_updates pool = forAll (genUsageForGap $ AddressPool.gap pool) $ \usage ->
+    let addr ix = AddressPool.generator pool ix
+        g       = AddressPool.gap pool
+        addrs1  = [ addr ix | (ix,Used) <- zip [toEnum 0..] usage ]
+        addrs2  = map (addr . toEnum) [0..2*g]
+        pool1   = foldl (flip AddressPool.update) pool (addrs1 <> addrs2)
+    in  prop_consistent pool1
+
+prop_updates_order
+    :: (Ord addr, Ord ix, Enum ix, Show addr, Show ix)
+    => Pool addr ix -> Property
+prop_updates_order pool0 = forAll genUpdates $ \pool ->
+      AddressPool.addresses pool
+    ===
+      AddressPool.addresses (applyUsageInOrder pool0 $ toUsage pool)
+  where
+    addr ix = AddressPool.generator pool0 ix
+    g       = AddressPool.gap pool0
+
+    -- generate and apply a random sequence of updates
+    genUpdates = sized $ randomUpdates pool0
+    randomUpdates pool 0 = pure pool
+    randomUpdates pool n = do
+        let end = AddressPool.size pool - 1
+        ix <- toEnum <$>
+            oneof [choose (0,end), choose (end-(g-1),end)]
+        randomUpdates (AddressPool.update (addr ix) pool) (n-1)
+
+    applyUsageInOrder pool usage =
+        foldl (flip AddressPool.update) pool
+            [ addr ix | (ix,Used) <- zip [toEnum 0..] usage ]
+    toUsage = map snd . sortOn fst . Map.elems . AddressPool.addresses
 
 {-------------------------------------------------------------------------------
     Generators
@@ -53,22 +88,66 @@ type TestPool = Pool Int Int
 testPool :: TestPool
 testPool = AddressPool.new id 5
 
-{- HLINT ignore "Use zipWith" -}
--- | Make a testing pool from a given list of address statuses
-fromUsage :: [AddressState] -> TestPool
-fromUsage = AddressPool.loadUnsafe testPool
-    . Map.fromList . map decorate . zip [0..]
+-- | Fill a given pool from a list of address statuses
+fromUsage :: (Ord addr, Enum ix) => Pool addr ix -> [AddressState] -> Pool addr ix
+fromUsage pool = AddressPool.loadUnsafe pool
+    . Map.fromList . zipWith decorate [(toEnum 0)..]
   where
-    decorate (ix,status) = (generator testPool ix, (ix, status))
+    decorate ix status = (generator pool ix, (ix, status))
 
 -- | Generate address statuses that respect the address gap.
-genUsageWithGap :: Gen [AddressState]
-genUsageWithGap = do
+genUsageForGap :: Int -> Gen [AddressState]
+genUsageForGap gap = do
     xs <- listOf uu
     y  <- used
     pure $ concat xs <> y <> replicate gap Unused
   where
-    gap    = AddressPool.gap testPool
     used   = flip replicate Used <$> oneof [choose (1,3), choose (gap+1,2*gap)]
     unused = flip replicate Unused <$> choose (0,gap-1)
     uu     = (<>) <$> used <*> unused
+
+-- | Generate a random address Pool that satisfies 'prop_consistent'
+-- from existing pool (parameters).
+genPool :: (Ord addr, Enum ix) => Pool addr ix -> Gen (Pool addr ix)
+genPool pool = fromUsage pool <$> genUsageForGap (AddressPool.gap pool) 
+
+{-------------------------------------------------------------------------------
+    Shrinkers
+-------------------------------------------------------------------------------}
+-- | Shrink an address pool. The gap will be shrunk as well.
+shrinkPool
+    :: (Ord addr, Enum ix)
+    => Int -- ^ minimum gap to shrink to
+    -> Pool addr ix -> [Pool addr ix]
+shrinkPool minGap pool
+    | k == gap && gap == minGap = []
+    | k == gap && gap >  minGap = [ minimalPool ]
+    | otherwise =
+        [ minimalPool
+        , AddressPool.clear pool
+        , AddressPool.loadUnsafe pool $ removeN n gap $ AddressPool.addresses pool
+        ]
+  where
+    k = AddressPool.size pool
+    n = gap `div` 5
+    gap = AddressPool.gap pool
+    minimalPool = AddressPool.new (AddressPool.generator pool) minGap
+
+-- | Remove the top @n@ indices and restore the upper @gap@ indices to 'Unused'.
+--
+-- Note: This function is only used for shrinking and not unit tested.
+-- This is ok, because a bug in the shrinker only affects
+-- our ability to find the cause of a bug,
+-- but does not affect the visibility of said bug.
+removeN
+    :: Enum ix
+    => Int -> Int
+    -> Map.Map addr (ix, AddressState)
+    -> Map.Map addr (ix, AddressState)
+removeN n gap addrs = Map.map unuse $ Map.filter (not . isTop) addrs
+  where
+    top = Map.size addrs - 1 -- topmost index
+    isTop (ix,_) = top <= fromEnum ix + (n-1)
+    unuse a@(ix,_)
+        | top <= fromEnum ix + (n-1) + gap = (ix, Unused)
+        | otherwise = a
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs
index bfb114b23ef..9a37982a3fc 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs
@@ -66,13 +66,10 @@ import Cardano.Wallet.Primitive.AddressDiscovery
 import Cardano.Wallet.Primitive.AddressDiscovery.Random
     ( RndState (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( AddressPool
-    , DerivationPrefix (..)
-    , ParentContext (..)
+    ( DerivationPrefix (..)
     , SeqState (..)
     , coinTypeAda
     , defaultAddressPoolGap
-    , mkAddressPool
     , purposeCIP1852
     )
 import Cardano.Wallet.Primitive.AddressDiscovery.Shared
@@ -165,6 +162,8 @@ import Data.Ratio
     ( (%) )
 import Data.Text.Class
     ( toText )
+import Data.Typeable
+    ( Typeable )
 import Data.Word
     ( Word16, Word32 )
 import Data.Word.Odd
@@ -481,12 +480,14 @@ instance Arbitrary (Index 'WholeDomain depth) where
 -------------------------------------------------------------------------------}
 
 instance Arbitrary (SeqState 'Mainnet ShelleyKey) where
-    shrink (SeqState intPool extPool ixs rwd prefix) =
-        (\(i, e, x) -> SeqState i e x rwd prefix) <$> shrink (intPool, extPool, ixs)
+    shrink (SeqState intPool extPool ixs acc rwd prefix) =
+            (\(i, e, x) -> SeqState i e x acc rwd prefix)
+        <$> shrink (intPool, extPool, ixs)
     arbitrary = SeqState
         <$> arbitrary
         <*> arbitrary
         <*> arbitrary
+        <*> pure arbitrarySeqAccount
         <*> pure arbitraryRewardAccount
         <*> pure defaultSeqStatePrefix
 
@@ -522,13 +523,11 @@ instance Arbitrary (ShelleyKey 'RootK XPrv) where
 instance Arbitrary (Seq.PendingIxs) where
     arbitrary = pure Seq.emptyPendingIxs
 
-instance Arbitrary (AddressPool 'UtxoExternal ShelleyKey) where
-    arbitrary = pure $ mkAddressPool @'Mainnet
-        (ParentContextUtxo arbitrarySeqAccount) minBound mempty
-
-instance Arbitrary (AddressPool 'UtxoInternal ShelleyKey) where
-    arbitrary = pure $ mkAddressPool @'Mainnet
-        (ParentContextUtxo arbitrarySeqAccount) minBound mempty
+instance ( Typeable ( c :: Role ) )
+    => Arbitrary (Seq.SeqAddressPool c ShelleyKey)
+  where
+    arbitrary = pure $ Seq.newSeqAddressPool @'Mainnet
+        arbitrarySeqAccount defaultAddressPoolGap
 
 -- Properties are quite heavy on the generation of values, although for
 -- private keys, it isn't particularly useful / relevant to generate many of
diff --git a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs
index c034fe0fb9c..f6b00e779ae 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs
@@ -108,7 +108,6 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , KeyFingerprint
     , NetworkDiscriminant (..)
     , PersistPrivateKey (..)
-    , Role (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation.Byron
     ( ByronKey )
@@ -121,7 +120,7 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley
 import Cardano.Wallet.Primitive.AddressDiscovery.Random
     ( RndState )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( AddressPool (..), AddressPoolGap, SeqState (..) )
+    ( AddressPoolGap, SeqState (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     ( Readiness, SharedState (..) )
 import Cardano.Wallet.Primitive.Model
@@ -970,13 +969,6 @@ instance ToExpr (SeqState 'Mainnet ShelleyKey) where
 instance ToExpr (RndState 'Mainnet) where
     toExpr = defaultExprViaShow
 
-instance (Show (key 'AccountK CC.XPub)) =>
-    ToExpr (AddressPool
-        (chain :: Role)
-        (key :: Depth -> * -> *)
-    ) where
-    toExpr = defaultExprViaShow
-
 instance ToExpr a => ToExpr (Readiness a) where
     toExpr = genericToExpr
 
diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs
index c4e2121978f..b1176527576 100644
--- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs
+++ b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs
@@ -23,6 +23,8 @@ import Prelude
 
 import Cardano.Address.Derivation
     ( XPub )
+import Cardano.Wallet.Address.PoolSpec
+    ( genPool, shrinkPool )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( DelegationAddress (..)
     , Depth (..)
@@ -30,7 +32,6 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , DerivationType (..)
     , HardDerivation (..)
     , Index
-    , KeyFingerprint
     , MkKeyFingerprint (..)
     , NetworkDiscriminant (..)
     , PaymentAddress (..)
@@ -54,26 +55,20 @@ import Cardano.Wallet.Primitive.AddressDiscovery
     , genChange
     )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( AddressPool
-    , AddressPoolGap (..)
+    ( AddressPoolGap (..)
     , DerivationPrefix (..)
     , MkAddressPoolGapError (..)
-    , ParentContext (..)
+    , SeqAddressPool (..)
     , SeqState (..)
-    , addresses
     , coinTypeAda
-    , context
     , defaultAddressPoolGap
     , emptyPendingIxs
-    , gap
-    , lookupAddress
-    , mkAddressPool
     , mkAddressPoolGap
     , mkSeqStateFromAccountXPub
     , mkSeqStateFromRootXPrv
     , mkUnboundedAddressPoolGap
+    , newSeqAddressPool
     , purposeCIP1852
-    , role
     )
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..), AddressState (..) )
@@ -84,17 +79,11 @@ import Cardano.Wallet.Util
 import Control.Arrow
     ( first )
 import Control.Monad
-    ( forM, forM_, unless )
+    ( unless )
 import Control.Monad.IO.Class
     ( liftIO )
-import Control.Monad.Trans.State.Strict
-    ( execState, state )
 import Data.Function
     ( (&) )
-import Data.Kind
-    ( Type )
-import Data.List
-    ( elemIndex, (\\) )
 import Data.List.NonEmpty
     ( NonEmpty )
 import Data.Maybe
@@ -115,7 +104,6 @@ import Test.Hspec.Extra
     ( parallel )
 import Test.QuickCheck
     ( Arbitrary (..)
-    , InfiniteList (..)
     , Property
     , arbitraryBoundedEnum
     , checkCoverage
@@ -140,6 +128,7 @@ import Test.QuickCheck.Monadic
 import Test.Text.Roundtrip
     ( textRoundtrip )
 
+import qualified Cardano.Wallet.Address.Pool as AddressPool
 import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus
 import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley
 
@@ -160,35 +149,6 @@ spec = do
     parallel $ describe "DerivationPrefix" $ do
         textRoundtrip (Proxy @DerivationPrefix)
 
-    let styles =
-            [ Style (Proxy @'UtxoExternal)
-            , Style (Proxy @'UtxoInternal)
-            ]
-
-    parallel $ describe "AddressPool (Shelley)" $ do
-        forM_ styles $ \s@(Style proxyS) -> do
-            parallel $ describe ("ShelleyKey " <> show s) $ do
-                it "'lookupAddressPool' extends the pool by a maximum of 'gap'"
-                    (checkCoverage (prop_poolGrowWithinGap @_ @ShelleyKey proxyS))
-                it "'addresses' preserves the address order"
-                    (checkCoverage (prop_roundtripMkAddressPool @_ @ShelleyKey proxyS))
-                it "An AddressPool always contains at least 'gap pool' addresses"
-                    (property (prop_poolAtLeastGapAddresses @_ @ShelleyKey proxyS))
-                it "Our addresses are eventually discovered"
-                    (property (prop_poolEventuallyDiscoverOurs @_ @ShelleyKey proxyS))
-
-    parallel $ describe "AddressPool (Shelley)" $ do
-        forM_ styles $ \s@(Style proxyS) -> do
-            parallel $ describe ("IcarusKey " <> show s) $ do
-                it "'lookupAddressPool' extends the pool by a maximum of 'gap'"
-                    (checkCoverage (prop_poolGrowWithinGap @_ @IcarusKey proxyS))
-                it "'addresses' preserves the address order"
-                    (checkCoverage (prop_roundtripMkAddressPool @_ @IcarusKey proxyS))
-                it "An AddressPool always contains at least 'gap pool' addresses"
-                    (property (prop_poolAtLeastGapAddresses @_ @IcarusKey proxyS))
-                it "Our addresses are eventually discovered"
-                    (property (prop_poolEventuallyDiscoverOurs @_ @IcarusKey proxyS))
-
     parallel $ describe "AddressPoolGap - Text Roundtrip" $ do
         textRoundtrip $ Proxy @AddressPoolGap
         let err = "An address pool gap must be a natural number between 10 and 100000."
@@ -280,111 +240,6 @@ prop_roundtripEnumGap g =
     (toEnum . fromEnum) g === g
 
 
-{-------------------------------------------------------------------------------
-                          Properties for AddressPool
--------------------------------------------------------------------------------}
-
--- | After a lookup, a property should never grow more than its gap value.
-prop_poolGrowWithinGap
-    :: forall (chain :: Role) k.
-        ( Typeable chain
-        , Eq (k 'AccountK XPub)
-        , Show (k 'AccountK XPub)
-        , MkKeyFingerprint k (Proxy 'Mainnet, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , SoftDerivation k
-        , AddressPoolTest k
-        , GetPurpose k
-        )
-    => Proxy chain
-    -> (AddressPool chain k, Address)
-    -> Property
-prop_poolGrowWithinGap _proxy (pool, addr) =
-    cover 7.5 (isJust $ fst res) "pool hit" prop
-  where
-    res = lookupAddress @'Mainnet id addr pool
-    prop = case res of
-        (Nothing, pool') -> pool === pool'
-        (Just _, pool') ->
-            let k = length $ addresses liftAddress pool' \\ addresses liftAddress pool
-            in conjoin
-                [ gap pool === gap pool'
-                , property (k >= 0 && k <= fromEnum (gap pool))
-                ]
-
--- | A pool gives back its addresses in correct order and can be reconstructed
-prop_roundtripMkAddressPool
-    :: forall (chain :: Role) k.
-        ( Typeable chain
-        , Eq (k 'AccountK XPub)
-        , Show (k 'AccountK XPub)
-        , MkKeyFingerprint k (Proxy 'Mainnet, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , SoftDerivation k
-        , AddressPoolTest k
-        , GetPurpose k
-        )
-    => Proxy chain
-    -> AddressPool chain k
-    -> Property
-prop_roundtripMkAddressPool _proxy pool =
-    ( mkAddressPool @'Mainnet
-        (context pool)
-        (gap pool)
-        (map pair' $ addresses liftAddress pool)
-    ) === pool
-
-class GetCtx (chain :: Role) where
-    getCtxFromAccXPub
-        :: (k == SharedKey) ~ 'False
-        => k 'AccountK XPub
-        -> ParentContext chain k
-
-instance GetCtx 'UtxoExternal where
-    getCtxFromAccXPub accXPub = ParentContextUtxo accXPub
-
-instance GetCtx 'UtxoInternal where
-    getCtxFromAccXPub accXPub = ParentContextUtxo accXPub
-
--- | A pool always contains a number of addresses at least equal to its gap
-prop_poolAtLeastGapAddresses
-    :: forall (chain :: Role) k.
-        ( AddressPoolTest k
-        , Typeable chain
-        , GetPurpose k
-        )
-    => Proxy chain
-    -> AddressPool chain k
-    -> Property
-prop_poolAtLeastGapAddresses _proxy pool =
-    property prop
-  where
-    prop = length (addresses liftAddress pool) >= fromEnum (gap pool)
-
--- | Our addresses are eventually discovered
-prop_poolEventuallyDiscoverOurs
-    :: forall (chain :: Role) (k :: Depth -> Type -> Type).
-        ( Typeable chain
-        , MkKeyFingerprint k (Proxy 'Mainnet, k 'AddressK XPub)
-        , MkKeyFingerprint k Address
-        , SoftDerivation k
-        , AddressPoolTest k
-        , GetCtx chain
-        , (k == SharedKey) ~ 'False
-        )
-    => Proxy chain
-    -> (AddressPoolGap, Address)
-    -> Property
-prop_poolEventuallyDiscoverOurs _proxy (g, addr) =
-    if addr `elem` ours then property $
-        (fromEnum <$> fst (lookupAddress @'Mainnet id addr pool)) === elemIndex addr ours
-    else
-        label "address not ours" (property True)
-  where
-    ours = take 25 (ourAddresses (Proxy @k) (role @chain))
-    pool = flip execState (mkAddressPool @'Mainnet @chain @k (getCtxFromAccXPub ourAccount) g mempty) $
-        forM ours (state . lookupAddress @'Mainnet id)
-
 {-------------------------------------------------------------------------------
                     Properties for AddressScheme & PendingIxs
 -------------------------------------------------------------------------------}
@@ -435,7 +290,7 @@ prop_changeNoLock
 prop_changeNoLock (s0, ix) =
     ShowFmt xs =/= ShowFmt ys .&&. ShowFmt addr `notElem` (ShowFmt <$> ys)
   where
-    g = gap $ internalPool s0
+    g = AddressPool.gap . getPool $ internalPool s0
     (xs, s) = changeAddresses [] s0
     addr = xs !! (ix `mod` fromEnum g)
     (_, s') = isOurs addr s
@@ -506,17 +361,17 @@ prop_atLeastKnownAddresses
 prop_atLeastKnownAddresses s =
     property $ length (knownAddresses s) >= g (externalPool s)
   where
-    g = fromEnum . getAddressPoolGap . gap
+    g = fromEnum . AddressPool.gap . getPool
 
 prop_changeIsOnlyKnownAfterGeneration
-    :: ( AddressPool 'UtxoInternal ShelleyKey
-       , AddressPool 'UtxoExternal ShelleyKey
+    :: ( SeqAddressPool 'UtxoInternal ShelleyKey
+       , SeqAddressPool 'UtxoExternal ShelleyKey
        )
     -> Property
 prop_changeIsOnlyKnownAfterGeneration (intPool, extPool) =
     let
         s0 :: SeqState 'Mainnet ShelleyKey
-        s0 = SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix
+        s0 = SeqState intPool extPool emptyPendingIxs ourAccount rewardAccount defaultPrefix
         addrs0 = pair' <$> knownAddresses s0
         (change, s1) = genChange (\k _ -> paymentAddress @'Mainnet k) s0
         addrs1 = fst' <$> knownAddresses s1
@@ -527,12 +382,16 @@ prop_changeIsOnlyKnownAfterGeneration (intPool, extPool) =
   where
     prop_addrsNotInInternalPool addrs =
         map (\(x, s) ->
-                let notInPool = isNothing $ fst $ lookupAddress @'Mainnet id x intPool
+                let notInPool = isNothing $ lookupAddress x intPool
                     isUsed = s == Used
                 in (ShowFmt x, notInPool || isUsed))
             addrs
         ===
         map (\(x, _) -> (ShowFmt x, True)) addrs
+    lookupAddress addrRaw (SeqAddressPool pool) =
+        case paymentKeyFingerprint addrRaw of
+            Left _ -> Nothing
+            Right addr -> AddressPool.lookup addr pool
     prop_changeAddressIsKnown addr addrs =
         counterexample
             (show (ShowFmt addr) <> " not in " <> show (ShowFmt <$> addrs))
@@ -562,9 +421,6 @@ class AddressPoolTest k where
         :: Proxy k
         -> Role
         -> [Address]
-    liftAddress
-        :: KeyFingerprint "payment" k
-        -> Address
 
 instance AddressPoolTest IcarusKey where
     ourAccount = publicKey $
@@ -577,9 +433,6 @@ instance AddressPoolTest IcarusKey where
       where
         mkAddress = paymentAddress @'Mainnet @IcarusKey
 
-    liftAddress =
-        liftPaymentAddress @'Mainnet
-
 instance AddressPoolTest ShelleyKey where
     ourAccount = publicKey $
         Shelley.unsafeGenerateKeyFromSeed (mw, Nothing) mempty
@@ -591,9 +444,6 @@ instance AddressPoolTest ShelleyKey where
       where
         mkAddress k = delegationAddress @'Mainnet k rewardAccount
 
-    liftAddress fingerprint =
-        liftDelegationAddress @'Mainnet fingerprint rewardAccount
-
 rewardAccount
     :: ShelleyKey 'AddressK XPub
 rewardAccount = publicKey $
@@ -664,53 +514,32 @@ instance Arbitrary Address where
         ]
 
 instance
-    ( Typeable chain
+    ( Typeable c
     , MkKeyFingerprint k (Proxy 'Mainnet, k 'AddressK XPub)
     , MkKeyFingerprint k Address
     , SoftDerivation k
     , AddressPoolTest k
-    , GetCtx chain
     , GetPurpose k
     , (k == SharedKey) ~ 'False
-    ) => Arbitrary (AddressPool chain k) where
-    shrink pool =
-        let
-            ctx = context pool
-            g = gap pool
-            addrs = pair' <$> addresses liftAddress pool
-        in case length addrs of
-            k | k == fromEnum g && g == minBound ->
-                []
-            k | k == fromEnum g && g > minBound ->
-                [ mkAddressPool @'Mainnet ctx minBound [] ]
-            k ->
-                [ mkAddressPool @'Mainnet ctx minBound []
-                , mkAddressPool @'Mainnet ctx g []
-                , mkAddressPool @'Mainnet ctx g (take (k - (fromEnum g `div` 5)) addrs)
-                ]
+    ) => Arbitrary (SeqAddressPool c k) where
+    shrink (SeqAddressPool pool) =
+        SeqAddressPool <$> shrinkPool minGap pool
+      where
+        minGap = fromIntegral $ getAddressPoolGap minBound
 
     arbitrary = do
-        g <- unsafeMkAddressPoolGap <$> choose
+        gap <- unsafeMkAddressPoolGap <$> choose
             (getAddressPoolGap minBound, 2 * getAddressPoolGap minBound)
-        n <- choose (0, 2 * fromEnum g)
-        let addrs = take n (ourAddresses (Proxy @k) (role @chain))
-        InfiniteList statuses _ <- arbitrary
-        return $ mkAddressPool @'Mainnet (getCtxFromAccXPub ourAccount) g (zip addrs statuses)
+        let SeqAddressPool pool = newSeqAddressPool @'Mainnet @c ourAccount gap
+        SeqAddressPool <$> genPool pool
 
 instance Arbitrary (SeqState 'Mainnet ShelleyKey) where
-    shrink (SeqState intPool extPool ixs rwd prefix) =
-        (\(i, e) -> SeqState i e ixs rwd prefix) <$> shrink (intPool, extPool)
+    shrink (SeqState intPool extPool ixs acc rwd prefix) =
+        (\(i, e) -> SeqState i e ixs acc rwd prefix) <$> shrink (intPool, extPool)
     arbitrary = do
         intPool <- arbitrary
         extPool <- arbitrary
-        return $ SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix
-
--- | Wrapper to encapsulate accounting style proxies that are so-to-speak,
--- different types in order to easily map over them and avoid duplicating
--- properties.
-data Style =
-    forall (chain :: Role). (Typeable chain, GetCtx chain) => Style (Proxy chain)
-instance Show Style where show (Style proxy) = show (typeRep proxy)
+        return $ SeqState intPool extPool emptyPendingIxs ourAccount rewardAccount defaultPrefix
 
 -- | Wrapper to encapsulate keys.
 data Key = forall (k :: Depth -> * -> *).