{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- An address pool caches a collection of addresses.
-- The purpose of this data structure is to aid in BIP-44 style
-- address discovery with an address gap.
module Cardano.Wallet.Address.Pool
    ( Pool
    , addressFromIx
    , addresses
    , usedAddresses
    , gap
    , lookup
    , size
    , successor
    , new
    , load
    , update
    , clear

    -- * Address Discovery
    , discover

    -- * Internal
    , loadUnsafe
    , prop_sequence
    , prop_gap
    , prop_fresh
    , prop_fromIx
    , prop_consistent
    )
  where

import Prelude hiding
    ( last, lookup )

import Cardano.Wallet.Primitive.Types.Address
    ( AddressState (..) )
import Control.DeepSeq
    ( NFData )
import Data.Map.Strict
    ( Map )
import Data.Ord
    ( Down (..) )
import Fmt
    ( Buildable (..) )
import GHC.Generics
    ( Generic )

{- HLINT ignore "Avoid restricted qualification" -}
import qualified Data.List as List
import qualified Data.Map.Strict as Map

{-------------------------------------------------------------------------------
    Address Pool, abstract data type
-------------------------------------------------------------------------------}
-- | An address pool caches a collection of addresses (type @addr@)
-- which are derived from a numeric index (type @ix@).
data Pool addr ix = Pool
    { Pool addr ix -> ix -> addr
addressFromIx :: ix -> addr
    -- ^ Mapping from a numeric index to its corresponding address.
    --
    -- This mapping is supposed to be (practically) a one-way function:
    -- Given an 'addr', it is impossible to compute the preimage
    -- 'ix' in practice.
    -- The purpose of the 'Pool' data structure is to help inverting
    -- this function regardless. The idea is that addresses
    -- with small indices @0,1,…@ are 'Used' before addresses with larger
    -- indices; specifically, only less than 'gap' many addresses in sequence
    -- may be 'Unused' before the next 'Used' address.
    -- This usage scheme restricts the search space considerably
    -- and allows us to practically invert the 'addressFromIx' function.
    , Pool addr ix -> Int
gap :: Int
    -- ^ The pool gap determines how 'Used' and 'Unused'
    -- have to be distributed.
    -- See 'prop_gap' and 'prop_fresh'.
    , Pool addr ix -> Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
    -- ^ Partial, cached inverse of the 'addressFromIx'.
    -- This map contains all cached addresses @addr@,
    -- their corresponding indices @ix@,
    -- and whether they are 'Used' or 'Unused'.
    -- See 'prop_sequence'.
    } deriving ((forall x. Pool addr ix -> Rep (Pool addr ix) x)
-> (forall x. Rep (Pool addr ix) x -> Pool addr ix)
-> Generic (Pool addr ix)
forall x. Rep (Pool addr ix) x -> Pool addr ix
forall x. Pool addr ix -> Rep (Pool addr ix) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall addr ix x. Rep (Pool addr ix) x -> Pool addr ix
forall addr ix x. Pool addr ix -> Rep (Pool addr ix) x
$cto :: forall addr ix x. Rep (Pool addr ix) x -> Pool addr ix
$cfrom :: forall addr ix x. Pool addr ix -> Rep (Pool addr ix) x
Generic)

instance (NFData addr, NFData ix) => NFData (Pool addr ix)

-- | Internal invariant:
-- The indices of the addresses in a pool form a finite
-- sequence beginning with 'fromEnum'@ 0@.
prop_sequence :: (Ord ix, Enum ix) => Pool addr ix -> Bool
prop_sequence :: Pool addr ix -> Bool
prop_sequence Pool{Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses} =
    [ix]
indices [ix] -> [ix] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` [Int -> ix
forall a. Enum a => Int -> a
toEnum Int
0..]
  where
    indices :: [ix]
indices = [ix] -> [ix]
forall a. Ord a => [a] -> [a]
List.sort ([ix] -> [ix]) -> [ix] -> [ix]
forall a b. (a -> b) -> a -> b
$ ((ix, AddressState) -> ix) -> [(ix, AddressState)] -> [ix]
forall a b. (a -> b) -> [a] -> [b]
map (ix, AddressState) -> ix
forall a b. (a, b) -> a
fst ([(ix, AddressState)] -> [ix]) -> [(ix, AddressState)] -> [ix]
forall a b. (a -> b) -> a -> b
$ Map addr (ix, AddressState) -> [(ix, AddressState)]
forall k a. Map k a -> [a]
Map.elems Map addr (ix, AddressState)
addresses

-- | Internal invariant:
-- If we order the 'addresses' by their indices,
-- then there are always /less than/ 'gap' many 'Unused'
-- addresses between two consecutive 'Used' addresses,
-- or before the first 'Used' address.
prop_gap :: Ord ix => Pool addr ix -> Bool
prop_gap :: Pool addr ix -> Bool
prop_gap Pool{Int
gap :: Int
gap :: forall addr ix. Pool addr ix -> Int
gap,Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses}
    = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
gap) ([Int] -> Bool)
-> ([AddressState] -> [Int]) -> [AddressState] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[AddressState]] -> [Int]
consecutiveUnused ([[AddressState]] -> [Int])
-> ([AddressState] -> [[AddressState]]) -> [AddressState] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AddressState] -> [[AddressState]]
forall a. Eq a => [a] -> [[a]]
List.group ([AddressState] -> Bool) -> [AddressState] -> Bool
forall a b. (a -> b) -> a -> b
$ [AddressState]
statuses
  where
    consecutiveUnused :: [[AddressState]] -> [Int]
consecutiveUnused ((AddressState
Used:[AddressState]
_):[[AddressState]]
xs) = [[AddressState]] -> [Int]
consecutiveUnused [[AddressState]]
xs
    consecutiveUnused (x :: [AddressState]
x@(AddressState
Unused:[AddressState]
_):(AddressState
Used:[AddressState]
_):[[AddressState]]
xs) =
        [AddressState] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AddressState]
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [[AddressState]] -> [Int]
consecutiveUnused [[AddressState]]
xs
    consecutiveUnused [[AddressState]]
_ = []

    statuses :: [AddressState]
statuses = ((ix, AddressState) -> AddressState)
-> [(ix, AddressState)] -> [AddressState]
forall a b. (a -> b) -> [a] -> [b]
map (ix, AddressState) -> AddressState
forall a b. (a, b) -> b
snd ([(ix, AddressState)] -> [AddressState])
-> [(ix, AddressState)] -> [AddressState]
forall a b. (a -> b) -> a -> b
$ ((ix, AddressState) -> ix)
-> [(ix, AddressState)] -> [(ix, AddressState)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (ix, AddressState) -> ix
forall a b. (a, b) -> a
fst ([(ix, AddressState)] -> [(ix, AddressState)])
-> [(ix, AddressState)] -> [(ix, AddressState)]
forall a b. (a -> b) -> a -> b
$ Map addr (ix, AddressState) -> [(ix, AddressState)]
forall k a. Map k a -> [a]
Map.elems Map addr (ix, AddressState)
addresses

-- | Internal invariant:
-- If we order the 'addresses' by their indices,
-- there are exactly 'gap' many 'Unused' addresses after the last
-- 'Used' address.
prop_fresh :: Ord ix => Pool addr ix -> Bool
prop_fresh :: Pool addr ix -> Bool
prop_fresh Pool{Int
gap :: Int
gap :: forall addr ix. Pool addr ix -> Int
gap,Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses} =
    (AddressState -> Bool) -> [AddressState] -> [AddressState]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (AddressState -> AddressState -> Bool
forall a. Eq a => a -> a -> Bool
== AddressState
Unused) [AddressState]
end [AddressState] -> [AddressState] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> AddressState -> [AddressState]
forall a. Int -> a -> [a]
replicate Int
gap AddressState
Unused
  where
    end :: [AddressState]
end = ((ix, AddressState) -> AddressState)
-> [(ix, AddressState)] -> [AddressState]
forall a b. (a -> b) -> [a] -> [b]
map (ix, AddressState) -> AddressState
forall a b. (a, b) -> b
snd ([(ix, AddressState)] -> [AddressState])
-> [(ix, AddressState)] -> [AddressState]
forall a b. (a -> b) -> a -> b
$ ((ix, AddressState) -> Down ix)
-> [(ix, AddressState)] -> [(ix, AddressState)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (ix -> Down ix
forall a. a -> Down a
Down (ix -> Down ix)
-> ((ix, AddressState) -> ix) -> (ix, AddressState) -> Down ix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ix, AddressState) -> ix
forall a b. (a, b) -> a
fst) ([(ix, AddressState)] -> [(ix, AddressState)])
-> [(ix, AddressState)] -> [(ix, AddressState)]
forall a b. (a -> b) -> a -> b
$ Map addr (ix, AddressState) -> [(ix, AddressState)]
forall k a. Map k a -> [a]
Map.elems Map addr (ix, AddressState)
addresses

-- | Internal invariant:
-- All 'addresses' in the pool have been generated from their index
-- via the pool 'addressFromIx'.
prop_fromIx :: Eq addr => Pool addr ix -> Bool
prop_fromIx :: Pool addr ix -> Bool
prop_fromIx Pool{ix -> addr
addressFromIx :: ix -> addr
addressFromIx :: forall addr ix. Pool addr ix -> ix -> addr
addressFromIx,Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses} =
    Map addr Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Map addr Bool -> Bool) -> Map addr Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (addr -> (ix, AddressState) -> Bool)
-> Map addr (ix, AddressState) -> Map addr Bool
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey addr -> (ix, AddressState) -> Bool
isGenerated Map addr (ix, AddressState)
addresses
  where
    isGenerated :: addr -> (ix, AddressState) -> Bool
isGenerated addr
addr (ix
ix,AddressState
_) = ix -> addr
addressFromIx ix
ix addr -> addr -> Bool
forall a. Eq a => a -> a -> Bool
== addr
addr

-- | Internal invariant: The pool satisfies all invariants above.
prop_consistent :: (Ord ix, Enum ix, Eq addr) => Pool addr ix -> Bool
prop_consistent :: Pool addr ix -> Bool
prop_consistent Pool addr ix
p =
    ((Pool addr ix -> Bool) -> Bool) -> [Pool addr ix -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Pool addr ix -> Bool) -> Pool addr ix -> Bool
forall a b. (a -> b) -> a -> b
$ Pool addr ix
p) [Pool addr ix -> Bool
forall ix addr. (Ord ix, Enum ix) => Pool addr ix -> Bool
prop_sequence, Pool addr ix -> Bool
forall ix addr. Ord ix => Pool addr ix -> Bool
prop_gap, Pool addr ix -> Bool
forall ix addr. Ord ix => Pool addr ix -> Bool
prop_fresh, Pool addr ix -> Bool
forall addr ix. Eq addr => Pool addr ix -> Bool
prop_fromIx]

{-------------------------------------------------------------------------------
    Pretty printing
-------------------------------------------------------------------------------}
instance Buildable (Pool addr ix) where
    build :: Pool addr ix -> Builder
build Pool addr ix
pool = Builder
"AddressPool "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"{ " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall p. Buildable p => p -> Builder
build (Pool addr ix -> Int
forall addr ix. Pool addr ix -> Int
size Pool addr ix
pool) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" addresses"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", gap = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall p. Buildable p => p -> Builder
build (Pool addr ix -> Int
forall addr ix. Pool addr ix -> Int
gap Pool addr ix
pool)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"

instance (Show addr, Show ix) => Show (Pool addr ix) where
    show :: Pool addr ix -> String
show Pool addr ix
pool = String
"AddressPool"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"{ addressFromIx = <<function>>"
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", gap = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Pool addr ix -> Int
forall addr ix. Pool addr ix -> Int
gap Pool addr ix
pool)
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", addresses = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map addr (ix, AddressState) -> String
forall a. Show a => a -> String
show (Pool addr ix -> Map addr (ix, AddressState)
forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses Pool addr ix
pool)
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"

{-------------------------------------------------------------------------------
    Address Pool, operations
-------------------------------------------------------------------------------}
-- | Create a new address pool.
new :: (Ord addr, Enum ix) => (ix -> addr) -> Int -> Pool addr ix
new :: (ix -> addr) -> Int -> Pool addr ix
new ix -> addr
addressFromIx Int
gap
    = ix -> Pool addr ix -> Pool addr ix
forall addr ix.
(Ord addr, Enum ix) =>
ix -> Pool addr ix -> Pool addr ix
ensureFresh (Int -> ix
forall a. Enum a => Int -> a
toEnum Int
0) (Pool addr ix -> Pool addr ix) -> Pool addr ix -> Pool addr ix
forall a b. (a -> b) -> a -> b
$ Pool :: forall addr ix.
(ix -> addr) -> Int -> Map addr (ix, AddressState) -> Pool addr ix
Pool{ ix -> addr
addressFromIx :: ix -> addr
addressFromIx :: ix -> addr
addressFromIx, Int
gap :: Int
gap :: Int
gap, addresses :: Map addr (ix, AddressState)
addresses = Map addr (ix, AddressState)
forall k a. Map k a
Map.empty }

-- | Replace the collection of addresses in a pool,
-- but only if this collection satisfies the necessary invariants
-- such as 'prop_sequence' etc.
load
    :: (Ord addr,  Ord ix, Enum ix)
    => Pool addr ix -> Map addr (ix,AddressState) -> Maybe (Pool addr ix)
load :: Pool addr ix -> Map addr (ix, AddressState) -> Maybe (Pool addr ix)
load Pool addr ix
pool0 Map addr (ix, AddressState)
addrs = if Pool addr ix -> Bool
forall ix addr. (Ord ix, Enum ix, Eq addr) => Pool addr ix -> Bool
prop_consistent Pool addr ix
pool then Pool addr ix -> Maybe (Pool addr ix)
forall a. a -> Maybe a
Just Pool addr ix
pool else Maybe (Pool addr ix)
forall a. Maybe a
Nothing
  where pool :: Pool addr ix
pool = Pool addr ix -> Map addr (ix, AddressState) -> Pool addr ix
forall addr ix.
Pool addr ix -> Map addr (ix, AddressState) -> Pool addr ix
loadUnsafe Pool addr ix
pool0 Map addr (ix, AddressState)
addrs

-- | Replace the collection of addresses in a pool,
-- but skips checking the invariants.
loadUnsafe :: Pool addr ix -> Map addr (ix,AddressState) -> Pool addr ix
loadUnsafe :: Pool addr ix -> Map addr (ix, AddressState) -> Pool addr ix
loadUnsafe Pool addr ix
pool Map addr (ix, AddressState)
addrs = Pool addr ix
pool{ addresses :: Map addr (ix, AddressState)
addresses = Map addr (ix, AddressState)
addrs }

-- | Remove all previously discovered addresses,
-- i.e. create a new pool with the same 'addressFromIx' and 'gap' as the old pool.
clear :: (Ord addr, Enum ix) => Pool addr ix -> Pool addr ix
clear :: Pool addr ix -> Pool addr ix
clear Pool{ix -> addr
addressFromIx :: ix -> addr
addressFromIx :: forall addr ix. Pool addr ix -> ix -> addr
addressFromIx,Int
gap :: Int
gap :: forall addr ix. Pool addr ix -> Int
gap} = (ix -> addr) -> Int -> Pool addr ix
forall addr ix.
(Ord addr, Enum ix) =>
(ix -> addr) -> Int -> Pool addr ix
new ix -> addr
addressFromIx Int
gap

-- | Look up an address in the pool.
lookup :: Ord addr => addr -> Pool addr ix -> Maybe ix
lookup :: addr -> Pool addr ix -> Maybe ix
lookup addr
addr Pool{Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses} = (ix, AddressState) -> ix
forall a b. (a, b) -> a
fst ((ix, AddressState) -> ix) -> Maybe (ix, AddressState) -> Maybe ix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> addr -> Map addr (ix, AddressState) -> Maybe (ix, AddressState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup addr
addr Map addr (ix, AddressState)
addresses

-- | Sorted list of all addresses that are marked 'Used' in the pool.
usedAddresses :: Pool addr ix -> [addr]
usedAddresses :: Pool addr ix -> [addr]
usedAddresses Pool addr ix
pool =
    [ addr
addr | (addr
addr,(ix
_,AddressState
Used)) <- Map addr (ix, AddressState) -> [(addr, (ix, AddressState))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map addr (ix, AddressState) -> [(addr, (ix, AddressState))])
-> Map addr (ix, AddressState) -> [(addr, (ix, AddressState))]
forall a b. (a -> b) -> a -> b
$ Pool addr ix -> Map addr (ix, AddressState)
forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses Pool addr ix
pool ]

-- | Number of addresses cached in the pool.
size :: Pool addr ix -> Int
size :: Pool addr ix -> Int
size = Map addr (ix, AddressState) -> Int
forall k a. Map k a -> Int
Map.size (Map addr (ix, AddressState) -> Int)
-> (Pool addr ix -> Map addr (ix, AddressState))
-> Pool addr ix
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pool addr ix -> Map addr (ix, AddressState)
forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses

-- | Given an index @ix@, return the enumerated successor @Just (succ ix)@
-- as long as the address corresponding to this successor is still
-- in the pool.
--
-- This function is useful for address discovery in a light client setting,
-- where the discovery procedure is:
-- Start with index @ix = 0@, query the corresponding address in an explorer,
-- @update@ address pool and repeat with @successor ix@ until the latter
-- returns 'Nothing'. According to the BIP-44 standard,
-- the account may not contain any other addresses than the ones discovered.
--
-- This function is not useful for generating change addresses,
-- as it does not take 'Used' or 'Unused' status into account.
successor :: Enum ix => Pool addr ix -> ix -> Maybe ix
successor :: Pool addr ix -> ix -> Maybe ix
successor Pool{Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses} ix
ix = let jx :: ix
jx = ix -> ix
forall a. Enum a => a -> a
succ ix
ix in
    if ix -> Int
forall a. Enum a => a -> Int
fromEnum ix
jx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map addr (ix, AddressState) -> Int
forall k a. Map k a -> Int
Map.size Map addr (ix, AddressState)
addresses then Maybe ix
forall a. Maybe a
Nothing else ix -> Maybe ix
forall a. a -> Maybe a
Just ix
jx

-- | Update an address to the 'Used' status
-- and create new 'Unused' addresses in order to satisfy 'prop_fresh'.
--
-- Does nothing if the address was not in the pool.
update :: (Ord addr, Enum ix) => addr -> Pool addr ix -> Pool addr ix
update :: addr -> Pool addr ix -> Pool addr ix
update addr
addr pool :: Pool addr ix
pool@Pool{Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses} =
    case addr -> Map addr (ix, AddressState) -> Maybe (ix, AddressState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup addr
addr Map addr (ix, AddressState)
addresses of
        Maybe (ix, AddressState)
Nothing     -> Pool addr ix
pool
        Just (ix
ix,AddressState
_) -> ix -> Pool addr ix -> Pool addr ix
forall addr ix.
(Ord addr, Enum ix) =>
ix -> Pool addr ix -> Pool addr ix
ensureFresh (ix -> ix
forall a. Enum a => a -> a
succ ix
ix) (Pool addr ix -> Pool addr ix) -> Pool addr ix -> Pool addr ix
forall a b. (a -> b) -> a -> b
$ Pool addr ix
pool
            { addresses :: Map addr (ix, AddressState)
addresses = ((ix, AddressState) -> (ix, AddressState))
-> addr
-> Map addr (ix, AddressState)
-> Map addr (ix, AddressState)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\(ix
i,AddressState
_) -> (ix
i, AddressState
Used)) addr
addr Map addr (ix, AddressState)
addresses }

-- | Create additional 'Unused' addresses from larger indices
-- in order to satisfy 'prop_fresh' again.
--
-- Preconditions:
--
-- * The index @ix@ satisfies:
--
--     either @ix = fromEnum 0@
--     or @ix = succ jx@ and the index @jx@ is a 'Used' address.
--
-- * All addresses with index @ix@ or larger are 'Unused'.
ensureFresh :: (Ord addr, Enum ix) => ix -> Pool addr ix -> Pool addr ix
ensureFresh :: ix -> Pool addr ix -> Pool addr ix
ensureFresh ix
ix pool :: Pool addr ix
pool@Pool{ix -> addr
addressFromIx :: ix -> addr
addressFromIx :: forall addr ix. Pool addr ix -> ix -> addr
addressFromIx,Int
gap :: Int
gap :: forall addr ix. Pool addr ix -> Int
gap,Map addr (ix, AddressState)
addresses :: Map addr (ix, AddressState)
addresses :: forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
addresses}
    = Pool addr ix
pool { addresses :: Map addr (ix, AddressState)
addresses = Map addr (ix, AddressState)
-> Map addr (ix, AddressState) -> Map addr (ix, AddressState)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map addr (ix, AddressState)
addresses Map addr (ix, AddressState)
nexts }
  where
    fresh :: ix
fresh = Int -> ix
forall a. Enum a => Int -> a
toEnum (Int -> ix) -> Int -> ix
forall a b. (a -> b) -> a -> b
$ Map addr (ix, AddressState) -> Int
forall k a. Map k a -> Int
Map.size Map addr (ix, AddressState)
addresses -- first index that is not in the pool
    nexts :: Map addr (ix, AddressState)
nexts = [(addr, (ix, AddressState))] -> Map addr (ix, AddressState)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (ix -> addr
addressFromIx ix
i, (ix
i, AddressState
Unused)) | ix
i <- [ix
fresh .. ix
to] ]
      where
        to :: ix
to = Int -> ix
forall a. Enum a => Int -> a
toEnum (Int -> ix) -> Int -> ix
forall a b. (a -> b) -> a -> b
$ ix -> Int
forall a. Enum a => a -> Int
fromEnum ix
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gap Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        -- example:
        --  ix = 0 && fresh = 0 && gap = 20 `implies` [fresh .. to] = [0..19]

{-------------------------------------------------------------------------------
    Address discovery using an address pool
-------------------------------------------------------------------------------}
-- | Discover transactions and addresses by
-- using an efficient query @addr -> m txs@ and an address pool.
discover
    :: (Enum ix, Ord addr, Monad m, Monoid txs, Eq txs)
    => (addr -> m txs) -> Pool addr ix -> m (txs, Pool addr ix)
discover :: (addr -> m txs) -> Pool addr ix -> m (txs, Pool addr ix)
discover addr -> m txs
query Pool addr ix
pool0 =
    txs -> Pool addr ix -> ix -> m (txs, Pool addr ix)
go txs
forall a. Monoid a => a
mempty Pool addr ix
pool0 (ix -> m (txs, Pool addr ix)) -> ix -> m (txs, Pool addr ix)
forall a b. (a -> b) -> a -> b
$ Int -> ix
forall a. Enum a => Int -> a
toEnum Int
0
  where
    go :: txs -> Pool addr ix -> ix -> m (txs, Pool addr ix)
go !txs
txs1 !Pool addr ix
pool1 ix
old = do
        -- TODO: Maybe cache the `addressFromIx` in the Pool using lazy evaluation.
        let addr :: addr
addr = Pool addr ix -> ix -> addr
forall addr ix. Pool addr ix -> ix -> addr
addressFromIx Pool addr ix
pool0 ix
old
        txs
newtxs <- addr -> m txs
query addr
addr
        let (Pool addr ix
pool2, txs
txs2) = if txs
forall a. Monoid a => a
mempty txs -> txs -> Bool
forall a. Eq a => a -> a -> Bool
== txs
newtxs
                then (Pool addr ix
pool1, txs
txs1)
                else (addr -> Pool addr ix -> Pool addr ix
forall addr ix.
(Ord addr, Enum ix) =>
addr -> Pool addr ix -> Pool addr ix
update addr
addr Pool addr ix
pool1, txs
txs1 txs -> txs -> txs
forall a. Semigroup a => a -> a -> a
<> txs
newtxs)
        case Pool addr ix -> ix -> Maybe ix
forall ix addr. Enum ix => Pool addr ix -> ix -> Maybe ix
successor Pool addr ix
pool2 ix
old of
            Maybe ix
Nothing    -> (txs, Pool addr ix) -> m (txs, Pool addr ix)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (txs
txs2, Pool addr ix
pool2)
            Just ix
next  -> txs -> Pool addr ix -> ix -> m (txs, Pool addr ix)
go txs
txs2 Pool addr ix
pool2 ix
next