{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Implementation of address derivation for 'Shelley' Keys.

module Cardano.Wallet.Primitive.AddressDerivation.Shelley
    ( -- * Types
      ShelleyKey(..)

    -- * Constants
    , minSeedLengthBytes

    -- * Generation and derivation
    , generateKeyFromSeed
    , unsafeGenerateKeyFromSeed
    , unsafeGenerateKeyFromSeedShelley
    , deriveAccountPrivateKeyShelley
    , deriveAddressPrivateKeyShelley
    , deriveAddressPublicKeyShelley

    -- * Reward Account
    , toRewardAccountRaw
    ) where

import Prelude

import Cardano.Crypto.Wallet
    ( DerivationScheme (..)
    , XPrv
    , XPub (..)
    , deriveXPrv
    , deriveXPub
    , generateNew
    , toXPub
    , unXPrv
    , unXPub
    , xprv
    , xpub
    )
import Cardano.Mnemonic
    ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy )
import Cardano.Wallet.Primitive.AddressDerivation
    ( BoundedAddressLength (..)
    , DelegationAddress (..)
    , Depth (..)
    , DerivationIndex (..)
    , DerivationType (..)
    , HardDerivation (..)
    , Index (..)
    , KeyFingerprint (..)
    , MkKeyFingerprint (..)
    , NetworkDiscriminant (..)
    , PaymentAddress (..)
    , PersistPrivateKey (..)
    , PersistPublicKey (..)
    , RewardAccount (..)
    , Role (..)
    , SoftDerivation (..)
    , ToRewardAccount (..)
    , WalletKey (..)
    , fromHex
    , hex
    , mutableAccount
    )
import Cardano.Wallet.Primitive.AddressDiscovery
    ( DiscoverTxs (..), GetPurpose (..), IsOurs (..), MaybeLight (..) )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    ( DerivationPrefix (..)
    , SeqState (..)
    , coinTypeAda
    , discoverSeqWithRewards
    , purposeBIP44
    , purposeCIP1852
    , rewardAccountKey
    )
import Cardano.Wallet.Primitive.Passphrase
    ( Passphrase (..), PassphraseHash (..), changePassphraseXPrv )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Util
    ( invariant )
import Control.DeepSeq
    ( NFData (..) )
import Control.Monad
    ( guard, (<=<) )
import Crypto.Hash
    ( hash )
import Crypto.Hash.Algorithms
    ( Blake2b_224 (..) )
import Crypto.Hash.IO
    ( HashAlgorithm (hashDigestSize) )
import Crypto.Hash.Utils
    ( blake2b224 )
import Data.Binary.Put
    ( putByteString, putWord8, runPut )
import Data.ByteString
    ( ByteString )
import Data.Maybe
    ( fromMaybe )
import Data.Proxy
    ( Proxy (..) )
import GHC.Generics
    ( Generic )

import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NE

{-------------------------------------------------------------------------------
                            Sequential Derivation
-------------------------------------------------------------------------------}

-- | A cryptographic key for Shelley address derivation, with phantom-types to
-- disambiguate derivation paths
--
-- @
-- let rootPrivateKey = ShelleyKey 'RootK XPrv
-- let accountPubKey = ShelleyKey 'AccountK XPub
-- let addressPubKey = ShelleyKey 'AddressK XPub
-- @
newtype ShelleyKey (depth :: Depth) key =
    ShelleyKey { ShelleyKey depth key -> key
getKey :: key }
    deriving stock ((forall x. ShelleyKey depth key -> Rep (ShelleyKey depth key) x)
-> (forall x. Rep (ShelleyKey depth key) x -> ShelleyKey depth key)
-> Generic (ShelleyKey depth key)
forall x. Rep (ShelleyKey depth key) x -> ShelleyKey depth key
forall x. ShelleyKey depth key -> Rep (ShelleyKey depth key) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (depth :: Depth) key x.
Rep (ShelleyKey depth key) x -> ShelleyKey depth key
forall (depth :: Depth) key x.
ShelleyKey depth key -> Rep (ShelleyKey depth key) x
$cto :: forall (depth :: Depth) key x.
Rep (ShelleyKey depth key) x -> ShelleyKey depth key
$cfrom :: forall (depth :: Depth) key x.
ShelleyKey depth key -> Rep (ShelleyKey depth key) x
Generic, Int -> ShelleyKey depth key -> ShowS
[ShelleyKey depth key] -> ShowS
ShelleyKey depth key -> String
(Int -> ShelleyKey depth key -> ShowS)
-> (ShelleyKey depth key -> String)
-> ([ShelleyKey depth key] -> ShowS)
-> Show (ShelleyKey depth key)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (depth :: Depth) key.
Show key =>
Int -> ShelleyKey depth key -> ShowS
forall (depth :: Depth) key.
Show key =>
[ShelleyKey depth key] -> ShowS
forall (depth :: Depth) key.
Show key =>
ShelleyKey depth key -> String
showList :: [ShelleyKey depth key] -> ShowS
$cshowList :: forall (depth :: Depth) key.
Show key =>
[ShelleyKey depth key] -> ShowS
show :: ShelleyKey depth key -> String
$cshow :: forall (depth :: Depth) key.
Show key =>
ShelleyKey depth key -> String
showsPrec :: Int -> ShelleyKey depth key -> ShowS
$cshowsPrec :: forall (depth :: Depth) key.
Show key =>
Int -> ShelleyKey depth key -> ShowS
Show, ShelleyKey depth key -> ShelleyKey depth key -> Bool
(ShelleyKey depth key -> ShelleyKey depth key -> Bool)
-> (ShelleyKey depth key -> ShelleyKey depth key -> Bool)
-> Eq (ShelleyKey depth key)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (depth :: Depth) key.
Eq key =>
ShelleyKey depth key -> ShelleyKey depth key -> Bool
/= :: ShelleyKey depth key -> ShelleyKey depth key -> Bool
$c/= :: forall (depth :: Depth) key.
Eq key =>
ShelleyKey depth key -> ShelleyKey depth key -> Bool
== :: ShelleyKey depth key -> ShelleyKey depth key -> Bool
$c== :: forall (depth :: Depth) key.
Eq key =>
ShelleyKey depth key -> ShelleyKey depth key -> Bool
Eq)

