{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# 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
-- License: Apache-2.0
--
-- An implementation of address discovery for the sequential address derivation
-- scheme specified in BIP-0044.
--
-- The management of _accounts_ is left-out for this implementation focuses on
-- a single account. In practice, one wants to manage a set of pools, one per
-- account.

module Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    (
    -- * Sequential Derivation
    -- ** Address Pool Gap
      AddressPoolGap
    , MkAddressPoolGapError (..)
    , defaultAddressPoolGap
    , getAddressPoolGap
    , mkAddressPoolGap
    , mkUnboundedAddressPoolGap

    -- ** Address Pool
    , SeqAddressPool (..)
    , getGap
    , newSeqAddressPool
    , unsafePaymentKeyFingerprint

    -- ** State
    , SeqState (..)
    , DerivationPrefix (..)
    , purposeBIP44
    , purposeCIP1852
    , coinTypeAda
    , mkSeqStateFromRootXPrv
    , mkSeqStateFromAccountXPub
    , discoverSeq
    , discoverSeqWithRewards

    -- ** Benchmarking
    , SeqAnyState (..)
    , mkSeqAnyState
    ) where

import Prelude

import Cardano.Address.Derivation
    ( xpubPublicKey )
import Cardano.Address.Script
    ( Cosigner (..), ScriptTemplate (..) )
import Cardano.Crypto.Wallet
    ( XPrv, XPub )
import Cardano.Wallet.Primitive.AddressDerivation
    ( DelegationAddress (..)
    , Depth (..)
    , DerivationIndex (..)
    , DerivationPrefix (..)
    , DerivationType (..)
    , HardDerivation (..)
    , Index (..)
    , KeyFingerprint (..)
    , MkKeyFingerprint (..)
    , NetworkDiscriminant (..)
    , PaymentAddress (..)
    , PersistPublicKey (..)
    , Role (..)
    , SoftDerivation (..)
    , ToRewardAccount (..)
    , WalletKey (..)
    , roleVal
    )
import Cardano.Wallet.Primitive.AddressDerivation.MintBurn
    ( derivePolicyPrivateKey )
import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
    ( SharedKey (..) )
import Cardano.Wallet.Primitive.AddressDiscovery
    ( CompareDiscovery (..)
    , GenChange (..)
    , GetAccount (..)
    , IsOurs (..)
    , IsOwned (..)
    , KnownAddresses (..)
    , MaybeLight (..)
    , PendingIxs
    , coinTypeAda
    , emptyPendingIxs
    , nextChangeIndex
    , pendingIxsToList
    , updatePendingIxs
    )
import Cardano.Wallet.Primitive.BlockSummary
    ( ChainEvents )
import Cardano.Wallet.Primitive.Passphrase
    ( Passphrase )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..), AddressState (..) )
import Cardano.Wallet.Primitive.Types.RewardAccount
    ( RewardAccount )
import Codec.Binary.Encoding
    ( AbstractEncoding (..), encode )
import Control.Applicative
    ( (<|>) )
import Control.DeepSeq
    ( NFData (..), deepseq )
import Control.Monad
    ( unless )
import Data.Bifunctor
    ( first, second )
import Data.Digest.CRC32
    ( crc32 )
import Data.Kind
    ( Type )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Proxy
    ( Proxy (..) )
import Data.Text
    ( Text )
import Data.Text.Class
    ( FromText (..), TextDecodingError (..), ToText (..) )
import Data.Text.Read
    ( decimal )
import Data.Type.Equality
    ( type (==) )
import Data.Word
    ( Word32 )
import Fmt
    ( Buildable (..), blockListF', hexF, indentF, prefixF, suffixF )
import GHC.Generics
    ( Generic )
import GHC.Stack
    ( HasCallStack )
import GHC.TypeLits
    ( KnownNat, Nat, natVal )
import Type.Reflection
    ( Typeable )

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
-------------------------------------------------------------------------------}

-- | Maximum number of consecutive undiscovered addresses allowed
newtype AddressPoolGap = AddressPoolGap
    { AddressPoolGap -> Word32
getAddressPoolGap :: Word32 }
    deriving stock ((forall x. AddressPoolGap -> Rep AddressPoolGap x)
-> (forall x. Rep AddressPoolGap x -> AddressPoolGap)
-> Generic AddressPoolGap
forall x. Rep AddressPoolGap x -> AddressPoolGap
forall x. AddressPoolGap -> Rep AddressPoolGap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddressPoolGap x -> AddressPoolGap
$cfrom :: forall x. AddressPoolGap -> Rep AddressPoolGap x
Generic, Int -> AddressPoolGap -> ShowS
[AddressPoolGap] -> ShowS
AddressPoolGap -> String
(Int -> AddressPoolGap -> ShowS)
-> (AddressPoolGap -> String)
-> ([AddressPoolGap] -> ShowS)
-> Show AddressPoolGap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressPoolGap] -> ShowS
$cshowList :: [AddressPoolGap] -> ShowS
show :: AddressPoolGap -> String
$cshow :: AddressPoolGap -> String
showsPrec :: Int -> AddressPoolGap -> ShowS
$cshowsPrec :: Int -> AddressPoolGap -> ShowS
Show, AddressPoolGap -> AddressPoolGap -> Bool
(AddressPoolGap -> AddressPoolGap -> Bool)
-> (AddressPoolGap -> AddressPoolGap -> Bool) -> Eq AddressPoolGap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressPoolGap -> AddressPoolGap -> Bool
$c/= :: AddressPoolGap -> AddressPoolGap -> Bool
== :: AddressPoolGap -> AddressPoolGap -> Bool
$c== :: AddressPoolGap -> AddressPoolGap -> Bool
Eq, Eq AddressPoolGap
Eq AddressPoolGap
-> (AddressPoolGap -> AddressPoolGap -> Ordering)
-> (AddressPoolGap -> AddressPoolGap -> Bool)
-> (AddressPoolGap -> AddressPoolGap -> Bool)
-> (AddressPoolGap -> AddressPoolGap -> Bool)
-> (AddressPoolGap -> AddressPoolGap -> Bool)
-> (AddressPoolGap -> AddressPoolGap -> AddressPoolGap)
-> (AddressPoolGap -> AddressPoolGap -> AddressPoolGap)
-> Ord AddressPoolGap
AddressPoolGap -> AddressPoolGap -> Bool
AddressPoolGap -> AddressPoolGap -> Ordering
AddressPoolGap -> AddressPoolGap -> AddressPoolGap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AddressPoolGap -> AddressPoolGap -> AddressPoolGap
$cmin :: AddressPoolGap -> AddressPoolGap -> AddressPoolGap
max :: AddressPoolGap -> AddressPoolGap -> AddressPoolGap
$cmax :: AddressPoolGap -> AddressPoolGap -> AddressPoolGap
>= :: AddressPoolGap -> AddressPoolGap -> Bool
$c>= :: AddressPoolGap -> AddressPoolGap -> Bool
> :: AddressPoolGap -> AddressPoolGap -> Bool
$c> :: AddressPoolGap -> AddressPoolGap -> Bool
<= :: AddressPoolGap -> AddressPoolGap -> Bool
$c<= :: AddressPoolGap -> AddressPoolGap -> Bool
< :: AddressPoolGap -> AddressPoolGap -> Bool
$c< :: AddressPoolGap -> AddressPoolGap -> Bool
compare :: AddressPoolGap -> AddressPoolGap -> Ordering
$ccompare :: AddressPoolGap -> AddressPoolGap -> Ordering
$cp1Ord :: Eq AddressPoolGap
Ord)

instance NFData AddressPoolGap

instance FromText AddressPoolGap where
    fromText :: Text -> Either TextDecodingError AddressPoolGap
fromText Text
t = do
        (Integer
g, Text
txt) <- (String -> TextDecodingError)
-> Either String (Integer, Text)
-> Either TextDecodingError (Integer, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TextDecodingError -> String -> TextDecodingError
forall a b. a -> b -> a
const TextDecodingError
err) (Either String (Integer, Text)
 -> Either TextDecodingError (Integer, Text))
-> Either String (Integer, Text)
-> Either TextDecodingError (Integer, Text)
forall a b. (a -> b) -> a -> b
$ Reader Integer
forall a. Integral a => Reader a
decimal Text
t
        Bool -> Either TextDecodingError () -> Either TextDecodingError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
txt) (Either TextDecodingError () -> Either TextDecodingError ())
-> Either TextDecodingError () -> Either TextDecodingError ()
forall a b. (a -> b) -> a -> b
$ TextDecodingError -> Either TextDecodingError ()
forall a b. a -> Either a b
Left TextDecodingError
err
        (MkAddressPoolGapError -> TextDecodingError)
-> Either MkAddressPoolGapError AddressPoolGap
-> Either TextDecodingError AddressPoolGap
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\case ErrGapOutOfRange{} -> TextDecodingError
err) (Integer -> Either MkAddressPoolGapError AddressPoolGap
mkAddressPoolGap Integer
g)
      where
        err :: TextDecodingError
err = String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$
            String
"An address pool gap must be a natural number between "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (AddressPoolGap -> Int
forall a. Enum a => a -> Int
fromEnum (AddressPoolGap -> Int) -> AddressPoolGap -> Int
forall a b. (a -> b) -> a -> b
$ Bounded AddressPoolGap => AddressPoolGap
forall a. Bounded a => a
minBound @AddressPoolGap)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (AddressPoolGap -> Int
forall a. Enum a => a -> Int
fromEnum (AddressPoolGap -> Int) -> AddressPoolGap -> Int
forall a b. (a -> b) -> a -> b
$ Bounded AddressPoolGap => AddressPoolGap
forall a. Bounded a => a
maxBound @AddressPoolGap)
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."

instance ToText (AddressPoolGap) where
    toText :: AddressPoolGap -> Text
toText = String -> Text
T.pack (String -> Text)
-> (AddressPoolGap -> String) -> AddressPoolGap -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String)
-> (AddressPoolGap -> Word32) -> AddressPoolGap -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressPoolGap -> Word32
getAddressPoolGap

instance Bounded AddressPoolGap where
    minBound :: AddressPoolGap
minBound = Word32 -> AddressPoolGap
AddressPoolGap Word32
10
    maxBound :: AddressPoolGap
maxBound = Word32 -> AddressPoolGap
AddressPoolGap Word32
100_000

instance Enum AddressPoolGap where
    fromEnum :: AddressPoolGap -> Int
fromEnum (AddressPoolGap Word32
g) = Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
g
    toEnum :: Int -> AddressPoolGap
toEnum Int
g
        | Word32 -> AddressPoolGap
AddressPoolGap (Int -> Word32
forall a. Enum a => Int -> a
toEnum Int
g) AddressPoolGap -> AddressPoolGap -> Bool
forall a. Ord a => a -> a -> Bool
< Bounded AddressPoolGap => AddressPoolGap
forall a. Bounded a => a
minBound @AddressPoolGap =
            String -> AddressPoolGap
