{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Wallet.Primitive.AddressDiscovery.Random
(
RndState (..)
, RndStateLike
, mkRndState
, DerivationPath
, toDerivationIndexes
, importAddress
, ErrImportAddress(..)
, addPendingAddress
, deriveRndStateAddress
, findUnusedPath
, unavailablePaths
, defaultAccountIndex
, withRNG
, RndAnyState (..)
, mkRndAnyState
) where
import Prelude
import Cardano.Address.Derivation
( XPrv )
import Cardano.Byron.Codec.Cbor
( decodeAddressDerivationPath, decodeAddressPayload, deserialiseCbor )
import Cardano.Wallet.Primitive.AddressDerivation
( Depth (..)
, DerivationIndex (..)
, DerivationType (..)
, Index (..)
, NetworkDiscriminant
, PaymentAddress (..)
, liftIndex
, publicKey
)
import Cardano.Wallet.Primitive.AddressDerivation.Byron
( ByronKey (..), deriveAccountPrivateKey, deriveAddressPrivateKey )
import Cardano.Wallet.Primitive.AddressDiscovery
( CompareDiscovery (..)
, GenChange (..)
, IsOurs (isOurs)
, IsOwned (..)
, KnownAddresses (..)
, MaybeLight (..)
)
import Cardano.Wallet.Primitive.Passphrase
( Passphrase (..) )
import Cardano.Wallet.Primitive.Types.Address
( Address (..), AddressState (..) )
import Cardano.Wallet.Primitive.Types.RewardAccount
( RewardAccount )
import Control.Arrow
( second )
import Control.DeepSeq
( NFData (..) )
import Control.Monad
( join )
import Data.Digest.CRC32
( crc32 )
import Data.List.NonEmpty
( NonEmpty (..) )
import Data.Map
( Map )
import Data.Proxy
( Proxy (..) )
import Data.Set
( Set )
import Data.Word
( Word32 )
import Fmt
( Buildable (..), blockMapF', indentF, tupleF )
import GHC.Generics
( Generic )
import GHC.TypeLits
( KnownNat, Nat, natVal )
import System.Random
( RandomGen, StdGen, mkStdGen, randomR )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Set as Set
class RndStateLike s where
importAddress
:: Address
-> s
-> Either ErrImportAddress s
addPendingAddress
:: Address
-> DerivationPath
-> s
-> s
unavailablePaths
:: s
-> Set DerivationPath
defaultAccountIndex
:: s
-> Index 'Hardened 'AccountK
withRNG
:: s
-> (StdGen -> (a, StdGen))
-> (a, s)
data RndState (network :: NetworkDiscriminant) = RndState
{ RndState network -> Passphrase "addr-derivation-payload"
hdPassphrase :: Passphrase "addr-derivation-payload"
, RndState network -> Index 'Hardened 'AccountK
accountIndex :: Index 'Hardened 'AccountK
, RndState network -> Map DerivationPath (Address, AddressState)
discoveredAddresses :: Map DerivationPath (Address, AddressState)
, RndState network -> Map DerivationPath Address
pendingAddresses :: Map DerivationPath Address
, RndState network -> StdGen
gen :: StdGen
} deriving ((forall x. RndState network -> Rep (RndState network) x)
-> (forall x. Rep (RndState network) x -> RndState network)
-> Generic (RndState network)
forall x. Rep (RndState network) x -> RndState network
forall x. RndState network -> Rep (RndState network) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (network :: NetworkDiscriminant) x.
Rep (RndState network) x -> RndState network
forall (network :: NetworkDiscriminant) x.
RndState network -> Rep (RndState network) x
$cto :: forall (network :: NetworkDiscriminant) x.
Rep (RndState network) x -> RndState network
$cfrom :: forall (network :: NetworkDiscriminant) x.
RndState network -> Rep (RndState network) x
Generic, RndState network -> RndState network -> Bool
(RndState network -> RndState network -> Bool)
-> (RndState network -> RndState network -> Bool)
-> Eq (RndState network)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (network :: NetworkDiscriminant).
RndState network -> RndState network -> Bool
/= :: RndState network -> RndState network -> Bool
$c/= :: forall (network :: NetworkDiscriminant).
RndState network -> RndState network -> Bool
== :: RndState network -> RndState network -> Bool
$c== :: forall (network :: NetworkDiscriminant).
RndState network -> RndState network -> Bool
Eq)
instance NFData (RndState network) where
rnf :: RndState network -> ()
rnf (RndState !Passphrase "addr-derivation-payload"
_ !Index 'Hardened 'AccountK
_ !Map DerivationPath (Address, AddressState)
_ !Map DerivationPath Address
_ StdGen
g) = String -> () -> ()
seq (StdGen -> String
forall a. Show a => a -> String
show StdGen
g) ()
instance Show (RndState network) where
show :: RndState network -> String
show (RndState Passphrase "addr-derivation-payload"
_key Index 'Hardened 'AccountK
ix Map DerivationPath (Address, AddressState)
addrs Map DerivationPath Address
pending StdGen
g) = [String] -> String
unwords
[ String
"RndState <xprv>", Index 'Hardened 'AccountK -> String
forall a. Show a => a -> String
p Index 'Hardened 'AccountK
ix, Map DerivationPath (Address, AddressState) -> String
forall a. Show a => a -> String
p Map DerivationPath (Address, AddressState)
addrs, Map DerivationPath Address -> String
forall a. Show a => a -> String
p Map DerivationPath Address
pending, StdGen -> String
forall a. Show a => a -> String
p StdGen
g ]
where
p :: a -> String
p a
x = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
instance Buildable (RndState network) where
build :: RndState network -> Builder
build (RndState Passphrase "addr-derivation-payload"
_ Index 'Hardened 'AccountK
ix Map DerivationPath (Address, AddressState)
addrs Map DerivationPath Address
pending StdGen
g) = Builder
"RndState:\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (Builder
"Account ix: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Index 'Hardened 'AccountK -> Builder
forall p. Buildable p => p -> Builder
build Index 'Hardened 'AccountK
ix)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (Builder
"Random Generator: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall p. Buildable p => p -> Builder
build (StdGen -> String
forall a. Show a => a -> String
show StdGen
g))
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (Builder
"Known addresses: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (DerivationPath -> Builder)
-> ((Address, AddressState) -> Builder)
-> Map DerivationPath (Address, AddressState)
-> Builder
forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
blockMapF' DerivationPath -> Builder
forall a. TupleF a => a -> Builder
tupleF (Address, AddressState) -> Builder
forall a. TupleF a => a -> Builder
tupleF Map DerivationPath (Address, AddressState)
addrs)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
indentF Int
4 (Builder
"Change addresses: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (DerivationPath -> Builder)
-> (Address -> Builder) -> Map DerivationPath Address -> Builder
forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
blockMapF' DerivationPath -> Builder
forall a. TupleF a => a -> Builder
tupleF Address -> Builder
forall p. Buildable p => p -> Builder
build Map DerivationPath Address
pending)
type DerivationPath = (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'AddressK)
instance RndStateLike (RndState n) where
importAddress :: Address -> RndState n -> Either ErrImportAddress (RndState n)
importAddress Address
addr RndState n
s = do
case Address
-> Passphrase "addr-derivation-payload" -> Maybe DerivationPath
addressToPath Address
addr (RndState n -> Passphrase "addr-derivation-payload"
forall (network :: NetworkDiscriminant).
RndState network -> Passphrase "addr-derivation-payload"
hdPassphrase RndState n
s) of
Maybe DerivationPath
Nothing ->
ErrImportAddress -> Either ErrImportAddress (RndState n)
forall a b. a -> Either a b
Left (Address -> ErrImportAddress
ErrAddrDoesNotBelong Address
addr)
Just DerivationPath
path | DerivationPath
-> Map DerivationPath (Address, AddressState) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member DerivationPath
path (RndState n -> Map DerivationPath (Address, AddressState)
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath (Address, AddressState)
discoveredAddresses RndState n
s) ->
RndState n -> Either ErrImportAddress (RndState n)
forall a b. b -> Either a b
Right RndState n
s
Just DerivationPath
path | DerivationPath -> Map DerivationPath Address -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member DerivationPath
path (RndState n -> Map DerivationPath Address
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath Address
pendingAddresses RndState n
s) ->
RndState n -> Either ErrImportAddress (RndState n)
forall a b. b -> Either a b
Right RndState n
s
Just DerivationPath
path ->
RndState n -> Either ErrImportAddress (RndState n)
forall a b. b -> Either a b
Right (Address -> DerivationPath -> RndState n -> RndState n
forall s. RndStateLike s => Address -> DerivationPath -> s -> s
addPendingAddress Address
addr DerivationPath
path RndState n
s)
addPendingAddress :: Address -> DerivationPath -> RndState n -> RndState n
addPendingAddress Address
addr DerivationPath
path RndState n
st = RndState n
st
{ pendingAddresses :: Map DerivationPath Address
pendingAddresses = DerivationPath
-> Address
-> Map DerivationPath Address
-> Map DerivationPath Address
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DerivationPath
path Address
addr (RndState n -> Map DerivationPath Address
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath Address
pendingAddresses RndState n
st)
}
unavailablePaths :: RndState n -> Set DerivationPath
unavailablePaths RndState n
st =
Map DerivationPath (Address, AddressState) -> Set DerivationPath
forall k a. Map k a -> Set k
Map.keysSet (RndState n -> Map DerivationPath (Address, AddressState)
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath (Address, AddressState)
discoveredAddresses RndState n
st) Set DerivationPath -> Set DerivationPath -> Set DerivationPath
forall a. Semigroup a => a -> a -> a
<> Map DerivationPath Address -> Set DerivationPath
forall k a. Map k a -> Set k
Map.keysSet (RndState n -> Map DerivationPath Address
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath Address
pendingAddresses RndState n
st)
defaultAccountIndex :: RndState n -> Index 'Hardened 'AccountK
defaultAccountIndex =
RndState n -> Index 'Hardened 'AccountK
forall (n :: NetworkDiscriminant).
RndState n -> Index 'Hardened 'AccountK
accountIndex
withRNG :: RndState n -> (StdGen -> (a, StdGen)) -> (a, RndState n)
withRNG RndState n
s StdGen -> (a, StdGen)
action =
let (a
result, StdGen
gen') = StdGen -> (a, StdGen)
action (RndState n -> StdGen
forall (network :: NetworkDiscriminant). RndState network -> StdGen
gen RndState n
s) in (a
result, RndState n
s { gen :: StdGen
gen = StdGen
gen' })
instance IsOurs (RndState n) Address where
isOurs :: Address
-> RndState n -> (Maybe (NonEmpty DerivationIndex), RndState n)
isOurs Address
addr RndState n
st =
( DerivationPath -> NonEmpty DerivationIndex
toDerivationIndexes (DerivationPath -> NonEmpty DerivationIndex)
-> Maybe DerivationPath -> Maybe (NonEmpty DerivationIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DerivationPath
path
, (RndState n -> RndState n)
-> (DerivationPath -> RndState n -> RndState n)
-> Maybe DerivationPath
-> RndState n
-> RndState n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RndState n -> RndState n
forall a. a -> a
id (Address
-> AddressState -> DerivationPath -> RndState n -> RndState n
forall (n :: NetworkDiscriminant).
Address
-> AddressState -> DerivationPath -> RndState n -> RndState n
addDiscoveredAddress Address
addr AddressState
Used) Maybe DerivationPath
path RndState n
st
)
where
path :: Maybe DerivationPath
path = Address
-> Passphrase "addr-derivation-payload" -> Maybe DerivationPath
addressToPath Address
addr (RndState n -> Passphrase "addr-derivation-payload"
forall (network :: NetworkDiscriminant).
RndState network -> Passphrase "addr-derivation-payload"
hdPassphrase RndState n
st)
instance IsOurs (RndState n) RewardAccount where
isOurs :: RewardAccount
-> RndState n -> (Maybe (NonEmpty DerivationIndex), RndState n)
isOurs RewardAccount
_account RndState n
state = (Maybe (NonEmpty DerivationIndex)
forall a. Maybe a
Nothing, RndState n
state)
instance IsOwned (RndState n) ByronKey where
isOwned :: RndState n
-> (ByronKey 'RootK XPrv, Passphrase "encryption")
-> Address
-> Maybe (ByronKey 'AddressK XPrv, Passphrase "encryption")
isOwned RndState n
st (ByronKey 'RootK XPrv
key, Passphrase "encryption"
pwd) Address
addr =
(, Passphrase "encryption"
pwd) (ByronKey 'AddressK XPrv
-> (ByronKey 'AddressK XPrv, Passphrase "encryption"))
-> (DerivationPath -> ByronKey 'AddressK XPrv)
-> DerivationPath
-> (ByronKey 'AddressK XPrv, Passphrase "encryption")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronKey 'RootK XPrv
-> Passphrase "encryption"
-> DerivationPath
-> ByronKey 'AddressK XPrv
deriveAddressKeyFromPath ByronKey 'RootK XPrv
key Passphrase "encryption"
pwd
(DerivationPath
-> (ByronKey 'AddressK XPrv, Passphrase "encryption"))
-> Maybe DerivationPath
-> Maybe (ByronKey 'AddressK XPrv, Passphrase "encryption")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address
-> Passphrase "addr-derivation-payload" -> Maybe DerivationPath
addressToPath Address
addr (RndState n -> Passphrase "addr-derivation-payload"
forall (network :: NetworkDiscriminant).
RndState network -> Passphrase "addr-derivation-payload"
hdPassphrase RndState n
st)
addDiscoveredAddress
:: Address
-> AddressState
-> DerivationPath
-> RndState n
-> RndState n
addDiscoveredAddress :: Address
-> AddressState -> DerivationPath -> RndState n -> RndState n
addDiscoveredAddress Address
addr AddressState
status DerivationPath
path RndState n
st = RndState n
st
{ discoveredAddresses :: Map DerivationPath (Address, AddressState)
discoveredAddresses = DerivationPath
-> (Address, AddressState)
-> Map DerivationPath (Address, AddressState)
-> Map DerivationPath (Address, AddressState)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DerivationPath
path (Address
addr, AddressState
status) (RndState n -> Map DerivationPath (Address, AddressState)
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath (Address, AddressState)
discoveredAddresses RndState n
st)
, pendingAddresses :: Map DerivationPath Address
pendingAddresses = DerivationPath
-> Map DerivationPath Address -> Map DerivationPath Address
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete DerivationPath
path (RndState n -> Map DerivationPath Address
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath Address
pendingAddresses RndState n
st)
}
addressToPath
:: Address
-> Passphrase "addr-derivation-payload"
-> Maybe DerivationPath
addressToPath :: Address
-> Passphrase "addr-derivation-payload" -> Maybe DerivationPath
addressToPath (Address ByteString
addr) Passphrase "addr-derivation-payload"
pwd = do
ByteString
payload <- (forall s. Decoder s ByteString) -> ByteString -> Maybe ByteString
forall a. (forall s. Decoder s a) -> ByteString -> Maybe a
deserialiseCbor forall s. Decoder s ByteString
decodeAddressPayload ByteString
addr
Maybe (Maybe DerivationPath) -> Maybe DerivationPath
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe DerivationPath) -> Maybe DerivationPath)
-> Maybe (Maybe DerivationPath) -> Maybe DerivationPath
forall a b. (a -> b) -> a -> b
$ (forall s. Decoder s (Maybe DerivationPath))
-> ByteString -> Maybe (Maybe DerivationPath)
forall a. (forall s. Decoder s a) -> ByteString -> Maybe a
deserialiseCbor (Passphrase "addr-derivation-payload"
-> Decoder s (Maybe DerivationPath)
forall s.
Passphrase "addr-derivation-payload"
-> Decoder s (Maybe DerivationPath)
decodeAddressDerivationPath Passphrase "addr-derivation-payload"
pwd) ByteString
payload
toDerivationIndexes :: DerivationPath -> NonEmpty DerivationIndex
toDerivationIndexes :: DerivationPath -> NonEmpty DerivationIndex
toDerivationIndexes (Index 'WholeDomain 'AccountK
acctIx, Index 'WholeDomain 'AddressK
addrIx) = [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 'WholeDomain 'AccountK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'WholeDomain 'AccountK
acctIx
, Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'WholeDomain 'AddressK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'WholeDomain 'AddressK
addrIx
]
mkRndState :: ByronKey 'RootK XPrv -> Int -> RndState n
mkRndState :: ByronKey 'RootK XPrv -> Int -> RndState n
mkRndState ByronKey 'RootK XPrv
key Int
seed = RndState :: forall (network :: NetworkDiscriminant).
Passphrase "addr-derivation-payload"
-> Index 'Hardened 'AccountK
-> Map DerivationPath (Address, AddressState)
-> Map DerivationPath Address
-> StdGen
-> RndState network
RndState
{ hdPassphrase :: Passphrase "addr-derivation-payload"
hdPassphrase = ByronKey 'RootK XPrv -> Passphrase "addr-derivation-payload"
forall (depth :: Depth) key.
ByronKey depth key -> Passphrase "addr-derivation-payload"
payloadPassphrase ByronKey 'RootK XPrv
key
, accountIndex :: Index 'Hardened 'AccountK
accountIndex = Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound
, discoveredAddresses :: Map DerivationPath (Address, AddressState)
discoveredAddresses = Map DerivationPath (Address, AddressState)
forall a. Monoid a => a
mempty
, pendingAddresses :: Map DerivationPath Address
pendingAddresses = Map DerivationPath Address
forall a. Monoid a => a
mempty
, gen :: StdGen
gen = Int -> StdGen
mkStdGen Int
seed
}
newtype ErrImportAddress
= ErrAddrDoesNotBelong Address
deriving ((forall x. ErrImportAddress -> Rep ErrImportAddress x)
-> (forall x. Rep ErrImportAddress x -> ErrImportAddress)
-> Generic ErrImportAddress
forall x. Rep ErrImportAddress x -> ErrImportAddress
forall x. ErrImportAddress -> Rep ErrImportAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrImportAddress x -> ErrImportAddress
$cfrom :: forall x. ErrImportAddress -> Rep ErrImportAddress x
Generic, ErrImportAddress -> ErrImportAddress -> Bool
(ErrImportAddress -> ErrImportAddress -> Bool)
-> (ErrImportAddress -> ErrImportAddress -> Bool)
-> Eq ErrImportAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrImportAddress -> ErrImportAddress -> Bool
$c/= :: ErrImportAddress -> ErrImportAddress -> Bool
== :: ErrImportAddress -> ErrImportAddress -> Bool
$c== :: ErrImportAddress -> ErrImportAddress -> Bool
Eq, Int -> ErrImportAddress -> ShowS
[ErrImportAddress] -> ShowS
ErrImportAddress -> String
(Int -> ErrImportAddress -> ShowS)
-> (ErrImportAddress -> String)
-> ([ErrImportAddress] -> ShowS)
-> Show ErrImportAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrImportAddress] -> ShowS
$cshowList :: [ErrImportAddress] -> ShowS
show :: ErrImportAddress -> String
$cshow :: ErrImportAddress -> String
showsPrec :: Int -> ErrImportAddress -> ShowS
$cshowsPrec :: Int -> ErrImportAddress -> ShowS
Show)
instance PaymentAddress n ByronKey => GenChange (RndState n) where
type ArgGenChange (RndState n) = (ByronKey 'RootK XPrv, Passphrase "encryption")
genChange :: ArgGenChange (RndState n) -> RndState n -> (Address, RndState n)
genChange (rootXPrv, pwd) RndState n
st = (Address
address, RndState n
st')
where
address :: Address
address = ByronKey 'RootK XPrv
-> Passphrase "encryption" -> DerivationPath -> Address
forall (n :: NetworkDiscriminant).
PaymentAddress n ByronKey =>
ByronKey 'RootK XPrv
-> Passphrase "encryption" -> DerivationPath -> Address
deriveRndStateAddress @n ByronKey 'RootK XPrv
rootXPrv Passphrase "encryption"
pwd DerivationPath
path
(DerivationPath
path, StdGen
gen') = StdGen
-> Index 'Hardened 'AccountK
-> Set DerivationPath
-> (DerivationPath, StdGen)
findUnusedPath (RndState n -> StdGen
forall (network :: NetworkDiscriminant). RndState network -> StdGen
gen RndState n
st) (RndState n -> Index 'Hardened 'AccountK
forall (n :: NetworkDiscriminant).
RndState n -> Index 'Hardened 'AccountK
accountIndex RndState n
st)
(RndState n -> Set DerivationPath
forall s. RndStateLike s => s -> Set DerivationPath
unavailablePaths RndState n
st)
st' :: RndState n
st' = RndState n
st
{ pendingAddresses :: Map DerivationPath Address
pendingAddresses = DerivationPath
-> Address
-> Map DerivationPath Address
-> Map DerivationPath Address
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DerivationPath
path Address
address (RndState n -> Map DerivationPath Address
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath Address
pendingAddresses RndState n
st)
, gen :: StdGen
gen = StdGen
gen'
}
findUnusedPath
:: StdGen
-> Index 'Hardened 'AccountK
-> Set DerivationPath
-> (DerivationPath, StdGen)
findUnusedPath :: StdGen
-> Index 'Hardened 'AccountK
-> Set DerivationPath
-> (DerivationPath, StdGen)
findUnusedPath StdGen
g Index 'Hardened 'AccountK
accIx Set DerivationPath
used
| DerivationPath -> Set DerivationPath -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember DerivationPath
path Set DerivationPath
used = (DerivationPath
path, StdGen
gen')
| Bool
otherwise = StdGen
-> Index 'Hardened 'AccountK
-> Set DerivationPath
-> (DerivationPath, StdGen)
findUnusedPath StdGen
gen' Index 'Hardened 'AccountK
accIx Set DerivationPath
used
where
path :: DerivationPath
path = (Index 'Hardened 'AccountK -> Index 'WholeDomain 'AccountK
forall (derivation :: DerivationType) (level :: Depth).
LiftIndex derivation =>
Index derivation level -> Index 'WholeDomain level
liftIndex Index 'Hardened 'AccountK
accIx, Index 'Hardened 'AddressK -> Index 'WholeDomain 'AddressK
forall (derivation :: DerivationType) (level :: Depth).
LiftIndex derivation =>
Index derivation level -> Index 'WholeDomain level
liftIndex Index 'Hardened 'AddressK
addrIx)
(Index 'Hardened 'AddressK
addrIx, StdGen
gen') = StdGen -> (Index 'Hardened 'AddressK, StdGen)
forall ix g.
(RandomGen g, ix ~ Index 'Hardened 'AddressK) =>
g -> (ix, g)
randomIndex StdGen
g
randomIndex
:: forall ix g. (RandomGen g, ix ~ Index 'Hardened 'AddressK)
=> g
-> (ix, g)
randomIndex :: g -> (ix, g)
randomIndex g
g = (Word32 -> Index 'Hardened 'AddressK
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
ix, g
g')
where
(Word32
ix, g
g') = (Word32, Word32) -> g -> (Word32, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Index 'Hardened 'AddressK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex (Bounded ix => ix
forall a. Bounded a => a
minBound @ix), Index 'Hardened 'AddressK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex (Bounded ix => ix
forall a. Bounded a => a
maxBound @ix)) g
g
deriveAddressKeyFromPath
:: ByronKey 'RootK XPrv
-> Passphrase "encryption"
-> DerivationPath
-> ByronKey 'AddressK XPrv
deriveAddressKeyFromPath :: ByronKey 'RootK XPrv
-> Passphrase "encryption"
-> DerivationPath
-> ByronKey 'AddressK XPrv
deriveAddressKeyFromPath ByronKey 'RootK XPrv
rootXPrv Passphrase "encryption"
passphrase (Index 'WholeDomain 'AccountK
accIx, Index 'WholeDomain 'AddressK
addrIx) = ByronKey 'AddressK XPrv
addrXPrv
where
accXPrv :: ByronKey 'AccountK XPrv
accXPrv = Passphrase "encryption"
-> ByronKey 'RootK XPrv
-> Index 'WholeDomain 'AccountK
-> ByronKey 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
passphrase ByronKey 'RootK XPrv
rootXPrv Index 'WholeDomain 'AccountK
accIx
addrXPrv :: ByronKey 'AddressK XPrv
addrXPrv = Passphrase "encryption"
-> ByronKey 'AccountK XPrv
-> Index 'WholeDomain 'AddressK
-> ByronKey 'AddressK XPrv
deriveAddressPrivateKey Passphrase "encryption"
passphrase ByronKey 'AccountK XPrv
accXPrv Index 'WholeDomain 'AddressK
addrIx
deriveRndStateAddress
:: forall n. (PaymentAddress n ByronKey)
=> ByronKey 'RootK XPrv
-> Passphrase "encryption"
-> DerivationPath
-> Address
deriveRndStateAddress :: ByronKey 'RootK XPrv
-> Passphrase "encryption" -> DerivationPath -> Address
deriveRndStateAddress ByronKey 'RootK XPrv
k Passphrase "encryption"
passphrase DerivationPath
path =
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
PaymentAddress network key =>
key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
PaymentAddress n key =>
key 'AddressK XPub -> Address
paymentAddress @n (ByronKey 'AddressK XPub -> Address)
-> ByronKey 'AddressK XPub -> Address
forall a b. (a -> b) -> a -> b
$ ByronKey 'AddressK XPrv -> ByronKey 'AddressK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey (ByronKey 'AddressK XPrv -> ByronKey 'AddressK XPub)
-> ByronKey 'AddressK XPrv -> ByronKey 'AddressK XPub
forall a b. (a -> b) -> a -> b
$ ByronKey 'RootK XPrv
-> Passphrase "encryption"
-> DerivationPath
-> ByronKey 'AddressK XPrv
deriveAddressKeyFromPath ByronKey 'RootK XPrv
k Passphrase "encryption"
passphrase DerivationPath
path
instance CompareDiscovery (RndState n) where
compareDiscovery :: RndState n -> Address -> Address -> Ordering
compareDiscovery RndState n
_ Address
_ Address
_ = Ordering
EQ
instance KnownAddresses (RndState n) where
knownAddresses :: RndState n -> [(Address, AddressState, NonEmpty DerivationIndex)]
knownAddresses RndState n
s = [[(Address, AddressState, NonEmpty DerivationIndex)]]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a. Monoid a => [a] -> a
mconcat
[ (NonEmpty DerivationIndex
-> (Address, AddressState)
-> (Address, AddressState, NonEmpty DerivationIndex))
-> Map DerivationPath (Address, AddressState)
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall v result.
(NonEmpty DerivationIndex -> v -> result)
-> Map DerivationPath v -> [result]
toListWithPath (\NonEmpty DerivationIndex
path (Address
addr, AddressState
state) -> (Address
addr, AddressState
state, NonEmpty DerivationIndex
path))
(RndState n -> Map DerivationPath (Address, AddressState)
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath (Address, AddressState)
discoveredAddresses RndState n
s)
, (NonEmpty DerivationIndex
-> Address -> (Address, AddressState, NonEmpty DerivationIndex))
-> Map DerivationPath Address
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall v result.
(NonEmpty DerivationIndex -> v -> result)
-> Map DerivationPath v -> [result]
toListWithPath (\NonEmpty DerivationIndex
path Address
addr -> (Address
addr, AddressState
Unused, NonEmpty DerivationIndex
path))
(RndState n -> Map DerivationPath Address
forall (network :: NetworkDiscriminant).
RndState network -> Map DerivationPath Address
pendingAddresses RndState n
s)
]
where
toListWithPath
:: (NonEmpty DerivationIndex -> v -> result)
-> Map DerivationPath v
-> [result]
toListWithPath :: (NonEmpty DerivationIndex -> v -> result)
-> Map DerivationPath v -> [result]
toListWithPath NonEmpty DerivationIndex -> v -> result
mk =
(DerivationPath -> v -> [result] -> [result])
-> [result] -> Map DerivationPath v -> [result]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
(\DerivationPath
path v
v [result]
result -> NonEmpty DerivationIndex -> v -> result
mk (DerivationPath -> NonEmpty DerivationIndex
toDerivationIndexes DerivationPath
path) v
v result -> [result] -> [result]
forall a. a -> [a] -> [a]
: [result]
result)
[]
instance MaybeLight (RndState n) where
maybeDiscover :: Maybe (LightDiscoverTxs (RndState n))
maybeDiscover = Maybe (LightDiscoverTxs (RndState n))
forall a. Maybe a
Nothing
newtype RndAnyState (network :: NetworkDiscriminant) (p :: Nat) = RndAnyState
{ RndAnyState network p -> RndState network
innerState :: RndState network
} deriving ((forall x. RndAnyState network p -> Rep (RndAnyState network p) x)
-> (forall x.
Rep (RndAnyState network p) x -> RndAnyState network p)
-> Generic (RndAnyState network p)
forall x. Rep (RndAnyState network p) x -> RndAnyState network p
forall x. RndAnyState network p -> Rep (RndAnyState network p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (network :: NetworkDiscriminant) (p :: Nat) x.
Rep (RndAnyState network p) x -> RndAnyState network p
forall (network :: NetworkDiscriminant) (p :: Nat) x.
RndAnyState network p -> Rep (RndAnyState network p) x
$cto :: forall (network :: NetworkDiscriminant) (p :: Nat) x.
Rep (RndAnyState network p) x -> RndAnyState network p
$cfrom :: forall (network :: NetworkDiscriminant) (p :: Nat) x.
RndAnyState network p -> Rep (RndAnyState network p) x
Generic, Int -> RndAnyState network p -> ShowS
[RndAnyState network p] -> ShowS
RndAnyState network p -> String
(Int -> RndAnyState network p -> ShowS)
-> (RndAnyState network p -> String)
-> ([RndAnyState network p] -> ShowS)
-> Show (RndAnyState network p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (network :: NetworkDiscriminant) (p :: Nat).
Int -> RndAnyState network p -> ShowS
forall (network :: NetworkDiscriminant) (p :: Nat).
[RndAnyState network p] -> ShowS
forall (network :: NetworkDiscriminant) (p :: Nat).
RndAnyState network p -> String
showList :: [RndAnyState network p] -> ShowS
$cshowList :: forall (network :: NetworkDiscriminant) (p :: Nat).
[RndAnyState network p] -> ShowS
show :: RndAnyState network p -> String
$cshow :: forall (network :: NetworkDiscriminant) (p :: Nat).
RndAnyState network p -> String
showsPrec :: Int -> RndAnyState network p -> ShowS
$cshowsPrec :: forall (network :: NetworkDiscriminant) (p :: Nat).
Int -> RndAnyState network p -> ShowS
Show)
instance NFData (RndAnyState n p)
mkRndAnyState
:: forall (p :: Nat) n. ()
=> ByronKey 'RootK XPrv
-> Int
-> RndAnyState n p
mkRndAnyState :: ByronKey 'RootK XPrv -> Int -> RndAnyState n p
mkRndAnyState ByronKey 'RootK XPrv
key Int
seed = RndAnyState :: forall (network :: NetworkDiscriminant) (p :: Nat).
RndState network -> RndAnyState network p
RndAnyState
{ innerState :: RndState n
innerState = RndState :: forall (network :: NetworkDiscriminant).
Passphrase "addr-derivation-payload"
-> Index 'Hardened 'AccountK
-> Map DerivationPath (Address, AddressState)
-> Map DerivationPath Address
-> StdGen
-> RndState network
RndState
{ hdPassphrase :: Passphrase "addr-derivation-payload"
hdPassphrase = ByronKey 'RootK XPrv -> Passphrase "addr-derivation-payload"
forall (depth :: Depth) key.
ByronKey depth key -> Passphrase "addr-derivation-payload"
payloadPassphrase ByronKey 'RootK XPrv
key
, accountIndex :: Index 'Hardened 'AccountK
accountIndex = Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound
, discoveredAddresses :: Map DerivationPath (Address, AddressState)
discoveredAddresses = Map DerivationPath (Address, AddressState)
forall a. Monoid a => a
mempty
, pendingAddresses :: Map DerivationPath Address
pendingAddresses = Map DerivationPath Address
forall a. Monoid a => a
mempty
, gen :: StdGen
gen = Int -> StdGen
mkStdGen Int
seed
}
}
instance RndStateLike (RndAnyState n p) where
importAddress :: Address
-> RndAnyState n p -> Either ErrImportAddress (RndAnyState n p)
importAddress Address
addr (RndAnyState RndState n
inner) =
RndState n -> RndAnyState n p
forall (network :: NetworkDiscriminant) (p :: Nat).
RndState network -> RndAnyState network p
RndAnyState (RndState n -> RndAnyState n p)
-> Either ErrImportAddress (RndState n)
-> Either ErrImportAddress (RndAnyState n p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> RndState n -> Either ErrImportAddress (RndState n)
forall s.
RndStateLike s =>
Address -> s -> Either ErrImportAddress s
importAddress Address
addr RndState n
inner
addPendingAddress :: Address -> DerivationPath -> RndAnyState n p -> RndAnyState n p
addPendingAddress Address
addr DerivationPath
path (RndAnyState RndState n
inner) =
RndState n -> RndAnyState n p
forall (network :: NetworkDiscriminant) (p :: Nat).
RndState network -> RndAnyState network p
RndAnyState (RndState n -> RndAnyState n p) -> RndState n -> RndAnyState n p
forall a b. (a -> b) -> a -> b
$ Address -> DerivationPath -> RndState n -> RndState n
forall s. RndStateLike s => Address -> DerivationPath -> s -> s
addPendingAddress Address
addr DerivationPath
path RndState n
inner
unavailablePaths :: RndAnyState n p -> Set DerivationPath
unavailablePaths (RndAnyState RndState n
inner) =
RndState n -> Set DerivationPath
forall s. RndStateLike s => s -> Set DerivationPath
unavailablePaths RndState n
inner
defaultAccountIndex :: RndAnyState n p -> Index 'Hardened 'AccountK
defaultAccountIndex (RndAnyState RndState n
inner) =
RndState n -> Index 'Hardened 'AccountK
forall s. RndStateLike s => s -> Index 'Hardened 'AccountK
defaultAccountIndex RndState n
inner
withRNG :: RndAnyState n p -> (StdGen -> (a, StdGen)) -> (a, RndAnyState n p)
withRNG (RndAnyState RndState n
inner) StdGen -> (a, StdGen)
action =
(RndState n -> RndAnyState n p)
-> (a, RndState n) -> (a, RndAnyState n p)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second RndState n -> RndAnyState n p
forall (network :: NetworkDiscriminant) (p :: Nat).
RndState network -> RndAnyState network p
RndAnyState ((a, RndState n) -> (a, RndAnyState n p))
-> (a, RndState n) -> (a, RndAnyState n p)
forall a b. (a -> b) -> a -> b
$ RndState n -> (StdGen -> (a, StdGen)) -> (a, RndState n)
forall s a.
RndStateLike s =>
s -> (StdGen -> (a, StdGen)) -> (a, s)
withRNG RndState n
inner StdGen -> (a, StdGen)
action
instance KnownNat p => IsOurs (RndAnyState n p) Address where
isOurs :: Address
-> RndAnyState n p
-> (Maybe (NonEmpty DerivationIndex), RndAnyState n p)
isOurs addr :: Address
addr@(Address ByteString
bytes) st :: RndAnyState n p
st@(RndAnyState RndState n
inner) =
case Address
-> RndState n -> (Maybe (NonEmpty DerivationIndex), RndState n)
forall s entity.
IsOurs s entity =>
entity -> s -> (Maybe (NonEmpty DerivationIndex), s)
isOurs Address
addr RndState n
inner of
(Just NonEmpty DerivationIndex
path, RndState n
inner') ->
(NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just NonEmpty DerivationIndex
path, RndState n -> RndAnyState n p
forall (network :: NetworkDiscriminant) (p :: Nat).
RndState network -> RndAnyState network p
RndAnyState RndState n
inner')
(Maybe (NonEmpty DerivationIndex)
Nothing, RndState n
_) | ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
bytes Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
p ->
let
(DerivationPath
path, StdGen
gen') = StdGen
-> Index 'Hardened 'AccountK
-> Set DerivationPath
-> (DerivationPath, StdGen)
findUnusedPath
(RndState n -> StdGen
forall (network :: NetworkDiscriminant). RndState network -> StdGen
gen RndState n
inner) (RndState n -> Index 'Hardened 'AccountK
forall (n :: NetworkDiscriminant).
RndState n -> Index 'Hardened 'AccountK
accountIndex RndState n
inner) (RndState n -> Set DerivationPath
forall s. RndStateLike s => s -> Set DerivationPath
unavailablePaths RndState n
inner)
inner' :: RndState n
inner' = Address
-> AddressState -> DerivationPath -> RndState n -> RndState n
forall (n :: NetworkDiscriminant).
Address
-> AddressState -> DerivationPath -> RndState n -> RndState n
addDiscoveredAddress
Address
addr AddressState
Used DerivationPath
path (RndState n
inner { gen :: StdGen
gen = StdGen
gen' })
in
(NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just (DerivationPath -> NonEmpty DerivationIndex
toDerivationIndexes DerivationPath
path), RndState n -> RndAnyState n p
forall (network :: NetworkDiscriminant) (p :: Nat).
RndState network -> RndAnyState network p
RndAnyState RndState n
inner')
(Maybe (NonEmpty DerivationIndex)
Nothing, RndState n
_) ->
(Maybe (NonEmpty DerivationIndex)
forall a. Maybe a
Nothing, RndAnyState n 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
forall a. Bounded a => a
maxBound :: Word32) 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)
double :: Integral a => a -> Double
double :: a -> Double
double = a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance IsOurs (RndAnyState n p) RewardAccount where
isOurs :: RewardAccount
-> RndAnyState n p
-> (Maybe (NonEmpty DerivationIndex), RndAnyState n p)
isOurs RewardAccount
_account RndAnyState n p
state = (Maybe (NonEmpty DerivationIndex)
forall a. Maybe a
Nothing, RndAnyState n p
state)
instance KnownNat p => IsOwned (RndAnyState n p) ByronKey where
isOwned :: RndAnyState n p
-> (ByronKey 'RootK XPrv, Passphrase "encryption")
-> Address
-> Maybe (ByronKey 'AddressK XPrv, Passphrase "encryption")
isOwned RndAnyState n p
_ (ByronKey 'RootK XPrv, Passphrase "encryption")
_ Address
_ = Maybe (ByronKey 'AddressK XPrv, Passphrase "encryption")
forall a. Maybe a
Nothing
instance PaymentAddress n ByronKey => GenChange (RndAnyState n p) where
type ArgGenChange (RndAnyState n p) = ArgGenChange (RndState n)
genChange :: ArgGenChange (RndAnyState n p)
-> RndAnyState n p -> (Address, RndAnyState n p)
genChange ArgGenChange (RndAnyState n p)
a (RndAnyState RndState n
s) = RndState n -> RndAnyState n p
forall (network :: NetworkDiscriminant) (p :: Nat).
RndState network -> RndAnyState network p
RndAnyState (RndState n -> RndAnyState n p)
-> (Address, RndState n) -> (Address, RndAnyState n p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArgGenChange (RndState n) -> RndState n -> (Address, RndState n)
forall s. GenChange s => ArgGenChange s -> s -> (Address, s)
genChange ArgGenChange (RndAnyState n p)
ArgGenChange (RndState n)
a RndState n
s
instance CompareDiscovery (RndAnyState n p) where
compareDiscovery :: RndAnyState n p -> Address -> Address -> Ordering
compareDiscovery (RndAnyState RndState n
s) = RndState n -> Address -> Address -> Ordering
forall s. CompareDiscovery s => s -> Address -> Address -> Ordering
compareDiscovery RndState n
s
instance KnownAddresses (RndAnyState n p) where
knownAddresses :: RndAnyState n p
-> [(Address, AddressState, NonEmpty DerivationIndex)]
knownAddresses (RndAnyState RndState n
s) = RndState n -> [(Address, AddressState, NonEmpty DerivationIndex)]
forall s.
KnownAddresses s =>
s -> [(Address, AddressState, NonEmpty DerivationIndex)]
knownAddresses RndState n
s
instance MaybeLight (RndAnyState n p) where
maybeDiscover :: Maybe (LightDiscoverTxs (RndAnyState n p))
maybeDiscover = Maybe (LightDiscoverTxs (RndAnyState n p))
forall a. Maybe a
Nothing