instance (NFData key) => NFData (ShelleyKey depth key)

-- | The minimum seed length for 'generateKeyFromSeed' and
-- 'unsafeGenerateKeyFromSeed'.
minSeedLengthBytes :: Int
minSeedLengthBytes :: Int
minSeedLengthBytes = Int
16

-- | Generate a root key from a corresponding seed.
-- The seed should be at least 16 bytes.
generateKeyFromSeed
    :: (SomeMnemonic, Maybe SomeMnemonic)
       -- ^ The actual seed and its recovery / generation passphrase
    -> Passphrase "encryption"
    -> ShelleyKey 'RootK XPrv
generateKeyFromSeed :: (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> ShelleyKey 'RootK XPrv
generateKeyFromSeed = (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> ShelleyKey 'RootK XPrv
forall (depth :: Depth).
(SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> ShelleyKey depth XPrv
unsafeGenerateKeyFromSeed

-- | Generate a new key from seed. Note that the @depth@ is left open so that
-- the caller gets to decide what type of key this is. This is mostly for
-- testing, in practice, seeds are used to represent root keys, and one should
-- use 'generateKeyFromSeed'.
unsafeGenerateKeyFromSeed
    :: (SomeMnemonic, Maybe SomeMnemonic)
        -- ^ The actual seed and its recovery / generation passphrase
    -> Passphrase "encryption"
    -> ShelleyKey depth XPrv
unsafeGenerateKeyFromSeed :: (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> ShelleyKey depth XPrv
unsafeGenerateKeyFromSeed (SomeMnemonic, Maybe SomeMnemonic)
mnemonics Passphrase "encryption"
pwd =
    XPrv -> ShelleyKey depth XPrv
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (XPrv -> ShelleyKey depth XPrv) -> XPrv -> ShelleyKey depth XPrv
forall a b. (a -> b) -> a -> b
$ (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> XPrv
unsafeGenerateKeyFromSeedShelley (SomeMnemonic, Maybe SomeMnemonic)
mnemonics Passphrase "encryption"
pwd

unsafeGenerateKeyFromSeedShelley
    :: (SomeMnemonic, Maybe SomeMnemonic)
        -- ^ The actual seed and its recovery / generation passphrase
    -> Passphrase "encryption"
    -> XPrv
unsafeGenerateKeyFromSeedShelley :: (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> XPrv
unsafeGenerateKeyFromSeedShelley (SomeMnemonic
root, Maybe SomeMnemonic
m2nd) Passphrase "encryption"
pwd =
    ScrubbedBytes -> ScrubbedBytes -> ScrubbedBytes -> XPrv
forall keyPassPhrase generationPassPhrase seed.
(ByteArrayAccess keyPassPhrase,
 ByteArrayAccess generationPassPhrase, ByteArrayAccess seed) =>
seed -> generationPassPhrase -> keyPassPhrase -> XPrv
generateNew ScrubbedBytes
seed' (ScrubbedBytes
-> (SomeMnemonic -> ScrubbedBytes)
-> Maybe SomeMnemonic
-> ScrubbedBytes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ScrubbedBytes
forall a. Monoid a => a
mempty SomeMnemonic -> ScrubbedBytes
mnemonicToBytes Maybe SomeMnemonic
m2nd) (Passphrase "encryption" -> ScrubbedBytes
forall (purpose :: Symbol). Passphrase purpose -> ScrubbedBytes
unPassphrase Passphrase "encryption"
pwd)
  where
    mnemonicToBytes :: SomeMnemonic -> ScrubbedBytes
mnemonicToBytes (SomeMnemonic Mnemonic mw
mw) = Entropy (EntropySize mw) -> ScrubbedBytes
forall (n :: Nat). Entropy n -> ScrubbedBytes
entropyToBytes (Entropy (EntropySize mw) -> ScrubbedBytes)
-> Entropy (EntropySize mw) -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ Mnemonic mw -> Entropy (EntropySize mw)
forall (mw :: Nat). Mnemonic mw -> Entropy (EntropySize mw)
mnemonicToEntropy Mnemonic mw
mw
    seed :: ScrubbedBytes
seed  = SomeMnemonic -> ScrubbedBytes
mnemonicToBytes SomeMnemonic
root
    seed' :: ScrubbedBytes
seed' = String -> ScrubbedBytes -> (ScrubbedBytes -> Bool) -> ScrubbedBytes
forall a. HasCallStack => String -> a -> (a -> Bool) -> a
invariant
        (String
"seed length : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
seed) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" in (Passphrase \"seed\") is not valid")
        ScrubbedBytes
seed
        (\ScrubbedBytes
s -> ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minSeedLengthBytes Bool -> Bool -> Bool
&& ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255)

deriveAccountPrivateKeyShelley
    :: Index 'Hardened 'PurposeK
    -> Passphrase "encryption"
    -> XPrv
    -> Index 'Hardened 'AccountK
    -> XPrv
deriveAccountPrivateKeyShelley :: Index 'Hardened 'PurposeK
-> Passphrase "encryption"
-> XPrv
-> Index 'Hardened 'AccountK
-> XPrv
deriveAccountPrivateKeyShelley Index 'Hardened 'PurposeK
purpose (Passphrase ScrubbedBytes
pwd) XPrv
rootXPrv (Index Word32
accIx) =
    let
        purposeXPrv :: XPrv
purposeXPrv = -- lvl1 derivation; hardened derivation of purpose'
            DerivationScheme -> ScrubbedBytes -> XPrv -> Word32 -> XPrv
forall passPhrase.
ByteArrayAccess passPhrase =>
DerivationScheme -> passPhrase -> XPrv -> Word32 -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 ScrubbedBytes
pwd XPrv
rootXPrv (Index 'Hardened 'PurposeK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'PurposeK
purpose)
        coinTypeXPrv :: XPrv
coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type'
            DerivationScheme -> ScrubbedBytes -> XPrv -> Word32 -> XPrv
forall passPhrase.
ByteArrayAccess passPhrase =>
DerivationScheme -> passPhrase -> XPrv -> Word32 -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 ScrubbedBytes
pwd XPrv
purposeXPrv (Index 'Hardened 'CoinTypeK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'CoinTypeK
coinTypeAda)
     -- lvl3 derivation; hardened derivation of account' index
    in DerivationScheme -> ScrubbedBytes -> XPrv -> Word32 -> XPrv
forall passPhrase.
ByteArrayAccess passPhrase =>
DerivationScheme -> passPhrase -> XPrv -> Word32 -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 ScrubbedBytes
pwd XPrv
coinTypeXPrv Word32
accIx

deriveAddressPrivateKeyShelley
    :: Enum a
    => Passphrase "encryption"
    -> XPrv
    -> a
    -> Index derivationType level
    -> XPrv
deriveAddressPrivateKeyShelley :: Passphrase "encryption"
-> XPrv -> a -> Index derivationType level -> XPrv
deriveAddressPrivateKeyShelley (Passphrase ScrubbedBytes
pwd) XPrv
accXPrv a
role (Index Word32
addrIx) =
    let
        changeCode :: Word32
changeCode =
            Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
role
        changeXPrv :: XPrv
changeXPrv = -- lvl4 derivation; soft derivation of change chain
            DerivationScheme -> ScrubbedBytes -> XPrv -> Word32 -> XPrv
forall passPhrase.
ByteArrayAccess passPhrase =>
DerivationScheme -> passPhrase -> XPrv -> Word32 -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 ScrubbedBytes
pwd XPrv
accXPrv Word32
changeCode
       -- lvl5 derivation; soft derivation of address index
    in DerivationScheme -> ScrubbedBytes -> XPrv -> Word32 -> XPrv
forall passPhrase.
ByteArrayAccess passPhrase =>
DerivationScheme -> passPhrase -> XPrv -> Word32 -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 ScrubbedBytes
pwd XPrv
changeXPrv Word32
addrIx

deriveAddressPublicKeyShelley
    :: Enum a
    => XPub
    -> a
    -> Index derivationType level
    -> XPub
deriveAddressPublicKeyShelley :: XPub -> a -> Index derivationType level -> XPub
deriveAddressPublicKeyShelley XPub
accXPub a
role (Index Word32
addrIx) =
    XPub -> Maybe XPub -> XPub
forall a. a -> Maybe a -> a
fromMaybe XPub
errWrongIndex (Maybe XPub -> XPub) -> Maybe XPub -> XPub
forall a b. (a -> b) -> a -> b
$ do
        let changeCode :: Word32
changeCode = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
role
        XPub
changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain
            DerivationScheme -> XPub -> Word32 -> Maybe XPub
deriveXPub DerivationScheme
DerivationScheme2 XPub
accXPub Word32
changeCode
        -- lvl5 derivation in bip44 is derivation of address chain
        DerivationScheme -> XPub -> Word32 -> Maybe XPub
deriveXPub DerivationScheme
DerivationScheme2 XPub
changeXPub Word32
addrIx
  where
      errWrongIndex :: XPub
errWrongIndex = String -> XPub
forall a. HasCallStack => String -> a
error (String -> XPub) -> String -> XPub
forall a b. (a -> b) -> a -> b
$
          String
"deriveAddressPublicKey failed: was given an hardened (or too big) \
          \index for soft path derivation ( " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
addrIx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"). This is \
          \either a programmer error, or, we may have reached the maximum \
          \number of addresses for a given wallet."

instance HardDerivation ShelleyKey where
    type AddressIndexDerivationType ShelleyKey = 'Soft

    deriveAccountPrivateKey :: Passphrase "encryption"
-> ShelleyKey 'RootK XPrv
-> Index 'Hardened 'AccountK
-> ShelleyKey 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
pwd (ShelleyKey XPrv
rootXPrv) Index 'Hardened 'AccountK
ix =
        XPrv -> ShelleyKey 'AccountK XPrv
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (XPrv -> ShelleyKey 'AccountK XPrv)
-> XPrv -> ShelleyKey 'AccountK XPrv
forall a b. (a -> b) -> a -> b
$ Index 'Hardened 'PurposeK
-> Passphrase "encryption"
-> XPrv
-> Index 'Hardened 'AccountK
-> XPrv
deriveAccountPrivateKeyShelley Index 'Hardened 'PurposeK
purposeCIP1852 Passphrase "encryption"
pwd XPrv
rootXPrv Index 'Hardened 'AccountK
ix

    deriveAddressPrivateKey :: Passphrase "encryption"
-> ShelleyKey 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType ShelleyKey) 'AddressK
-> ShelleyKey 'AddressK XPrv
deriveAddressPrivateKey Passphrase "encryption"
pwd (ShelleyKey XPrv
accXPrv) Role
role Index (AddressIndexDerivationType ShelleyKey) 'AddressK
ix =
        XPrv -> ShelleyKey 'AddressK XPrv
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (XPrv -> ShelleyKey 'AddressK XPrv)
-> XPrv -> ShelleyKey 'AddressK XPrv
forall a b. (a -> b) -> a -> b
$ Passphrase "encryption"
-> XPrv -> Role -> Index 'Soft 'AddressK -> XPrv
forall a (derivationType :: DerivationType) (level :: Depth).
Enum a =>
Passphrase "encryption"
-> XPrv -> a -> Index derivationType level -> XPrv
deriveAddressPrivateKeyShelley Passphrase "encryption"
pwd XPrv
accXPrv Role
role Index (AddressIndexDerivationType ShelleyKey) 'AddressK
Index 'Soft 'AddressK
ix

instance SoftDerivation ShelleyKey where
    deriveAddressPublicKey :: ShelleyKey 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> ShelleyKey 'AddressK XPub
deriveAddressPublicKey (ShelleyKey XPub
accXPub) Role
role Index 'Soft 'AddressK
ix =
        XPub -> ShelleyKey 'AddressK XPub
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (XPub -> ShelleyKey 'AddressK XPub)
-> XPub -> ShelleyKey 'AddressK XPub
forall a b. (a -> b) -> a -> b
$ XPub -> Role -> Index 'Soft 'AddressK -> XPub
forall a (derivationType :: DerivationType) (level :: Depth).
Enum a =>
XPub -> a -> Index derivationType level -> XPub
deriveAddressPublicKeyShelley XPub
accXPub Role
role Index 'Soft 'AddressK
ix

{-------------------------------------------------------------------------------
                            WalletKey implementation
-------------------------------------------------------------------------------}

instance WalletKey ShelleyKey where
    changePassphrase :: (PassphraseScheme, Passphrase "user")
-> (PassphraseScheme, Passphrase "user")
-> ShelleyKey depth XPrv
-> ShelleyKey depth XPrv
changePassphrase (PassphraseScheme, Passphrase "user")
oldPwd (PassphraseScheme, Passphrase "user")
newPwd (ShelleyKey XPrv
prv) =
        XPrv -> ShelleyKey depth XPrv
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (XPrv -> ShelleyKey depth XPrv) -> XPrv -> ShelleyKey depth XPrv
forall a b. (a -> b) -> a -> b
$ (PassphraseScheme, Passphrase "user")
-> (PassphraseScheme, Passphrase "user") -> XPrv -> XPrv
changePassphraseXPrv (PassphraseScheme, Passphrase "user")
oldPwd (PassphraseScheme, Passphrase "user")
newPwd XPrv
prv

    publicKey :: ShelleyKey depth XPrv -> ShelleyKey depth XPub
publicKey (ShelleyKey XPrv
prv) =
        XPub -> ShelleyKey depth XPub
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (HasCallStack => XPrv -> XPub
XPrv -> XPub
toXPub XPrv
prv)

    digest :: ShelleyKey depth XPub -> Digest a
digest (ShelleyKey XPub
pub) =
        ByteString -> Digest a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash (XPub -> ByteString
unXPub XPub
pub)

    getRawKey :: ShelleyKey depth raw -> raw
getRawKey =
        ShelleyKey depth raw -> raw
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey

    liftRawKey :: raw -> ShelleyKey depth raw
liftRawKey =
        raw -> ShelleyKey depth raw
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey

    keyTypeDescriptor :: Proxy ShelleyKey -> String
keyTypeDescriptor Proxy ShelleyKey
_ =
        String
"she"

{-------------------------------------------------------------------------------
                         Relationship Key / Address
-------------------------------------------------------------------------------}

instance GetPurpose ShelleyKey where
    getPurpose :: Index 'Hardened 'PurposeK
getPurpose = Index 'Hardened 'PurposeK
purposeCIP1852

instance PaymentAddress 'Mainnet ShelleyKey where
    paymentAddress :: ShelleyKey 'AddressK XPub -> Address
paymentAddress ShelleyKey 'AddressK XPub
paymentK = do
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
enterprise Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
paymentK
      where
        enterprise :: Word8
enterprise = Word8
96
        networkId :: Word8
networkId = Word8
1

    liftPaymentAddress :: KeyFingerprint "payment" ShelleyKey -> Address
liftPaymentAddress (KeyFingerprint ByteString
fingerprint) =
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
enterprise Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString ByteString
fingerprint
      where
        enterprise :: Word8
enterprise = Word8
96
        networkId :: Word8
networkId = Word8
1

instance PaymentAddress ('Testnet pm) ShelleyKey where
    paymentAddress :: ShelleyKey 'AddressK XPub -> Address
paymentAddress ShelleyKey 'AddressK XPub
paymentK =
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
enterprise Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
paymentK
      where
        enterprise :: Word8
enterprise = Word8
96
        networkId :: Word8
networkId = Word8
0

    liftPaymentAddress :: KeyFingerprint "payment" ShelleyKey -> Address
liftPaymentAddress (KeyFingerprint ByteString
fingerprint) =
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
enterprise Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString ByteString
fingerprint
      where
        enterprise :: Word8
enterprise = Word8
96
        networkId :: Word8
networkId = Word8
0

instance DelegationAddress 'Mainnet ShelleyKey where
    delegationAddress :: ShelleyKey 'AddressK XPub -> ShelleyKey 'AddressK XPub -> Address
delegationAddress ShelleyKey 'AddressK XPub
paymentK ShelleyKey 'AddressK XPub
stakingK =
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
base Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
paymentK
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
stakingK
      where
        base :: Word8
base = Word8
0
        networkId :: Word8
networkId = Word8
1

    liftDelegationAddress :: KeyFingerprint "payment" ShelleyKey
-> ShelleyKey 'AddressK XPub -> Address
liftDelegationAddress (KeyFingerprint ByteString
fingerprint) ShelleyKey 'AddressK XPub
stakingK =
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
base Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString ByteString
fingerprint
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224(ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
stakingK
      where
        base :: Word8
base = Word8
0
        networkId :: Word8
networkId = Word8
1

instance DelegationAddress ('Testnet pm) ShelleyKey where
    delegationAddress :: ShelleyKey 'AddressK XPub -> ShelleyKey 'AddressK XPub -> Address
delegationAddress ShelleyKey 'AddressK XPub
paymentK ShelleyKey 'AddressK XPub
stakingK =
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
base Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
paymentK
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
stakingK
      where
        base :: Word8
base = Word8
0
        networkId :: Word8
networkId = Word8
0

    liftDelegationAddress :: KeyFingerprint "payment" ShelleyKey
-> ShelleyKey 'AddressK XPub -> Address
liftDelegationAddress (KeyFingerprint ByteString
fingerprint) ShelleyKey 'AddressK XPub
stakingK =
        ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
            Word8 -> Put
putWord8 (Word8
base Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
networkId)
            ByteString -> Put
putByteString ByteString
fingerprint
            ByteString -> Put
putByteString (ByteString -> Put)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (ShelleyKey 'AddressK XPub -> ByteString)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'AddressK XPub -> Put)
-> ShelleyKey 'AddressK XPub -> Put
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub
stakingK
      where
        base :: Word8
base = Word8
0
        networkId :: Word8
networkId = Word8
0

instance MkKeyFingerprint ShelleyKey Address where
    paymentKeyFingerprint :: Address
-> Either
     (ErrMkKeyFingerprint ShelleyKey Address)
     (KeyFingerprint "payment" ShelleyKey)
paymentKeyFingerprint (Address ByteString
bytes) =
        KeyFingerprint "payment" ShelleyKey
-> Either
     (ErrMkKeyFingerprint ShelleyKey Address)
     (KeyFingerprint "payment" ShelleyKey)
forall a b. b -> Either a b
Right (KeyFingerprint "payment" ShelleyKey
 -> Either
      (ErrMkKeyFingerprint ShelleyKey Address)
      (KeyFingerprint "payment" ShelleyKey))
-> KeyFingerprint "payment" ShelleyKey
-> Either
     (ErrMkKeyFingerprint ShelleyKey Address)
     (KeyFingerprint "payment" ShelleyKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyFingerprint "payment" ShelleyKey
forall k (s :: Symbol) (key :: k).
ByteString -> KeyFingerprint s key
KeyFingerprint (ByteString -> KeyFingerprint "payment" ShelleyKey)
-> ByteString -> KeyFingerprint "payment" ShelleyKey
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
hashSize (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
bytes

instance MkKeyFingerprint ShelleyKey (Proxy (n :: NetworkDiscriminant), ShelleyKey 'AddressK XPub) where
    paymentKeyFingerprint :: (Proxy n, ShelleyKey 'AddressK XPub)
-> Either
     (ErrMkKeyFingerprint
        ShelleyKey (Proxy n, ShelleyKey 'AddressK XPub))
     (KeyFingerprint "payment" ShelleyKey)
paymentKeyFingerprint (Proxy n
_, ShelleyKey 'AddressK XPub
paymentK) =
        KeyFingerprint "payment" ShelleyKey
-> Either
     (ErrMkKeyFingerprint
        ShelleyKey (Proxy n, ShelleyKey 'AddressK XPub))
     (KeyFingerprint "payment" ShelleyKey)
forall a b. b -> Either a b
Right (KeyFingerprint "payment" ShelleyKey
 -> Either
      (ErrMkKeyFingerprint
         ShelleyKey (Proxy n, ShelleyKey 'AddressK XPub))
      (KeyFingerprint "payment" ShelleyKey))
-> KeyFingerprint "payment" ShelleyKey
-> Either
     (ErrMkKeyFingerprint
        ShelleyKey (Proxy n, ShelleyKey 'AddressK XPub))
     (KeyFingerprint "payment" ShelleyKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyFingerprint "payment" ShelleyKey
forall k (s :: Symbol) (key :: k).
ByteString -> KeyFingerprint s key
KeyFingerprint (ByteString -> KeyFingerprint "payment" ShelleyKey)
-> ByteString -> KeyFingerprint "payment" ShelleyKey
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> ByteString
xpubPublicKey (XPub -> ByteString) -> XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey ShelleyKey 'AddressK XPub
paymentK

instance BoundedAddressLength ShelleyKey where
    maxLengthAddressFor :: Proxy ShelleyKey -> Address
maxLengthAddressFor Proxy ShelleyKey
_ = ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
57 Word8
0

{-------------------------------------------------------------------------------
                          Dealing with Rewards
-------------------------------------------------------------------------------}

instance IsOurs (SeqState n ShelleyKey) RewardAccount
  where
    isOurs :: RewardAccount
-> SeqState n ShelleyKey
-> (Maybe (NonEmpty DerivationIndex), SeqState n ShelleyKey)
isOurs RewardAccount
account state :: SeqState n ShelleyKey
state@SeqState{DerivationPrefix
derivationPrefix :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> DerivationPrefix
derivationPrefix :: DerivationPrefix
derivationPrefix} =
        let
            DerivationPrefix (Index 'Hardened 'PurposeK
purpose, Index 'Hardened 'CoinTypeK
coinType, Index 'Hardened 'AccountK
accountIx) = DerivationPrefix
derivationPrefix
            path :: NonEmpty DerivationIndex
path = [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
$ Index 'Soft 'RoleK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Soft 'RoleK
mutableAccount
                , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Soft Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Soft Index 'Soft Any
forall a. Bounded a => a
minBound
                ]
        in
            (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RewardAccount
account RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== RewardAccount
ourAccount) Maybe ()
-> Maybe (NonEmpty DerivationIndex)
-> Maybe (NonEmpty DerivationIndex)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> NonEmpty DerivationIndex -> Maybe (NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just NonEmpty DerivationIndex
path, SeqState n ShelleyKey
state)
      where
        ourAccount :: RewardAccount
ourAccount = ShelleyKey 'AddressK XPub -> RewardAccount
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
k 'AddressK XPub -> RewardAccount
toRewardAccount (ShelleyKey 'AddressK XPub -> RewardAccount)
-> ShelleyKey 'AddressK XPub -> RewardAccount
forall a b. (a -> b) -> a -> b
$ SeqState n ShelleyKey -> ShelleyKey 'AddressK XPub
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> k 'AddressK XPub
rewardAccountKey SeqState n ShelleyKey
state

instance ToRewardAccount ShelleyKey where
    toRewardAccount :: ShelleyKey 'AddressK XPub -> RewardAccount
toRewardAccount = XPub -> RewardAccount
toRewardAccountRaw (XPub -> RewardAccount)
-> (ShelleyKey 'AddressK XPub -> XPub)
-> ShelleyKey 'AddressK XPub
-> RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey
    someRewardAccount :: SomeMnemonic -> (XPrv, RewardAccount, NonEmpty DerivationIndex)
someRewardAccount SomeMnemonic
mw =
        let
            -- NOTE: Accounts from mnemonics are considered to be ITN wallet-like,
            -- therefore bound to purpose=44', 0th account.
            path :: NonEmpty DerivationIndex
path = [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
purposeBIP44
                , 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
coinTypeAda
                , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Hardened Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Hardened Index 'Hardened Any
forall a. Bounded a => a
minBound
                , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Soft 'RoleK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Soft 'RoleK
mutableAccount
                , Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Soft Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Soft Index 'Soft Any
forall a. Bounded a => a
minBound
                ]
        in
            (ShelleyKey 'AddressK XPrv -> XPrv
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey ShelleyKey 'AddressK XPrv
stakK, ShelleyKey 'AddressK XPub -> RewardAccount
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
k 'AddressK XPub -> RewardAccount
toRewardAccount (ShelleyKey 'AddressK XPrv -> ShelleyKey 'AddressK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey ShelleyKey 'AddressK XPrv
stakK), NonEmpty DerivationIndex
path)
      where
        rootK :: ShelleyKey 'RootK XPrv
rootK = (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> ShelleyKey 'RootK XPrv
generateKeyFromSeed (SomeMnemonic
mw, Maybe SomeMnemonic
forall a. Maybe a
Nothing) Passphrase "encryption"
forall a. Monoid a => a
mempty
        acctK :: ShelleyKey 'AccountK XPrv
acctK = Passphrase "encryption"
-> ShelleyKey 'RootK XPrv
-> Index 'Hardened 'AccountK
-> ShelleyKey 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'RootK XPrv
-> Index 'Hardened 'AccountK
-> key 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
forall a. Monoid a => a
mempty ShelleyKey 'RootK XPrv
rootK Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound
        stakK :: ShelleyKey 'AddressK XPrv
stakK = Passphrase "encryption"
-> ShelleyKey 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType ShelleyKey) 'AddressK
-> ShelleyKey 'AddressK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType key) 'AddressK
-> key 'AddressK XPrv
deriveAddressPrivateKey Passphrase "encryption"
forall a. Monoid a => a
mempty ShelleyKey 'AccountK XPrv
acctK Role
MutableAccount Index (AddressIndexDerivationType ShelleyKey) 'AddressK
forall a. Bounded a => a
minBound

toRewardAccountRaw :: XPub -> RewardAccount
toRewardAccountRaw :: XPub -> RewardAccount
toRewardAccountRaw = ByteString -> RewardAccount
RewardAccount (ByteString -> RewardAccount)
-> (XPub -> ByteString) -> XPub -> RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (XPub -> ByteString) -> XPub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey

instance DelegationAddress n ShelleyKey
    => MaybeLight (SeqState n ShelleyKey)
  where
    maybeDiscover :: Maybe (LightDiscoverTxs (SeqState n ShelleyKey))
maybeDiscover = LightDiscoverTxs (SeqState n ShelleyKey)
-> Maybe (LightDiscoverTxs (SeqState n ShelleyKey))
forall a. a -> Maybe a
Just (LightDiscoverTxs (SeqState n ShelleyKey)
 -> Maybe (LightDiscoverTxs (SeqState n ShelleyKey)))
-> LightDiscoverTxs (SeqState n ShelleyKey)
-> Maybe (LightDiscoverTxs (SeqState n ShelleyKey))
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 Monad m =>
 (Either Address RewardAccount -> m ChainEvents)
 -> SeqState n ShelleyKey -> m (ChainEvents, SeqState n ShelleyKey))
-> LightDiscoverTxs (SeqState n ShelleyKey)
forall addr txs s.
(forall (m :: * -> *).
 Monad m =>
 (addr -> m txs) -> s -> m (txs, s))
-> DiscoverTxs addr txs s
DiscoverTxs forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *)
       (m :: * -> *).
(DelegationAddress n k, ToRewardAccount k, Monad m) =>
(Either Address RewardAccount -> m ChainEvents)
-> SeqState n k -> m (ChainEvents, SeqState n k)
forall (m :: * -> *).
Monad m =>
(Either Address RewardAccount -> m ChainEvents)
-> SeqState n ShelleyKey -> m (ChainEvents, SeqState n ShelleyKey)
discoverSeqWithRewards

{-------------------------------------------------------------------------------
                          Storing and retrieving keys
-------------------------------------------------------------------------------}

instance PersistPrivateKey (ShelleyKey 'RootK) where
    serializeXPrv :: (ShelleyKey 'RootK XPrv, PassphraseHash)
-> (ByteString, ByteString)
serializeXPrv (ShelleyKey 'RootK XPrv
k, PassphraseHash
h) =
        ( ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
hex (ByteString -> ByteString)
-> (ShelleyKey 'RootK XPrv -> ByteString)
-> ShelleyKey 'RootK XPrv
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> ByteString
unXPrv (XPrv -> ByteString)
-> (ShelleyKey 'RootK XPrv -> XPrv)
-> ShelleyKey 'RootK XPrv
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey 'RootK XPrv -> XPrv
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey (ShelleyKey 'RootK XPrv -> ByteString)
-> ShelleyKey 'RootK XPrv -> ByteString
forall a b. (a -> b) -> a -> b
$ ShelleyKey 'RootK XPrv
k
        , ScrubbedBytes -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
hex (ScrubbedBytes -> ByteString)
-> (PassphraseHash -> ScrubbedBytes)
-> PassphraseHash
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassphraseHash -> ScrubbedBytes
getPassphraseHash (PassphraseHash -> ByteString) -> PassphraseHash -> ByteString
forall a b. (a -> b) -> a -> b
$ PassphraseHash
h
        )

    unsafeDeserializeXPrv :: (ByteString, ByteString)
-> (ShelleyKey 'RootK XPrv, PassphraseHash)
unsafeDeserializeXPrv (ByteString
k, ByteString
h) = (String -> (ShelleyKey 'RootK XPrv, PassphraseHash))
-> ((ShelleyKey 'RootK XPrv, PassphraseHash)
    -> (ShelleyKey 'RootK XPrv, PassphraseHash))
-> Either String (ShelleyKey 'RootK XPrv, PassphraseHash)
-> (ShelleyKey 'RootK XPrv, PassphraseHash)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> (ShelleyKey 'RootK XPrv, PassphraseHash)
forall p a. p -> a
err (ShelleyKey 'RootK XPrv, PassphraseHash)
-> (ShelleyKey 'RootK XPrv, PassphraseHash)
forall a. a -> a
id (Either String (ShelleyKey 'RootK XPrv, PassphraseHash)
 -> (ShelleyKey 'RootK XPrv, PassphraseHash))
-> Either String (ShelleyKey 'RootK XPrv, PassphraseHash)
-> (ShelleyKey 'RootK XPrv, PassphraseHash)
forall a b. (a -> b) -> a -> b
$ (,)
        (ShelleyKey 'RootK XPrv
 -> PassphraseHash -> (ShelleyKey 'RootK XPrv, PassphraseHash))
-> Either String (ShelleyKey 'RootK XPrv)
-> Either
     String (PassphraseHash -> (ShelleyKey 'RootK XPrv, PassphraseHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPrv -> ShelleyKey 'RootK XPrv)
-> Either String XPrv -> Either String (ShelleyKey 'RootK XPrv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XPrv -> ShelleyKey 'RootK XPrv
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (ByteString -> Either String XPrv
xprvFromText ByteString
k)
        Either
  String (PassphraseHash -> (ShelleyKey 'RootK XPrv, PassphraseHash))
-> Either String PassphraseHash
-> Either String (ShelleyKey 'RootK XPrv, PassphraseHash)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ScrubbedBytes -> PassphraseHash)
-> Either String ScrubbedBytes -> Either String PassphraseHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScrubbedBytes -> PassphraseHash
PassphraseHash (ByteString -> Either String ScrubbedBytes
forall bout. ByteArray bout => ByteString -> Either String bout
fromHex ByteString
h)
      where
        xprvFromText :: ByteString -> Either String XPrv
xprvFromText = ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
xprv (ByteString -> Either String XPrv)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String XPrv
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteArray ByteString => ByteString -> Either String ByteString
forall bout. ByteArray bout => ByteString -> Either String bout
fromHex @ByteString
        err :: p -> a
err p
_ = String -> a
forall a. HasCallStack => String -> a
error String
"unsafeDeserializeXPrv: unable to deserialize ShelleyKey"

instance PersistPublicKey (ShelleyKey depth) where
    serializeXPub :: ShelleyKey depth XPub -> ByteString
serializeXPub =
        ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
hex (ByteString -> ByteString)
-> (ShelleyKey depth XPub -> ByteString)
-> ShelleyKey depth XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
unXPub (XPub -> ByteString)
-> (ShelleyKey depth XPub -> XPub)
-> ShelleyKey depth XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyKey depth XPub -> XPub
forall (depth :: Depth) raw. ShelleyKey depth raw -> raw
getKey

    unsafeDeserializeXPub :: ByteString -> ShelleyKey depth XPub
unsafeDeserializeXPub =
        (String -> ShelleyKey depth XPub)
-> (XPub -> ShelleyKey depth XPub)
-> Either String XPub
-> ShelleyKey depth XPub
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ShelleyKey depth XPub
forall p a. p -> a
err XPub -> ShelleyKey depth XPub
forall (depth :: Depth) key. key -> ShelleyKey depth key
ShelleyKey (Either String XPub -> ShelleyKey depth XPub)
-> (ByteString -> Either String XPub)
-> ByteString
-> ShelleyKey depth XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either String XPub
xpub (ByteString -> Either String XPub)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String XPub
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteArray ByteString => ByteString -> Either String ByteString
forall bout. ByteArray bout => ByteString -> Either String bout
fromHex @ByteString)
      where
        err :: p -> a
err p
_ = String -> a
forall a. HasCallStack => String -> a
error String
"unsafeDeserializeXPub: unable to deserialize ShelleyKey"

{-------------------------------------------------------------------------------
                                 Internals
-------------------------------------------------------------------------------}

hashSize :: Int
hashSize :: Int
hashSize =
    Blake2b_224 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize Blake2b_224
Blake2b_224