forall a. HasCallStack => String -> a
error String
"AddressPoolGap.toEnum: bad argument"
        | Word32 -> AddressPoolGap
AddressPoolGap (Int -> Word32
forall a. Enum a => Int -> a
toEnum Int
g) AddressPoolGap -> AddressPoolGap -> Bool
forall a. Ord a => a -> a -> Bool
> Bounded AddressPoolGap => AddressPoolGap
forall a. Bounded a => a
maxBound @AddressPoolGap =
            String -> AddressPoolGap
forall a. HasCallStack => String -> a
error String
"AddressPoolGap.toEnum: bad argument"
        | Bool
otherwise =
            Word32 -> AddressPoolGap
AddressPoolGap (Int -> Word32
forall a. Enum a => Int -> a
toEnum Int
g)

-- | Smart constructor for 'AddressPoolGap'
mkAddressPoolGap :: Integer -> Either MkAddressPoolGapError AddressPoolGap
mkAddressPoolGap :: Integer -> Either MkAddressPoolGapError AddressPoolGap
mkAddressPoolGap !Integer
g
    | Integer
g Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AddressPoolGap -> Word32
getAddressPoolGap AddressPoolGap
forall a. Bounded a => a
minBound) Bool -> Bool -> Bool
&&
      Integer
g Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AddressPoolGap -> Word32
getAddressPoolGap AddressPoolGap
forall a. Bounded a => a
maxBound) =
        AddressPoolGap -> Either MkAddressPoolGapError AddressPoolGap
forall a b. b -> Either a b
Right (AddressPoolGap -> Either MkAddressPoolGapError AddressPoolGap)
-> AddressPoolGap -> Either MkAddressPoolGapError AddressPoolGap
forall a b. (a -> b) -> a -> b
$ Word32 -> AddressPoolGap
AddressPoolGap (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
g)
    | Bool
otherwise =
        MkAddressPoolGapError
-> Either MkAddressPoolGapError AddressPoolGap
forall a b. a -> Either a b
Left (MkAddressPoolGapError
 -> Either MkAddressPoolGapError AddressPoolGap)
-> MkAddressPoolGapError
-> Either MkAddressPoolGapError AddressPoolGap
forall a b. (a -> b) -> a -> b
$ Integer -> MkAddressPoolGapError
ErrGapOutOfRange Integer
g

-- | Constructor which allows by-passing the address pool gap boundary
-- limitations.
-- A practical use-case for this are sequential wallets for which we don't have
-- access to the whole history which therefore require using arbitrary big gaps
-- in order to discover addresses with indexes separated by possible huge gaps.
--
-- This defies a bit the purpose of this type though.
mkUnboundedAddressPoolGap :: Word32 -> AddressPoolGap
mkUnboundedAddressPoolGap :: Word32 -> AddressPoolGap
mkUnboundedAddressPoolGap = Word32 -> AddressPoolGap
AddressPoolGap

-- | Possible errors when casting to an 'AddressPoolGap'
newtype MkAddressPoolGapError = ErrGapOutOfRange Integer
    deriving (MkAddressPoolGapError -> MkAddressPoolGapError -> Bool
(MkAddressPoolGapError -> MkAddressPoolGapError -> Bool)
-> (MkAddressPoolGapError -> MkAddressPoolGapError -> Bool)
-> Eq MkAddressPoolGapError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MkAddressPoolGapError -> MkAddressPoolGapError -> Bool
$c/= :: MkAddressPoolGapError -> MkAddressPoolGapError -> Bool
== :: MkAddressPoolGapError -> MkAddressPoolGapError -> Bool
$c== :: MkAddressPoolGapError -> MkAddressPoolGapError -> Bool
Eq, Int -> MkAddressPoolGapError -> ShowS
[MkAddressPoolGapError] -> ShowS
MkAddressPoolGapError -> String
(Int -> MkAddressPoolGapError -> ShowS)
-> (MkAddressPoolGapError -> String)
-> ([MkAddressPoolGapError] -> ShowS)
-> Show MkAddressPoolGapError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MkAddressPoolGapError] -> ShowS
$cshowList :: [MkAddressPoolGapError] -> ShowS
show :: MkAddressPoolGapError -> String
$cshow :: MkAddressPoolGapError -> String
showsPrec :: Int -> MkAddressPoolGapError -> ShowS
$cshowsPrec :: Int -> MkAddressPoolGapError -> ShowS
Show)

-- | A default 'AddressPoolGap', as suggested in BIP-0044
defaultAddressPoolGap :: AddressPoolGap
defaultAddressPoolGap :: AddressPoolGap
defaultAddressPoolGap =
    Word32 -> AddressPoolGap
AddressPoolGap Word32
20

{-------------------------------------------------------------------------------
    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 {
        SeqAddressPool c key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
getPool ::
            AddressPool.Pool
                (KeyFingerprint "payment" key)
                (Index 'Soft 'AddressK)
    } deriving ((forall x. SeqAddressPool c key -> Rep (SeqAddressPool c key) x)
-> (forall x. Rep (SeqAddressPool c key) x -> SeqAddressPool c key)
-> Generic (SeqAddressPool c key)
forall x. Rep (SeqAddressPool c key) x -> SeqAddressPool c key
forall x. SeqAddressPool c key -> Rep (SeqAddressPool c key) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (c :: Role) (key :: Depth -> * -> *) x.
Rep (SeqAddressPool c key) x -> SeqAddressPool c key
forall (c :: Role) (key :: Depth -> * -> *) x.
SeqAddressPool c key -> Rep (SeqAddressPool c key) x
$cto :: forall (c :: Role) (key :: Depth -> * -> *) x.
Rep (SeqAddressPool c key) x -> SeqAddressPool c key
$cfrom :: forall (c :: Role) (key :: Depth -> * -> *) x.
SeqAddressPool c key -> Rep (SeqAddressPool c key) x
Generic, Int -> SeqAddressPool c key -> ShowS
[SeqAddressPool c key] -> ShowS
SeqAddressPool c key -> String
(Int -> SeqAddressPool c key -> ShowS)
-> (SeqAddressPool c key -> String)
-> ([SeqAddressPool c key] -> ShowS)
-> Show (SeqAddressPool c key)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: Role) (key :: Depth -> * -> *).
Int -> SeqAddressPool c key -> ShowS
forall (c :: Role) (key :: Depth -> * -> *).
[SeqAddressPool c key] -> ShowS
forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key -> String
showList :: [SeqAddressPool c key] -> ShowS
$cshowList :: forall (c :: Role) (key :: Depth -> * -> *).
[SeqAddressPool c key] -> ShowS
show :: SeqAddressPool c key -> String
$cshow :: forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key -> String
showsPrec :: Int -> SeqAddressPool c key -> ShowS
$cshowsPrec :: forall (c :: Role) (key :: Depth -> * -> *).
Int -> SeqAddressPool c key -> ShowS
Show)

instance NFData (SeqAddressPool c k)

instance Buildable (SeqAddressPool c k) where
    build :: SeqAddressPool c k -> Builder
build (SeqAddressPool Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool) = Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> Builder
forall p. Buildable p => p -> Builder
build Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool

-- | 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 :: key 'AccountK XPub -> AddressPoolGap -> SeqAddressPool c key
newSeqAddressPool key 'AccountK XPub
account AddressPoolGap
g =
    Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
forall (c :: Role) (key :: Depth -> * -> *).
Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
SeqAddressPool (Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
 -> SeqAddressPool c key)
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
forall a b. (a -> b) -> a -> b
$ (Index 'Soft 'AddressK -> KeyFingerprint "payment" key)
-> Int
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
forall addr ix.
(Ord addr, Enum ix) =>
(ix -> addr) -> Int -> Pool addr ix
AddressPool.new Index 'Soft 'AddressK -> KeyFingerprint "payment" key
addressFromIx Int
gap
  where
    gap :: Int
gap = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ AddressPoolGap -> Word32
getAddressPoolGap AddressPoolGap
g
    addressFromIx :: Index 'Soft 'AddressK -> KeyFingerprint "payment" key
addressFromIx Index 'Soft 'AddressK
ix =
        (Proxy n, key 'AddressK XPub) -> KeyFingerprint "payment" key
forall (k :: Depth -> * -> *) from.
(HasCallStack, MkKeyFingerprint k from) =>
from -> KeyFingerprint "payment" k
unsafePaymentKeyFingerprint @key
            ( Proxy n
forall k (t :: k). Proxy t
Proxy @n
            , key 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> key 'AddressK XPub
forall (key :: Depth -> * -> *).
SoftDerivation key =>
key 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> key 'AddressK XPub
deriveAddressPublicKey @key key 'AccountK XPub
account (Typeable c => Role
forall (c :: Role). Typeable c => Role
roleVal @c) Index 'Soft 'AddressK
ix
            )

getGap :: SeqAddressPool c k -> AddressPoolGap
getGap :: SeqAddressPool c k -> AddressPoolGap
getGap = Word32 -> AddressPoolGap
AddressPoolGap (Word32 -> AddressPoolGap)
-> (SeqAddressPool c k -> Word32)
-> SeqAddressPool c k
-> AddressPoolGap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> (SeqAddressPool c k -> Int) -> SeqAddressPool c k -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK) -> Int
forall addr ix. Pool addr ix -> Int
AddressPool.gap (Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK) -> Int)
-> (SeqAddressPool c k
    -> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> SeqAddressPool c k
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqAddressPool c k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
getPool

-- 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 -> KeyFingerprint "payment" k
unsafePaymentKeyFingerprint from
from = case from
-> Either (ErrMkKeyFingerprint k from) (KeyFingerprint "payment" k)
forall (key :: Depth -> * -> *) from.
MkKeyFingerprint key from =>
from
-> Either
     (ErrMkKeyFingerprint key from) (KeyFingerprint "payment" key)
paymentKeyFingerprint @k from
from of
    Right KeyFingerprint "payment" k
a -> KeyFingerprint "payment" k
a
    Left ErrMkKeyFingerprint k from
err -> String -> KeyFingerprint "payment" k
forall a. HasCallStack => String -> a
error (String -> KeyFingerprint "payment" k)
-> String -> KeyFingerprint "payment" k
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
        [ String
"unsafePaymentKeyFingerprint was given a source invalid with its"
        , String
"key type:"
        , ErrMkKeyFingerprint k from -> String
forall a. Show a => a -> String
show ErrMkKeyFingerprint k from
err
        ]

{-------------------------------------------------------------------------------
    Pretty printing
-------------------------------------------------------------------------------}

instance PersistPublicKey (key 'AccountK) => Buildable (key 'AccountK XPub) where
    build :: key 'AccountK XPub -> Builder
build key 'AccountK XPub
key = Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
prefixF Int
8 Builder
xpubF Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"..." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
suffixF Int
8 Builder
xpubF
      where
        xpubF :: Builder
xpubF = ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ key 'AccountK XPub -> ByteString
forall (key :: * -> *).
PersistPublicKey key =>
key XPub -> ByteString
serializeXPub key 'AccountK XPub
key

instance PersistPublicKey (key 'PolicyK) => Buildable (key 'PolicyK XPub) where
    build :: key 'PolicyK XPub -> Builder
build key 'PolicyK XPub
key = Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
prefixF Int
8 Builder
xpubF Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"..." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
suffixF Int
8 Builder
xpubF
      where
        xpubF :: Builder
xpubF = ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ key 'PolicyK XPub -> ByteString
forall (key :: * -> *).
PersistPublicKey key =>
key XPub -> ByteString
serializeXPub key 'PolicyK XPub
key

instance Buildable (ScriptTemplate, Maybe ScriptTemplate) where
    build :: (ScriptTemplate, Maybe ScriptTemplate) -> Builder
build (ScriptTemplate
paymentTemplate, Maybe ScriptTemplate
delegationTemplateM) =
        Builder
forall a. Monoid a => a
mempty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" payment script credential: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
scriptPaymentF Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
" delegation script credential: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
scriptDelegationF
      where
        scriptPaymentF :: Builder
scriptPaymentF = ScriptTemplate -> Builder
forall p. Buildable p => p -> Builder
build ScriptTemplate
paymentTemplate
        scriptDelegationF :: Builder
scriptDelegationF = Builder
-> (ScriptTemplate -> Builder) -> Maybe ScriptTemplate -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"absent" ScriptTemplate -> Builder
forall p. Buildable p => p -> Builder
build Maybe ScriptTemplate
delegationTemplateM

accXPubTxt :: XPub -> Text
accXPubTxt :: XPub -> Text
accXPubTxt XPub
xpub =
    let keyFormatted :: Text
keyFormatted = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase16 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> ByteString
xpubPublicKey XPub
xpub
    in Int -> Text -> Text
T.take Int
8 Text
keyFormatted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.takeEnd Int
8 Text
keyFormatted

instance Buildable ScriptTemplate where
    build :: ScriptTemplate -> Builder
build (ScriptTemplate Map Cosigner XPub
cosignersMap Script Cosigner
script') = Builder
forall a. Monoid a => a
mempty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"Cosigners:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build (Map Cosigner XPub -> Text
presentCosigners Map Cosigner XPub
cosignersMap) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
" Script:" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build (String -> Text
T.pack (Script Cosigner -> String
forall a. Show a => a -> String
show Script Cosigner
script'))
      where
        printCosigner :: Cosigner -> Text
printCosigner (Cosigner Word8
ix) =
            Text
"cosigner#"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word8 -> String
forall a. Show a => a -> String
show Word8
ix)
        presentCosigners :: Map Cosigner XPub -> Text
presentCosigners =
            (Cosigner -> XPub -> Text -> Text)
-> Text -> Map Cosigner XPub -> Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\Cosigner
c XPub
k Text
acc -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"| " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Cosigner -> Text
printCosigner Cosigner
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> XPub -> Text
accXPubTxt XPub
k ) Text
forall a. Monoid a => a
mempty

{-------------------------------------------------------------------------------
    SeqState
-------------------------------------------------------------------------------}

-- | A state to keep track of sequential addresses as described in
-- [BIP-44](https://github.com/bitcoin/bips/blob/master/bip-0044.mediawiki)
--
-- Internally, the state keeps track of a few things for us and is it is
-- 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
    { SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool :: !(SeqAddressPool 'UtxoInternal k)
        -- ^ Addresses living on the 'UtxoInternal'
    , SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool :: !(SeqAddressPool 'UtxoExternal k)
        -- ^ Addresses living on the 'UtxoExternal'
    , SeqState n k -> PendingIxs 'AddressK
pendingChangeIxs :: !(PendingIxs 'AddressK)
        -- ^ Indexes from the internal pool that have been used in pending
        -- transactions. The list is maintained sorted in descending order
        -- (cf: 'PendingIxs')
    , SeqState n k -> k 'AccountK XPub
accountXPub :: k 'AccountK XPub
        -- ^ The account public key associated with this state
    , SeqState n k -> Maybe (k 'PolicyK XPub)
policyXPub :: Maybe (k 'PolicyK XPub)
        -- ^ The policy public key associated with this state derived for
        -- policy key hardened index=0
    , SeqState n k -> k 'AddressK XPub
rewardAccountKey :: k 'AddressK XPub
        -- ^ Reward account public key associated with this wallet
    , SeqState n k -> DerivationPrefix
derivationPrefix :: DerivationPrefix
        -- ^ Derivation path prefix from a root key up to the internal account
    }
    deriving stock ((forall x. SeqState n k -> Rep (SeqState n k) x)
-> (forall x. Rep (SeqState n k) x -> SeqState n k)
-> Generic (SeqState n k)
forall x. Rep (SeqState n k) x -> SeqState n k
forall x. SeqState n k -> Rep (SeqState n k) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *) x.
Rep (SeqState n k) x -> SeqState n k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *) x.
SeqState n k -> Rep (SeqState n k) x
$cto :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *) x.
Rep (SeqState n k) x -> SeqState n k
$cfrom :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *) x.
SeqState n k -> Rep (SeqState n k) x
Generic)

deriving instance
    ( Show (k 'AccountK XPub)
    , Show (k 'AddressK XPub)
    , Show (k 'PolicyK XPub)
    , Show (KeyFingerprint "payment" k)
    ) => Show (SeqState n k)

instance
    ( NFData (k 'AccountK XPub)
    , NFData (k 'AddressK XPub)
    , NFData (k 'PolicyK XPub)
    , NFData (KeyFingerprint "payment" k)
    )
    => NFData (SeqState n k)

-- Hand-written, because 'AddressPool.Pool' is not an instance of 'Eq'.
instance
    ( Eq (k 'AccountK XPub)
    , Eq (k 'AddressK XPub)
    , Eq (k 'PolicyK XPub)
    , Eq (KeyFingerprint "payment" k)
    ) => Eq (SeqState n k)
  where
    SeqState SeqAddressPool 'UtxoInternal k
ai SeqAddressPool 'UtxoExternal k
ae PendingIxs 'AddressK
a1 k 'AccountK XPub
a2 Maybe (k 'PolicyK XPub)
a3 k 'AddressK XPub
a4 DerivationPrefix
a5 == :: SeqState n k -> SeqState n k -> Bool
== SeqState SeqAddressPool 'UtxoInternal k
bi SeqAddressPool 'UtxoExternal k
be PendingIxs 'AddressK
b1 k 'AccountK XPub
b2 Maybe (k 'PolicyK XPub)
b3 k 'AddressK XPub
b4 DerivationPrefix
b5
        = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [PendingIxs 'AddressK
a1 PendingIxs 'AddressK -> PendingIxs 'AddressK -> Bool
forall a. Eq a => a -> a -> Bool
== PendingIxs 'AddressK
b1, k 'AccountK XPub
a2 k 'AccountK XPub -> k 'AccountK XPub -> Bool
forall a. Eq a => a -> a -> Bool
== k 'AccountK XPub
b2, Maybe (k 'PolicyK XPub)
a3 Maybe (k 'PolicyK XPub) -> Maybe (k 'PolicyK XPub) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (k 'PolicyK XPub)
b3, k 'AddressK XPub
a4 k 'AddressK XPub -> k 'AddressK XPub -> Bool
forall a. Eq a => a -> a -> Bool
== k 'AddressK XPub
b4, DerivationPrefix
a5 DerivationPrefix -> DerivationPrefix -> Bool
forall a. Eq a => a -> a -> Bool
== DerivationPrefix
b5
            , SeqAddressPool 'UtxoExternal k
ae SeqAddressPool 'UtxoExternal k
-> SeqAddressPool 'UtxoExternal k -> Bool
forall (c :: Role) (key :: Depth -> * -> *) (c :: Role).
SeqAddressPool c key -> SeqAddressPool c key -> Bool
`match` SeqAddressPool 'UtxoExternal k
be, SeqAddressPool 'UtxoInternal k
ai SeqAddressPool 'UtxoInternal k
-> SeqAddressPool 'UtxoInternal k -> Bool
forall (c :: Role) (key :: Depth -> * -> *) (c :: Role).
SeqAddressPool c key -> SeqAddressPool c key -> Bool
`match` SeqAddressPool 'UtxoInternal k
bi
            ]
      where
        match :: SeqAddressPool c key -> SeqAddressPool c key -> Bool
match (SeqAddressPool Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
a) (SeqAddressPool Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
b)
            = Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> Map
     (KeyFingerprint "payment" key)
     (Index 'Soft 'AddressK, AddressState)
forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
AddressPool.addresses Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
a Map
  (KeyFingerprint "payment" key)
  (Index 'Soft 'AddressK, AddressState)
-> Map
     (KeyFingerprint "payment" key)
     (Index 'Soft 'AddressK, AddressState)
-> Bool
forall a. Eq a => a -> a -> Bool
== Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> Map
     (KeyFingerprint "payment" key)
     (Index 'Soft 'AddressK, AddressState)
forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
AddressPool.addresses Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
b
            Bool -> Bool -> Bool
&& Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK) -> Int
forall addr ix. Pool addr ix -> Int
AddressPool.gap Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK) -> Int
forall addr ix. Pool addr ix -> Int
AddressPool.gap Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
b

instance Buildable (SeqState n k) where
    build :: SeqState n k -> Builder
build SeqState n k
st = Builder
"SeqState:\n"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (Builder
"Derivation prefix: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
build (DerivationPrefix -> Text
forall a. ToText a => a -> Text
toText (SeqState n k -> DerivationPrefix
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> DerivationPrefix
derivationPrefix SeqState n k
st)))
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (SeqAddressPool 'UtxoInternal k -> Builder
forall p. Buildable p => p -> Builder
build (SeqAddressPool 'UtxoInternal k -> Builder)
-> SeqAddressPool 'UtxoInternal k -> Builder
forall a b. (a -> b) -> a -> b
$ SeqState n k -> SeqAddressPool 'UtxoInternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool SeqState n k
st)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (SeqAddressPool 'UtxoExternal k -> Builder
forall p. Buildable p => p -> Builder
build (SeqAddressPool 'UtxoExternal k -> Builder)
-> SeqAddressPool 'UtxoExternal k -> Builder
forall a b. (a -> b) -> a -> b
$ SeqState n k -> SeqAddressPool 'UtxoExternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool SeqState n k
st)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (Builder
"Change indexes: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 Builder
chgsF)
      where
        chgsF :: Builder
chgsF = Text
-> (Index 'Soft 'AddressK -> Builder)
-> [Index 'Soft 'AddressK]
-> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"-" Index 'Soft 'AddressK -> Builder
forall p. Buildable p => p -> Builder
build (PendingIxs 'AddressK -> [Index 'Soft 'AddressK]
forall (k :: Depth). PendingIxs k -> [Index 'Soft k]
pendingIxsToList (PendingIxs 'AddressK -> [Index 'Soft 'AddressK])
-> PendingIxs 'AddressK -> [Index 'Soft 'AddressK]
forall a b. (a -> b) -> a -> b
$ SeqState n k -> PendingIxs 'AddressK
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> PendingIxs 'AddressK
pendingChangeIxs SeqState n k
st)

-- | Purpose is a constant set to 44' (or 0x8000002C) following the original
-- BIP-44 specification.
--
-- It indicates that the subtree of this node is used according to this
-- specification.
--
-- Hardened derivation is used at this level.
purposeBIP44 :: Index 'Hardened 'PurposeK
purposeBIP44 :: Index 'Hardened 'PurposeK
purposeBIP44 = Int -> Index 'Hardened 'PurposeK
forall a. Enum a => Int -> a
toEnum Int
0x8000002C

-- | Purpose is a constant set to 1852' (or 0x8000073c) following the BIP-44
-- extension for Cardano:
--
-- https://github.com/input-output-hk/implementation-decisions/blob/e2d1bed5e617f0907bc5e12cf1c3f3302a4a7c42/text/1852-hd-chimeric.md
--
-- It indicates that the subtree of this node is used according to this
-- specification.
--
-- Hardened derivation is used at this level.
purposeCIP1852 :: Index 'Hardened 'PurposeK
purposeCIP1852 :: Index 'Hardened 'PurposeK
purposeCIP1852 = Int -> Index 'Hardened 'PurposeK
forall a. Enum a => Int -> a
toEnum Int
0x8000073c

-- | Construct a Sequential state for a wallet from root private key and password.
mkSeqStateFromRootXPrv
    :: forall n k.
        ( WalletKey k
        , SupportsDiscovery n k
        , (k == SharedKey) ~ 'False
        )
    => (k 'RootK XPrv, Passphrase "encryption")
    -> Index 'Hardened 'PurposeK
    -> AddressPoolGap
    -> SeqState n k
mkSeqStateFromRootXPrv :: (k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k
mkSeqStateFromRootXPrv (k 'RootK XPrv
rootXPrv, Passphrase "encryption"
pwd) =
    k 'AccountK XPub
-> Maybe (k 'PolicyK XPub)
-> Index 'Hardened 'PurposeK
-> AddressPoolGap
-> SeqState n k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
(SupportsDiscovery n k, (k == SharedKey) ~ 'False) =>
k 'AccountK XPub
-> Maybe (k 'PolicyK XPub)
-> Index 'Hardened 'PurposeK
-> AddressPoolGap
-> SeqState n k
mkSeqStateFromAccountXPub
        (k 'AccountK XPrv -> k 'AccountK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey (k 'AccountK XPrv -> k 'AccountK XPub)
-> k 'AccountK XPrv -> k 'AccountK XPub
forall a b. (a -> b) -> a -> b
$ Passphrase "encryption"
-> k 'RootK XPrv -> Index 'Hardened 'AccountK -> k 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'RootK XPrv
-> Index 'Hardened 'AccountK
-> key 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
pwd k 'RootK XPrv
rootXPrv Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound)
            (Maybe (k 'PolicyK XPub)
 -> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k)
-> Maybe (k 'PolicyK XPub)
-> Index 'Hardened 'PurposeK
-> AddressPoolGap
-> SeqState n k
forall a b. (a -> b) -> a -> b
$ k 'PolicyK XPub -> Maybe (k 'PolicyK XPub)
forall a. a -> Maybe a
Just
            (k 'PolicyK XPub -> Maybe (k 'PolicyK XPub))
-> k 'PolicyK XPub -> Maybe (k 'PolicyK XPub)
forall a b. (a -> b) -> a -> b
$ k 'PolicyK XPrv -> k 'PolicyK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey
            (k 'PolicyK XPrv -> k 'PolicyK XPub)
-> k 'PolicyK XPrv -> k 'PolicyK XPub
forall a b. (a -> b) -> a -> b
$ XPrv -> k 'PolicyK XPrv
forall (key :: Depth -> * -> *) raw (depth :: Depth).
WalletKey key =>
raw -> key depth raw
liftRawKey
            (XPrv -> k 'PolicyK XPrv) -> XPrv -> k 'PolicyK XPrv
forall a b. (a -> b) -> a -> b
$ Passphrase "encryption" -> XPrv -> Index 'Hardened 'PolicyK -> XPrv
forall (purpose :: Symbol).
Passphrase purpose -> XPrv -> Index 'Hardened 'PolicyK -> XPrv
derivePolicyPrivateKey Passphrase "encryption"
pwd (k 'RootK XPrv -> XPrv
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey k 'RootK XPrv
rootXPrv) Index 'Hardened 'PolicyK
forall a. Bounded a => a
minBound

-- | Construct a Sequential state for a wallet from public account key.
mkSeqStateFromAccountXPub
    :: forall (n :: NetworkDiscriminant) k.
        ( SupportsDiscovery n k
        , (k == SharedKey) ~ 'False
        )
    => k 'AccountK XPub
    -> Maybe (k 'PolicyK XPub)
    -> Index 'Hardened 'PurposeK
    -> AddressPoolGap
    -> SeqState n k
mkSeqStateFromAccountXPub :: k 'AccountK XPub
-> Maybe (k 'PolicyK XPub)
-> Index 'Hardened 'PurposeK
-> AddressPoolGap
-> SeqState n k
mkSeqStateFromAccountXPub k 'AccountK XPub
accXPub Maybe (k 'PolicyK XPub)
policyXPubM Index 'Hardened 'PurposeK
purpose AddressPoolGap
g = SeqState :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqAddressPool 'UtxoInternal k
-> SeqAddressPool 'UtxoExternal k
-> PendingIxs 'AddressK
-> k 'AccountK XPub
-> Maybe (k 'PolicyK XPub)
-> k 'AddressK XPub
-> DerivationPrefix
-> SeqState n k
SeqState
    { internalPool :: SeqAddressPool 'UtxoInternal k
internalPool = k 'AccountK XPub
-> AddressPoolGap -> SeqAddressPool 'UtxoInternal k
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(SupportsDiscovery n key, Typeable c) =>
key 'AccountK XPub -> AddressPoolGap -> SeqAddressPool c key
newSeqAddressPool @n k 'AccountK XPub
accXPub AddressPoolGap
g
    , externalPool :: SeqAddressPool 'UtxoExternal k
externalPool = k 'AccountK XPub
-> AddressPoolGap -> SeqAddressPool 'UtxoExternal k
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(SupportsDiscovery n key, Typeable c) =>
key 'AccountK XPub -> AddressPoolGap -> SeqAddressPool c key
newSeqAddressPool @n k 'AccountK XPub
accXPub AddressPoolGap
g
    , accountXPub :: k 'AccountK XPub
accountXPub = k 'AccountK XPub
accXPub
    , policyXPub :: Maybe (k 'PolicyK XPub)
policyXPub = Maybe (k 'PolicyK XPub)
policyXPubM
    , rewardAccountKey :: k 'AddressK XPub
rewardAccountKey = k 'AddressK XPub
rewardXPub
    , pendingChangeIxs :: PendingIxs 'AddressK
pendingChangeIxs = PendingIxs 'AddressK
forall (k :: Depth). PendingIxs k
emptyPendingIxs
    , derivationPrefix :: DerivationPrefix
derivationPrefix = (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
 Index 'Hardened 'AccountK)
-> DerivationPrefix
DerivationPrefix ( Index 'Hardened 'PurposeK
purpose, Index 'Hardened 'CoinTypeK
coinTypeAda, Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound )
    }
  where
    -- This matches the reward address for "normal wallets". The accountXPub
    -- is the first account, minBound being the first Soft index
    rewardXPub :: k 'AddressK XPub
rewardXPub = k 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (key :: Depth -> * -> *).
SoftDerivation key =>
key 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> key 'AddressK XPub
deriveAddressPublicKey k 'AccountK XPub
accXPub Role
MutableAccount Index 'Soft 'AddressK
forall a. Bounded a => a
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 n k
-> Role -> Index 'Soft 'AddressK -> NonEmpty DerivationIndex
decoratePath SeqState{DerivationPrefix
derivationPrefix :: DerivationPrefix
derivationPrefix :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> DerivationPrefix
derivationPrefix} Role
r Index 'Soft 'AddressK
ix = [DerivationIndex] -> NonEmpty DerivationIndex
forall a. [a] -> NonEmpty a
NE.fromList
    [ Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Hardened 'PurposeK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'PurposeK
purpose
    , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Hardened 'CoinTypeK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'CoinTypeK
coinType
    , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Hardened 'AccountK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'AccountK
accountIx
    , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Role -> Int
forall a. Enum a => a -> Int
fromEnum Role
r
    , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Soft 'AddressK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Soft 'AddressK
ix
    ]
  where
    DerivationPrefix (Index 'Hardened 'PurposeK
purpose, Index 'Hardened 'CoinTypeK
coinType, Index 'Hardened 'AccountK
accountIx) = DerivationPrefix
derivationPrefix

-- NOTE
-- We have to scan both the internal and external chain. Note that, the
-- 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 SupportsDiscovery n k => IsOurs (SeqState n k) Address where
    isOurs :: Address
-> SeqState n k -> (Maybe (NonEmpty DerivationIndex), SeqState n k)
isOurs Address
addrRaw st :: SeqState n k
st@SeqState{pendingChangeIxs :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> PendingIxs 'AddressK
pendingChangeIxs=PendingIxs 'AddressK
ixs} =
        -- FIXME LATER: Check that the network discrimant of the type
        -- is compatible with the discriminant of the Address!
        case Address
-> Either
     (ErrMkKeyFingerprint k Address) (KeyFingerprint "payment" k)
forall (key :: Depth -> * -> *) from.
MkKeyFingerprint key from =>
from
-> Either
     (ErrMkKeyFingerprint key from) (KeyFingerprint "payment" key)
paymentKeyFingerprint Address
addrRaw of
            Left ErrMkKeyFingerprint k Address
_ -> (Maybe (NonEmpty DerivationIndex)
forall a. Maybe a
Nothing, SeqState n k
st)
            Right KeyFingerprint "payment" k
addr ->
                let (Maybe (Index 'Soft 'AddressK)
internal, !SeqAddressPool 'UtxoInternal k
int) = KeyFingerprint "payment" k
-> SeqAddressPool 'UtxoInternal k
-> (Maybe (Index 'Soft 'AddressK), SeqAddressPool 'UtxoInternal k)
forall (key :: Depth -> * -> *) (c :: Role) (c :: Role).
KeyFingerprint "payment" key
-> SeqAddressPool c key
-> (Maybe (Index 'Soft 'AddressK), SeqAddressPool c key)
lookupAddress KeyFingerprint "payment" k
addr (SeqState n k -> SeqAddressPool 'UtxoInternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool SeqState n k
st)
                    (Maybe (Index 'Soft 'AddressK)
external, !SeqAddressPool 'UtxoExternal k
ext) = KeyFingerprint "payment" k
-> SeqAddressPool 'UtxoExternal k
-> (Maybe (Index 'Soft 'AddressK), SeqAddressPool 'UtxoExternal k)
forall (key :: Depth -> * -> *) (c :: Role) (c :: Role).
KeyFingerprint "payment" key
-> SeqAddressPool c key
-> (Maybe (Index 'Soft 'AddressK), SeqAddressPool c key)
lookupAddress KeyFingerprint "payment" k
addr (SeqState n k -> SeqAddressPool 'UtxoExternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool SeqState n k
st)

                    !ixs' :: PendingIxs 'AddressK
ixs' = case Maybe (Index 'Soft 'AddressK)
internal of
                        Maybe (Index 'Soft 'AddressK)
Nothing -> PendingIxs 'AddressK
ixs
                        Just Index 'Soft 'AddressK
ix -> Index 'Soft 'AddressK
-> PendingIxs 'AddressK -> PendingIxs 'AddressK
forall (k :: Depth). Index 'Soft k -> PendingIxs k -> PendingIxs k
updatePendingIxs Index 'Soft 'AddressK
ix PendingIxs 'AddressK
ixs

                    ours :: Maybe (NonEmpty DerivationIndex)
ours = case (Maybe (Index 'Soft 'AddressK)
external, Maybe (Index 'Soft 'AddressK)
internal) of
                        (Just Index 'Soft 'AddressK
ix, Maybe (Index 'Soft 'AddressK)
_) -> NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just (NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex))
-> NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ SeqState n k
-> Role -> Index 'Soft 'AddressK -> NonEmpty DerivationIndex
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k
-> Role -> Index 'Soft 'AddressK -> NonEmpty DerivationIndex
decoratePath SeqState n k
st Role
UtxoExternal Index 'Soft 'AddressK
ix
                        (Maybe (Index 'Soft 'AddressK)
_, Just Index 'Soft 'AddressK
ix) -> NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just (NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex))
-> NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ SeqState n k
-> Role -> Index 'Soft 'AddressK -> NonEmpty DerivationIndex
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k
-> Role -> Index 'Soft 'AddressK -> NonEmpty DerivationIndex
decoratePath SeqState n k
st Role
UtxoInternal Index 'Soft 'AddressK
ix
                        (Maybe (Index 'Soft 'AddressK), Maybe (Index 'Soft 'AddressK))
_ -> Maybe (NonEmpty DerivationIndex)
forall a. Maybe a
Nothing
                in
                    ( PendingIxs 'AddressK
ixs' PendingIxs 'AddressK
-> Maybe (NonEmpty DerivationIndex)
-> Maybe (NonEmpty DerivationIndex)
forall a b. NFData a => a -> b -> b
`deepseq` Maybe (NonEmpty DerivationIndex)
ours Maybe (NonEmpty DerivationIndex)
-> Maybe (NonEmpty DerivationIndex)
-> Maybe (NonEmpty DerivationIndex)
forall a b. NFData a => a -> b -> b
`deepseq` Maybe (NonEmpty DerivationIndex)
ours
                    , SeqState n k
st
                        { internalPool :: SeqAddressPool 'UtxoInternal k
internalPool = SeqAddressPool 'UtxoInternal k
int
                        , externalPool :: SeqAddressPool 'UtxoExternal k
externalPool = SeqAddressPool 'UtxoExternal k
ext
                        , pendingChangeIxs :: PendingIxs 'AddressK
pendingChangeIxs = PendingIxs 'AddressK
ixs'
                        }
                    )
      where
        lookupAddress :: KeyFingerprint "payment" key
-> SeqAddressPool c key
-> (Maybe (Index 'Soft 'AddressK), SeqAddressPool c key)
lookupAddress KeyFingerprint "payment" key
addr (SeqAddressPool Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
pool) =
            case KeyFingerprint "payment" key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> Maybe (Index 'Soft 'AddressK)
forall addr ix. Ord addr => addr -> Pool addr ix -> Maybe ix
AddressPool.lookup KeyFingerprint "payment" key
addr Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
pool of
                Maybe (Index 'Soft 'AddressK)
Nothing -> (Maybe (Index 'Soft 'AddressK)
forall a. Maybe a
Nothing, Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
forall (c :: Role) (key :: Depth -> * -> *).
Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
SeqAddressPool Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
pool)
                Just Index 'Soft 'AddressK
ix -> (Index 'Soft 'AddressK -> Maybe (Index 'Soft 'AddressK)
forall a. a -> Maybe a
Just Index 'Soft 'AddressK
ix, Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
forall (c :: Role) (key :: Depth -> * -> *).
Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
SeqAddressPool (Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
 -> SeqAddressPool c key)
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
forall a b. (a -> b) -> a -> b
$ KeyFingerprint "payment" key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
forall addr ix.
(Ord addr, Enum ix) =>
addr -> Pool addr ix -> Pool addr ix
AddressPool.update KeyFingerprint "payment" key
addr Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
pool)

instance
    ( SoftDerivation k
    ) => GenChange (SeqState n k) where
    -- | We pick indexes in sequence from the first known available index (i.e.
    -- @length addrs - gap@) but we do not generate _new change addresses_. As a
    -- result, we can't generate more than @gap@ _pending_ change addresses and
    -- therefore, rotate the change addresses when we need extra change outputs.
    --
    -- See also: 'nextChangeIndex'
    type ArgGenChange (SeqState n k) =
        (k 'AddressK XPub -> k 'AddressK XPub -> Address)

    genChange :: ArgGenChange (SeqState n k)
-> SeqState n k -> (Address, SeqState n k)
genChange ArgGenChange (SeqState n k)
mkAddress SeqState n k
st =
        (Address
addr, SeqState n k
st{ pendingChangeIxs :: PendingIxs 'AddressK
pendingChangeIxs = PendingIxs 'AddressK
pending' })
      where
        (Index 'Soft 'AddressK
ix, PendingIxs 'AddressK
pending') =
            Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> PendingIxs 'AddressK
-> (Index 'Soft 'AddressK, PendingIxs 'AddressK)
forall (key :: Depth -> * -> *) (k :: Depth).
Pool (KeyFingerprint "payment" key) (Index 'Soft k)
-> PendingIxs k -> (Index 'Soft k, PendingIxs k)
nextChangeIndex (SeqAddressPool 'UtxoInternal k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
getPool (SeqAddressPool 'UtxoInternal k
 -> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> SeqAddressPool 'UtxoInternal k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall a b. (a -> b) -> a -> b
$ SeqState n k -> SeqAddressPool 'UtxoInternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool SeqState n k
st) (SeqState n k -> PendingIxs 'AddressK
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> PendingIxs 'AddressK
pendingChangeIxs SeqState n k
st)
        addressXPub :: k 'AddressK XPub
addressXPub = k 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (key :: Depth -> * -> *).
SoftDerivation key =>
key 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> key 'AddressK XPub
deriveAddressPublicKey (SeqState n k -> k 'AccountK XPub
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> k 'AccountK XPub
accountXPub SeqState n k
st) Role
UtxoInternal Index 'Soft 'AddressK
ix
        addr :: Address
addr = ArgGenChange (SeqState n k)
k 'AddressK XPub -> k 'AddressK XPub -> Address
mkAddress k 'AddressK XPub
addressXPub (SeqState n k -> k 'AddressK XPub
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> k 'AddressK XPub
rewardAccountKey SeqState n k
st)

instance
    ( IsOurs (SeqState n k) Address
    , SupportsDiscovery n k
    , AddressIndexDerivationType k ~ 'Soft
    )
    => IsOwned (SeqState n k) k where
    isOwned :: SeqState n k
-> (k 'RootK XPrv, Passphrase "encryption")
-> Address
-> Maybe (k 'AddressK XPrv, Passphrase "encryption")
isOwned SeqState n k
st (k 'RootK XPrv
rootPrv, Passphrase "encryption"
pwd) Address
addrRaw =
        case Address
-> Either
     (ErrMkKeyFingerprint k Address) (KeyFingerprint "payment" k)
forall (key :: Depth -> * -> *) from.
MkKeyFingerprint key from =>
from
-> Either
     (ErrMkKeyFingerprint key from) (KeyFingerprint "payment" key)
paymentKeyFingerprint Address
addrRaw of
            Left ErrMkKeyFingerprint k Address
_ -> Maybe (k 'AddressK XPrv, Passphrase "encryption")
forall a. Maybe a
Nothing
            Right KeyFingerprint "payment" k
addr ->
                let
                    xPrv1 :: Maybe (k 'AddressK XPrv)
xPrv1 = KeyFingerprint "payment" k
-> SeqAddressPool 'UtxoInternal k -> Maybe (k 'AddressK XPrv)
forall (c :: Role).
Typeable c =>
KeyFingerprint "payment" k
-> SeqAddressPool c k -> Maybe (k 'AddressK XPrv)
lookupAndDeriveXPrv KeyFingerprint "payment" k
addr (SeqState n k -> SeqAddressPool 'UtxoInternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool SeqState n k
st)
                    xPrv2 :: Maybe (k 'AddressK XPrv)
xPrv2 = KeyFingerprint "payment" k
-> SeqAddressPool 'UtxoExternal k -> Maybe (k 'AddressK XPrv)
forall (c :: Role).
Typeable c =>
KeyFingerprint "payment" k
-> SeqAddressPool c k -> Maybe (k 'AddressK XPrv)
lookupAndDeriveXPrv KeyFingerprint "payment" k
addr (SeqState n k -> SeqAddressPool 'UtxoExternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool SeqState n k
st)
                    xPrv :: Maybe (k 'AddressK XPrv)
xPrv = Maybe (k 'AddressK XPrv)
xPrv1 Maybe (k 'AddressK XPrv)
-> Maybe (k 'AddressK XPrv) -> Maybe (k 'AddressK XPrv)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (k 'AddressK XPrv)
xPrv2
                in
                    (,Passphrase "encryption"
pwd) (k 'AddressK XPrv -> (k 'AddressK XPrv, Passphrase "encryption"))
-> Maybe (k 'AddressK XPrv)
-> Maybe (k 'AddressK XPrv, Passphrase "encryption")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (k 'AddressK XPrv)
xPrv
      where
        -- We are assuming there is only one account
        accountPrv :: k 'AccountK XPrv
accountPrv = Passphrase "encryption"
-> k 'RootK XPrv -> Index 'Hardened 'AccountK -> k 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'RootK XPrv
-> Index 'Hardened 'AccountK
-> key 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
pwd k 'RootK XPrv
rootPrv Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound

        lookupAndDeriveXPrv
            :: forall c. (Typeable c)
            => KeyFingerprint "payment" k
            -> SeqAddressPool c k
            -> Maybe (k 'AddressK XPrv)
        lookupAndDeriveXPrv :: KeyFingerprint "payment" k
-> SeqAddressPool c k -> Maybe (k 'AddressK XPrv)
lookupAndDeriveXPrv KeyFingerprint "payment" k
addr (SeqAddressPool Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool) =
                Passphrase "encryption"
-> k 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType k) 'AddressK
-> k 'AddressK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType key) 'AddressK
-> key 'AddressK XPrv
deriveAddressPrivateKey Passphrase "encryption"
pwd k 'AccountK XPrv
accountPrv (Typeable c => Role
forall (c :: Role). Typeable c => Role
roleVal @c)
            (Index 'Soft 'AddressK -> k 'AddressK XPrv)
-> Maybe (Index 'Soft 'AddressK) -> Maybe (k 'AddressK XPrv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyFingerprint "payment" k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> Maybe (Index 'Soft 'AddressK)
forall addr ix. Ord addr => addr -> Pool addr ix -> Maybe ix
AddressPool.lookup KeyFingerprint "payment" k
addr Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool

instance SupportsDiscovery n k => CompareDiscovery (SeqState n k) where
    compareDiscovery :: SeqState n k -> Address -> Address -> Ordering
compareDiscovery (SeqState !SeqAddressPool 'UtxoInternal k
s1 !SeqAddressPool 'UtxoExternal k
s2 PendingIxs 'AddressK
_ k 'AccountK XPub
_ Maybe (k 'PolicyK XPub)
_ k 'AddressK XPub
_ DerivationPrefix
_) Address
a1 Address
a2 =
        case (Address
-> SeqAddressPool 'UtxoInternal k -> Maybe (Index 'Soft 'AddressK)
forall (c :: Role).
Address -> SeqAddressPool c k -> Maybe (Index 'Soft 'AddressK)
ix Address
a1 SeqAddressPool 'UtxoInternal k
s1 Maybe (Index 'Soft 'AddressK)
-> Maybe (Index 'Soft 'AddressK) -> Maybe (Index 'Soft 'AddressK)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Address
-> SeqAddressPool 'UtxoExternal k -> Maybe (Index 'Soft 'AddressK)
forall (c :: Role).
Address -> SeqAddressPool c k -> Maybe (Index 'Soft 'AddressK)
ix Address
a1 SeqAddressPool 'UtxoExternal k
s2, Address
-> SeqAddressPool 'UtxoInternal k -> Maybe (Index 'Soft 'AddressK)
forall (c :: Role).
Address -> SeqAddressPool c k -> Maybe (Index 'Soft 'AddressK)
ix Address
a2 SeqAddressPool 'UtxoInternal k
s1 Maybe (Index 'Soft 'AddressK)
-> Maybe (Index 'Soft 'AddressK) -> Maybe (Index 'Soft 'AddressK)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Address
-> SeqAddressPool 'UtxoExternal k -> Maybe (Index 'Soft 'AddressK)
forall (c :: Role).
Address -> SeqAddressPool c k -> Maybe (Index 'Soft 'AddressK)
ix Address
a2 SeqAddressPool 'UtxoExternal k
s2) of
            (Maybe (Index 'Soft 'AddressK)
Nothing, Maybe (Index 'Soft 'AddressK)
Nothing) -> Ordering
EQ
            (Maybe (Index 'Soft 'AddressK)
Nothing, Just Index 'Soft 'AddressK
_)  -> Ordering
GT
            (Just Index 'Soft 'AddressK
_, Maybe (Index 'Soft 'AddressK)
Nothing)  -> Ordering
LT
            (Just Index 'Soft 'AddressK
i1, Just Index 'Soft 'AddressK
i2) -> Index 'Soft 'AddressK -> Index 'Soft 'AddressK -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Index 'Soft 'AddressK
i1 Index 'Soft 'AddressK
i2
      where
        ix :: Address -> SeqAddressPool c k -> Maybe (Index 'Soft 'AddressK)
        ix :: Address -> SeqAddressPool c k -> Maybe (Index 'Soft 'AddressK)
ix Address
a (SeqAddressPool Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool) = case Address
-> Either
     (ErrMkKeyFingerprint k Address) (KeyFingerprint "payment" k)
forall (key :: Depth -> * -> *) from.
MkKeyFingerprint key from =>
from
-> Either
     (ErrMkKeyFingerprint key from) (KeyFingerprint "payment" key)
paymentKeyFingerprint Address
a of
            Left ErrMkKeyFingerprint k Address
_ -> Maybe (Index 'Soft 'AddressK)
forall a. Maybe a
Nothing
            Right KeyFingerprint "payment" k
addr -> KeyFingerprint "payment" k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> Maybe (Index 'Soft 'AddressK)
forall addr ix. Ord addr => addr -> Pool addr ix -> Maybe ix
AddressPool.lookup KeyFingerprint "payment" k
addr Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool

instance
    ( PaymentAddress n k
    ) => KnownAddresses (SeqState n k) where
    knownAddresses :: SeqState n k -> [(Address, AddressState, NonEmpty DerivationIndex)]
knownAddresses SeqState n k
st =
        [(Address, AddressState, NonEmpty DerivationIndex)]
nonChangeAddresses [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a. Semigroup a => a -> a -> a
<> [(Address, AddressState, NonEmpty DerivationIndex)]
usedChangeAddresses [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a. Semigroup a => a -> a -> a
<> [(Address, AddressState, NonEmpty DerivationIndex)]
pendingChangeAddresses
      where
        -- | List addresses in order of increasing indices.
        listAddresses
            :: forall c. (Typeable c)
            => SeqAddressPool c k
            -> [(Address, AddressState, NonEmpty DerivationIndex)]
        listAddresses :: SeqAddressPool c k
-> [(Address, AddressState, NonEmpty DerivationIndex)]
listAddresses (SeqAddressPool Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool) =
            ((KeyFingerprint "payment" k,
  (Index 'Soft 'AddressK, AddressState))
 -> (Address, AddressState, NonEmpty DerivationIndex))
-> [(KeyFingerprint "payment" k,
     (Index 'Soft 'AddressK, AddressState))]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a b. (a -> b) -> [a] -> [b]
map (KeyFingerprint "payment" k, (Index 'Soft 'AddressK, AddressState))
-> (Address, AddressState, NonEmpty DerivationIndex)
shuffle ([(KeyFingerprint "payment" k,
   (Index 'Soft 'AddressK, AddressState))]
 -> [(Address, AddressState, NonEmpty DerivationIndex)])
-> (Map
      (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
    -> [(KeyFingerprint "payment" k,
         (Index 'Soft 'AddressK, AddressState))])
-> Map
     (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((KeyFingerprint "payment" k,
  (Index 'Soft 'AddressK, AddressState))
 -> Index 'Soft 'AddressK)
-> [(KeyFingerprint "payment" k,
     (Index 'Soft 'AddressK, AddressState))]
-> [(KeyFingerprint "payment" k,
     (Index 'Soft 'AddressK, AddressState))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (KeyFingerprint "payment" k, (Index 'Soft 'AddressK, AddressState))
-> Index 'Soft 'AddressK
forall a a b. (a, (a, b)) -> a
idx ([(KeyFingerprint "payment" k,
   (Index 'Soft 'AddressK, AddressState))]
 -> [(KeyFingerprint "payment" k,
      (Index 'Soft 'AddressK, AddressState))])
-> (Map
      (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
    -> [(KeyFingerprint "payment" k,
         (Index 'Soft 'AddressK, AddressState))])
-> Map
     (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
-> [(KeyFingerprint "payment" k,
     (Index 'Soft 'AddressK, AddressState))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
-> [(KeyFingerprint "payment" k,
     (Index 'Soft 'AddressK, AddressState))]
forall k a. Map k a -> [(k, a)]
Map.toList
            (Map
   (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
 -> [(Address, AddressState, NonEmpty DerivationIndex)])
-> Map
     (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a b. (a -> b) -> a -> b
$ Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> Map
     (KeyFingerprint "payment" k) (Index 'Soft 'AddressK, AddressState)
forall addr ix. Pool addr ix -> Map addr (ix, AddressState)
AddressPool.addresses Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool
          where
            idx :: (a, (a, b)) -> a
idx (a
_,(a
ix,b
_)) = a
ix
            shuffle :: (KeyFingerprint "payment" k, (Index 'Soft 'AddressK, AddressState))
-> (Address, AddressState, NonEmpty DerivationIndex)
shuffle (KeyFingerprint "payment" k
k,(Index 'Soft 'AddressK
ix,AddressState
s)) =
                (KeyFingerprint "payment" k -> Address
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
PaymentAddress network key =>
KeyFingerprint "payment" key -> Address
liftPaymentAddress @n KeyFingerprint "payment" k
k, AddressState
s, SeqState n k
-> Role -> Index 'Soft 'AddressK -> NonEmpty DerivationIndex
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k
-> Role -> Index 'Soft 'AddressK -> NonEmpty DerivationIndex
decoratePath SeqState n k
st (Typeable c => Role
forall (c :: Role). Typeable c => Role
roleVal @c) Index 'Soft 'AddressK
ix)

        nonChangeAddresses :: [(Address, AddressState, NonEmpty DerivationIndex)]
nonChangeAddresses = SeqAddressPool 'UtxoExternal k
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall (c :: Role).
Typeable c =>
SeqAddressPool c k
-> [(Address, AddressState, NonEmpty DerivationIndex)]
listAddresses (SeqAddressPool 'UtxoExternal k
 -> [(Address, AddressState, NonEmpty DerivationIndex)])
-> SeqAddressPool 'UtxoExternal k
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a b. (a -> b) -> a -> b
$ SeqState n k -> SeqAddressPool 'UtxoExternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool SeqState n k
st

        changeAddresses :: [(Address, AddressState, NonEmpty DerivationIndex)]
changeAddresses = SeqAddressPool 'UtxoInternal k
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall (c :: Role).
Typeable c =>
SeqAddressPool c k
-> [(Address, AddressState, NonEmpty DerivationIndex)]
listAddresses (SeqAddressPool 'UtxoInternal k
 -> [(Address, AddressState, NonEmpty DerivationIndex)])
-> SeqAddressPool 'UtxoInternal k
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a b. (a -> b) -> a -> b
$ SeqState n k -> SeqAddressPool 'UtxoInternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool SeqState n k
st
        usedChangeAddresses :: [(Address, AddressState, NonEmpty DerivationIndex)]
usedChangeAddresses =
            ((Address, AddressState, NonEmpty DerivationIndex) -> Bool)
-> [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Address
_, AddressState
status, NonEmpty DerivationIndex
_) -> AddressState
status AddressState -> AddressState -> Bool
forall a. Eq a => a -> a -> Bool
== AddressState
Used) [(Address, AddressState, NonEmpty DerivationIndex)]
changeAddresses

        -- pick as many unused change addresses as there are pending
        -- transactions. Note: the last `internalGap` addresses are all
        -- unused.
        pendingChangeAddresses :: [(Address, AddressState, NonEmpty DerivationIndex)]
pendingChangeAddresses = Int
-> [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a. Int -> [a] -> [a]
take ([Index 'Soft 'AddressK] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Index 'Soft 'AddressK]
ixs) [(Address, AddressState, NonEmpty DerivationIndex)]
edgeChangeAddresses
          where
            ixs :: [Index 'Soft 'AddressK]
ixs = PendingIxs 'AddressK -> [Index 'Soft 'AddressK]
forall (k :: Depth). PendingIxs k -> [Index 'Soft k]
pendingIxsToList (PendingIxs 'AddressK -> [Index 'Soft 'AddressK])
-> PendingIxs 'AddressK -> [Index 'Soft 'AddressK]
forall a b. (a -> b) -> a -> b
$ SeqState n k -> PendingIxs 'AddressK
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> PendingIxs 'AddressK
pendingChangeIxs SeqState n k
st
            internalGap :: Int
internalGap = Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK) -> Int
forall addr ix. Pool addr ix -> Int
AddressPool.gap (Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK) -> Int)
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK) -> Int
forall a b. (a -> b) -> a -> b
$ SeqAddressPool 'UtxoInternal k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
getPool (SeqAddressPool 'UtxoInternal k
 -> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> SeqAddressPool 'UtxoInternal k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall a b. (a -> b) -> a -> b
$ SeqState n k -> SeqAddressPool 'UtxoInternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool SeqState n k
st
            edgeChangeAddresses :: [(Address, AddressState, NonEmpty DerivationIndex)]
edgeChangeAddresses =
                Int
-> [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a. Int -> [a] -> [a]
drop ([(Address, AddressState, NonEmpty DerivationIndex)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Address, AddressState, NonEmpty DerivationIndex)]
changeAddresses Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
internalGap) [(Address, AddressState, NonEmpty DerivationIndex)]
changeAddresses

instance GetAccount (SeqState n k) k where
    getAccount :: SeqState n k -> k 'AccountK XPub
getAccount = SeqState n k -> k 'AccountK XPub
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> k 'AccountK XPub
accountXPub

-- | Discover addresses and transactions using an
-- efficient query @addr -> m txs@.
-- Does /not/ take 'RewardAccount' into account.
discoverSeq
    :: forall n k m. (PaymentAddress n k, Monad m)
    => (Either Address RewardAccount -> m ChainEvents)
    -> SeqState n k -> m (ChainEvents, SeqState n k)
discoverSeq :: (Either Address RewardAccount -> m ChainEvents)
-> SeqState n k -> m (ChainEvents, SeqState n k)
discoverSeq Either Address RewardAccount -> m ChainEvents
query s :: SeqState n k
s@SeqState{SeqAddressPool 'UtxoInternal k
internalPool :: SeqAddressPool 'UtxoInternal k
internalPool :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool,SeqAddressPool 'UtxoExternal k
externalPool :: SeqAddressPool 'UtxoExternal k
externalPool :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool} = do
    (ChainEvents
blocks1,SeqAddressPool 'UtxoInternal k
int) <- SeqAddressPool 'UtxoInternal k
-> m (ChainEvents, SeqAddressPool 'UtxoInternal k)
forall (r :: Role).
SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
discover SeqAddressPool 'UtxoInternal k
internalPool
    (ChainEvents
blocks2,SeqAddressPool 'UtxoExternal k
ext) <- SeqAddressPool 'UtxoExternal k
-> m (ChainEvents, SeqAddressPool 'UtxoExternal k)
forall (r :: Role).
SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
discover SeqAddressPool 'UtxoExternal k
externalPool
    (ChainEvents, SeqState n k) -> m (ChainEvents, SeqState n k)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( ChainEvents
blocks1 ChainEvents -> ChainEvents -> ChainEvents
forall a. Semigroup a => a -> a -> a
<> ChainEvents
blocks2
        , SeqState n k
s{internalPool :: SeqAddressPool 'UtxoInternal k
internalPool=SeqAddressPool 'UtxoInternal k
int,externalPool :: SeqAddressPool 'UtxoExternal k
externalPool=SeqAddressPool 'UtxoExternal k
ext}
        )
  where
    -- Only enterprise address (for legacy Icarus keys)
    fromPayment :: KeyFingerprint "payment" k -> Address
fromPayment KeyFingerprint "payment" k
hash = KeyFingerprint "payment" k -> Address
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
PaymentAddress network key =>
KeyFingerprint "payment" key -> Address
liftPaymentAddress @n KeyFingerprint "payment" k
hash
    discover :: SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
    discover :: SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
discover = ((ChainEvents,
  Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
 -> (ChainEvents, SeqAddressPool r k))
-> m (ChainEvents,
      Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> m (ChainEvents, SeqAddressPool r k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
 -> SeqAddressPool r k)
-> (ChainEvents,
    Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> (ChainEvents, SeqAddressPool r k)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> SeqAddressPool r k
forall (c :: Role) (key :: Depth -> * -> *).
Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
SeqAddressPool)
        (m (ChainEvents,
    Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
 -> m (ChainEvents, SeqAddressPool r k))
-> (SeqAddressPool r k
    -> m (ChainEvents,
          Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)))
-> SeqAddressPool r k
-> m (ChainEvents, SeqAddressPool r k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyFingerprint "payment" k -> m ChainEvents)
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> m (ChainEvents,
      Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
forall ix addr (m :: * -> *) txs.
(Enum ix, Ord addr, Monad m, Monoid txs, Eq txs) =>
(addr -> m txs) -> Pool addr ix -> m (txs, Pool addr ix)
AddressPool.discover (Either Address RewardAccount -> m ChainEvents
query (Either Address RewardAccount -> m ChainEvents)
-> (KeyFingerprint "payment" k -> Either Address RewardAccount)
-> KeyFingerprint "payment" k
-> m ChainEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Either Address RewardAccount
forall a b. a -> Either a b
Left (Address -> Either Address RewardAccount)
-> (KeyFingerprint "payment" k -> Address)
-> KeyFingerprint "payment" k
-> Either Address RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyFingerprint "payment" k -> Address
fromPayment) (Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
 -> m (ChainEvents,
       Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)))
-> (SeqAddressPool r k
    -> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> SeqAddressPool r k
-> m (ChainEvents,
      Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqAddressPool r k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
getPool

-- | Discover addresses and transactions using an
-- efficient query @addr -> m txs@.
-- Does take 'RewardAccount' into account.
discoverSeqWithRewards
    :: forall n k m. (DelegationAddress n k, ToRewardAccount k, Monad m)
    => (Either Address RewardAccount -> m ChainEvents)
    -> SeqState n k -> m (ChainEvents, SeqState n k)
discoverSeqWithRewards :: (Either Address RewardAccount -> m ChainEvents)
-> SeqState n k -> m (ChainEvents, SeqState n k)
discoverSeqWithRewards Either Address RewardAccount -> m ChainEvents
query s :: SeqState n k
s@SeqState{SeqAddressPool 'UtxoInternal k
internalPool :: SeqAddressPool 'UtxoInternal k
internalPool :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
internalPool,SeqAddressPool 'UtxoExternal k
externalPool :: SeqAddressPool 'UtxoExternal k
externalPool :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool,k 'AddressK XPub
rewardAccountKey :: k 'AddressK XPub
rewardAccountKey :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> k 'AddressK XPub
rewardAccountKey} = do
    ChainEvents
blocks0 <- Either Address RewardAccount -> m ChainEvents
query (Either Address RewardAccount -> m ChainEvents)
-> (RewardAccount -> Either Address RewardAccount)
-> RewardAccount
-> m ChainEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> Either Address RewardAccount
forall a b. b -> Either a b
Right (RewardAccount -> m ChainEvents) -> RewardAccount -> m ChainEvents
forall a b. (a -> b) -> a -> b
$ k 'AddressK XPub -> RewardAccount
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
k 'AddressK XPub -> RewardAccount
toRewardAccount k 'AddressK XPub
rewardAccountKey
    (ChainEvents
blocks1,SeqAddressPool 'UtxoInternal k
int) <- SeqAddressPool 'UtxoInternal k
-> m (ChainEvents, SeqAddressPool 'UtxoInternal k)
forall (r :: Role).
SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
discover SeqAddressPool 'UtxoInternal k
internalPool
    (ChainEvents
blocks2,SeqAddressPool 'UtxoExternal k
ext) <- SeqAddressPool 'UtxoExternal k
-> m (ChainEvents, SeqAddressPool 'UtxoExternal k)
forall (r :: Role).
SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
discover SeqAddressPool 'UtxoExternal k
externalPool
    (ChainEvents, SeqState n k) -> m (ChainEvents, SeqState n k)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( ChainEvents
blocks0 ChainEvents -> ChainEvents -> ChainEvents
forall a. Semigroup a => a -> a -> a
<> ChainEvents
blocks1 ChainEvents -> ChainEvents -> ChainEvents
forall a. Semigroup a => a -> a -> a
<> ChainEvents
blocks2
        , SeqState n k
s{internalPool :: SeqAddressPool 'UtxoInternal k
internalPool=SeqAddressPool 'UtxoInternal k
int,externalPool :: SeqAddressPool 'UtxoExternal k
externalPool=SeqAddressPool 'UtxoExternal k
ext}
        )
  where
    -- Every 'Address' is composed of a payment part and a staking part.
    -- Ideally, we would want 'query' to give us all transactions
    -- belonging to a given payment part, regardless of the staking parts
    -- that are paired with that payment part.
    -- Unfortunately, this is not possible at the moment.
    -- However, fortunately, the staking part is always the same,
    -- so we supply it here in order to obtain an 'Address' that we can query.
    fromPayment :: KeyFingerprint "payment" k -> Address
fromPayment KeyFingerprint "payment" k
hash = KeyFingerprint "payment" k -> k 'AddressK XPub -> Address
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
DelegationAddress network key =>
KeyFingerprint "payment" key -> key 'AddressK XPub -> Address
liftDelegationAddress @n KeyFingerprint "payment" k
hash k 'AddressK XPub
rewardAccountKey
    discover :: SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
    discover :: SeqAddressPool r k -> m (ChainEvents, SeqAddressPool r k)
discover = ((ChainEvents,
  Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
 -> (ChainEvents, SeqAddressPool r k))
-> m (ChainEvents,
      Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> m (ChainEvents, SeqAddressPool r k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
 -> SeqAddressPool r k)
-> (ChainEvents,
    Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> (ChainEvents, SeqAddressPool r k)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> SeqAddressPool r k
forall (c :: Role) (key :: Depth -> * -> *).
Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
SeqAddressPool)
        (m (ChainEvents,
    Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
 -> m (ChainEvents, SeqAddressPool r k))
-> (SeqAddressPool r k
    -> m (ChainEvents,
          Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)))
-> SeqAddressPool r k
-> m (ChainEvents, SeqAddressPool r k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyFingerprint "payment" k -> m ChainEvents)
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> m (ChainEvents,
      Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
forall ix addr (m :: * -> *) txs.
(Enum ix, Ord addr, Monad m, Monoid txs, Eq txs) =>
(addr -> m txs) -> Pool addr ix -> m (txs, Pool addr ix)
AddressPool.discover (Either Address RewardAccount -> m ChainEvents
query (Either Address RewardAccount -> m ChainEvents)
-> (KeyFingerprint "payment" k -> Either Address RewardAccount)
-> KeyFingerprint "payment" k
-> m ChainEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Either Address RewardAccount
forall a b. a -> Either a b
Left (Address -> Either Address RewardAccount)
-> (KeyFingerprint "payment" k -> Address)
-> KeyFingerprint "payment" k
-> Either Address RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyFingerprint "payment" k -> Address
fromPayment) (Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
 -> m (ChainEvents,
       Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)))
-> (SeqAddressPool r k
    -> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> SeqAddressPool r k
-> m (ChainEvents,
      Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqAddressPool r k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
getPool

{-------------------------------------------------------------------------------
    SeqAnyState

    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
-- it discovers addresses based on an arbitrary ratio instead of respecting
-- BIP-44 discovery.
--
-- The proportion is stored as a type-level parameter so that we don't have to
-- alter the database schema to store it. It simply exists and depends on the
-- caller creating the wallet to define it.
newtype SeqAnyState (network :: NetworkDiscriminant) key (p :: Nat) = SeqAnyState
    { SeqAnyState network key p -> SeqState network key
innerState :: SeqState network key
    } deriving ((forall x.
 SeqAnyState network key p -> Rep (SeqAnyState network key p) x)
-> (forall x.
    Rep (SeqAnyState network key p) x -> SeqAnyState network key p)
-> Generic (SeqAnyState network key p)
forall x.
Rep (SeqAnyState network key p) x -> SeqAnyState network key p
forall x.
SeqAnyState network key p -> Rep (SeqAnyState network key p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat) x.
Rep (SeqAnyState network key p) x -> SeqAnyState network key p
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat) x.
SeqAnyState network key p -> Rep (SeqAnyState network key p) x
$cto :: forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat) x.
Rep (SeqAnyState network key p) x -> SeqAnyState network key p
$cfrom :: forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat) x.
SeqAnyState network key p -> Rep (SeqAnyState network key p) x
Generic)

deriving instance
    ( Show (k 'AccountK XPub)
    , Show (k 'AddressK XPub)
    , Show (k 'PolicyK XPub)
    , Show (KeyFingerprint "payment" k)
    ) => Show (SeqAnyState n k p)

instance
    ( NFData (k 'AccountK XPub)
    , NFData (k 'AddressK XPub)
    , NFData (k 'PolicyK XPub)
    , NFData (KeyFingerprint "payment" k)
    )
    => NFData (SeqAnyState n k p)

-- | Initialize the HD random address discovery state from a root key and RNG
-- seed.
--
-- The type parameter is expected to be a ratio of addresses we ought to simply
-- recognize as ours. It is expressed in per-myriad, so "1" means 0.01%,
-- "100" means 1% and 10000 means 100%.
mkSeqAnyState
    :: forall (p :: Nat) n k.
        ( SupportsDiscovery n k
        , WalletKey k
        , (k == SharedKey) ~ 'False
        )
    => (k 'RootK XPrv, Passphrase "encryption")
    -> Index 'Hardened 'PurposeK
    -> AddressPoolGap
    -> SeqAnyState n k p
mkSeqAnyState :: (k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqAnyState n k p
mkSeqAnyState (k 'RootK XPrv, Passphrase "encryption")
credentials Index 'Hardened 'PurposeK
purpose AddressPoolGap
poolGap = SeqAnyState :: forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat).
SeqState network key -> SeqAnyState network key p
SeqAnyState
    { innerState :: SeqState n k
innerState = (k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
(WalletKey k, SupportsDiscovery n k, (k == SharedKey) ~ 'False) =>
(k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k
mkSeqStateFromRootXPrv (k 'RootK XPrv, Passphrase "encryption")
credentials Index 'Hardened 'PurposeK
purpose AddressPoolGap
poolGap
    }

instance KnownNat p => IsOurs (SeqAnyState n k p) Address where
    isOurs :: Address
-> SeqAnyState n k p
-> (Maybe (NonEmpty DerivationIndex), SeqAnyState n k p)
isOurs (Address ByteString
bytes) st :: SeqAnyState n k p
st@(SeqAnyState SeqState n k
inner)
        | ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
bytes Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
p =
            let
                pool :: Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool = SeqAddressPool 'UtxoExternal k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall (c :: Role) (key :: Depth -> * -> *).
SeqAddressPool c key
-> Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
getPool (SeqAddressPool 'UtxoExternal k
 -> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK))
-> SeqAddressPool 'UtxoExternal k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall a b. (a -> b) -> a -> b
$ SeqState n k -> SeqAddressPool 'UtxoExternal k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
externalPool SeqState n k
inner
                ix :: Index 'Soft 'AddressK
ix = Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'Soft 'AddressK) -> Int -> Index 'Soft 'AddressK
forall a b. (a -> b) -> a -> b
$ Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK) -> Int
forall addr ix. Pool addr ix -> Int
AddressPool.size Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool Int -> Int -> Int
forall a. Num a => a -> a -> a
- Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK) -> Int
forall addr ix. Pool addr ix -> Int
AddressPool.gap Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool
                addr :: KeyFingerprint "payment" k
addr = Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> Index 'Soft 'AddressK -> KeyFingerprint "payment" k
forall addr ix. Pool addr ix -> ix -> addr
AddressPool.addressFromIx Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool Index 'Soft 'AddressK
ix
                pool' :: Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool' = KeyFingerprint "payment" k
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
forall addr ix.
(Ord addr, Enum ix) =>
addr -> Pool addr ix -> Pool addr ix
AddressPool.update KeyFingerprint "payment" k
addr Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool
                path :: NonEmpty DerivationIndex
path = Word32 -> DerivationIndex
DerivationIndex (Index 'Soft 'AddressK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Soft 'AddressK
ix) DerivationIndex -> [DerivationIndex] -> NonEmpty DerivationIndex
forall a. a -> [a] -> NonEmpty a
:| []
            in
                ( NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just NonEmpty DerivationIndex
path
                , SeqState n k -> SeqAnyState n k p
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat).
SeqState network key -> SeqAnyState network key p
SeqAnyState (SeqState n k -> SeqAnyState n k p)
-> SeqState n k -> SeqAnyState n k p
forall a b. (a -> b) -> a -> b
$ SeqState n k
inner{ externalPool :: SeqAddressPool 'UtxoExternal k
externalPool = Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
-> SeqAddressPool 'UtxoExternal k
forall (c :: Role) (key :: Depth -> * -> *).
Pool (KeyFingerprint "payment" key) (Index 'Soft 'AddressK)
-> SeqAddressPool c key
SeqAddressPool Pool (KeyFingerprint "payment" k) (Index 'Soft 'AddressK)
pool' }
                )
        | Bool
otherwise =
            (Maybe (NonEmpty DerivationIndex)
forall a. Maybe a
Nothing, SeqAnyState n k p
st)
      where
        p :: Word32
p = Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
floor (Word32 -> Double
forall a. Integral a => a -> Double
double Word32
sup Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a. Integral a => a -> Double
double (Proxy p -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy p
forall k (t :: k). Proxy t
Proxy @p)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10000)
          where
            sup :: Word32
sup = Word32
forall a. Bounded a => a
maxBound :: Word32

        double :: Integral a => a -> Double
        double :: a -> Double
double = a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance IsOurs (SeqAnyState n k p) RewardAccount where
    isOurs :: RewardAccount
-> SeqAnyState n k p
-> (Maybe (NonEmpty DerivationIndex), SeqAnyState n k p)
isOurs RewardAccount
_account SeqAnyState n k p
state = (Maybe (NonEmpty DerivationIndex)
forall a. Maybe a
Nothing, SeqAnyState n k p
state)

instance
    ( AddressIndexDerivationType k ~ 'Soft
    , KnownNat p
    ) => IsOwned (SeqAnyState n k p) k
  where
    isOwned :: SeqAnyState n k p
-> (k 'RootK XPrv, Passphrase "encryption")
-> Address
-> Maybe (k 'AddressK XPrv, Passphrase "encryption")
isOwned SeqAnyState n k p
_ (k 'RootK XPrv, Passphrase "encryption")
_ Address
_ = Maybe (k 'AddressK XPrv, Passphrase "encryption")
forall a. Maybe a
Nothing

instance SoftDerivation k => GenChange (SeqAnyState n k p) where
    type ArgGenChange (SeqAnyState n k p) = ArgGenChange (SeqState n k)
    genChange :: ArgGenChange (SeqAnyState n k p)
-> SeqAnyState n k p -> (Address, SeqAnyState n k p)
genChange ArgGenChange (SeqAnyState n k p)
a (SeqAnyState SeqState n k
s) = SeqState n k -> SeqAnyState n k p
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat).
SeqState network key -> SeqAnyState network key p
SeqAnyState (SeqState n k -> SeqAnyState n k p)
-> (Address, SeqState n k) -> (Address, SeqAnyState n k p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArgGenChange (SeqState n k)
-> SeqState n k -> (Address, SeqState n k)
forall s. GenChange s => ArgGenChange s -> s -> (Address, s)
genChange ArgGenChange (SeqAnyState n k p)
ArgGenChange (SeqState n k)
a SeqState n k
s

instance SupportsDiscovery n k => CompareDiscovery (SeqAnyState n k p) where
    compareDiscovery :: SeqAnyState n k p -> Address -> Address -> Ordering
compareDiscovery (SeqAnyState SeqState n k
s) = SeqState n k -> Address -> Address -> Ordering
forall s. CompareDiscovery s => s -> Address -> Address -> Ordering
compareDiscovery SeqState n k
s

instance PaymentAddress n k => KnownAddresses (SeqAnyState n k p) where
    knownAddresses :: SeqAnyState n k p
-> [(Address, AddressState, NonEmpty DerivationIndex)]
knownAddresses (SeqAnyState SeqState n k
s) = SeqState n k -> [(Address, AddressState, NonEmpty DerivationIndex)]
forall s.
KnownAddresses s =>
s -> [(Address, AddressState, NonEmpty DerivationIndex)]
knownAddresses SeqState n k
s

instance MaybeLight (SeqAnyState n k p) where
    maybeDiscover :: Maybe (LightDiscoverTxs (SeqAnyState n k p))
maybeDiscover = Maybe (LightDiscoverTxs (SeqAnyState n k p))
forall a. Maybe a
Nothing