{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Module for `DelegationState`.
module Cardano.Wallet.Primitive.Delegation.State
    ( -- * Creation
      DelegationState (..)
    , initialDelegationState

      -- * Operations
    , presentableKeys
    , usableKeys
    , activeKeys

    -- * For Testing
    , keyAtIx
    , lastActiveIx
    , PointerUTxO (..)
    , State (..)
    , Key0Status (..)

      -- * Chain following model
    , Tx (..)
    , Cert (..)
    , applyTx
    , setPortfolioOf
    )
    where

import Prelude

import Cardano.Crypto.Wallet
    ( XPub )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..)
    , DerivationType (..)
    , Index (..)
    , MkKeyFingerprint (paymentKeyFingerprint)
    , Role (..)
    , SoftDerivation (..)
    , ToRewardAccount (..)
    )
import Cardano.Wallet.Primitive.Types.Address
    ( Address )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.RewardAccount
    ( RewardAccount )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxIn (..), TxOut (..) )
import Control.DeepSeq
    ( NFData )
import Data.Maybe
    ( maybeToList )
import GHC.Generics
    ( Generic )
import Quiet
    ( Quiet (..) )

import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TB

--------------------------------------------------------------------------------
-- Delegation State
--------------------------------------------------------------------------------

-- | Delegation state
--
-- === Goals
-- 1. Allow a wallet to have an arbitrary number of stake keys
-- 2. Ensure those stake keys can be automatically discovered on-chain
-- 3. Ensure the wallet is always aware of all stake keys it registers, even in
-- the case of concurrent user actions on multiple wallet instances, and old
-- wallet software.
--
--
-- === How
--
-- We track a consecutive range of keys that is extended with delegation of the
-- next unused key, and shrunk with key de-registration. We use a `PointerUTxO`
-- to ensure that transactions changing the state can't be accepted to the
-- ledger in any other order than intended. We also need some special care
-- regarding stake key 0, which old wallet software could try to de-register.
--
-- === Diagram
-- Diagram of states, where the list denotes active (registered /and/ delegating)
-- keys.
--
-- Here we assume the minUTxOValue is 1 ada.
--
-- Note that intermediate steps for the `PointerUTxO` should be skipped within a
-- transaction.
-- E.g. to transition from [] to [0,1,2] we should deposit 1 ada to key 3,
-- skipping key 2.
--
-- See the implementation of `setPortfolioOf` and `applyTx` for more details.
--
-- @
-- ┌────────────────────┐           ┌────────────────────┐                     ┌────────────────────┐            ┌─────────────────────┐
-- │                    │           │                    │                     │                    │            │                     │
-- │                    │           │                    │       Pointer       │                    │            │                     │
-- │                    │──────────▶│                    │ ──────deposit──────▶│                    │ ─────────▶ │                     │ ─────────▶
-- │                    │           │                    │                     │       [0,1]        │            │       [0,1,2]       │
-- │         []         │           │        [0]         │                     │1 ada held by key 2 │            │ 1 ada held by key 3 │
-- │                    │           │                    │                     │                    │            │                     │
-- │                    │           │                    │       Pointer       │                    │            │                     │
-- │                    │◀──────────│                    │ ◀─────deposit ──────│                    │◀────────── │                     │◀──────────
-- │                    │           │                    │       returned      │                    │            │                     │
-- └────────────────────┘◀──┐       └────────────────────┘                     └────────────────────▲            ▲─────────────────────▲            ▲
--                          └───┐                                                     │       ▲     └─┐         ┌┘      │       ▲      └─┐         ┌┘
-- Normal states                └───┐                                                 │       │       └─┐     ┌─┘       │       │        └─┐     ┌─┘
--                                  └───┐                                             │       │         └─┐ ┌─┘         │       │          └─┐ ┌─┘
-- ╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳└───┐╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳╳│╳╳╳╳╳╳╳│╳╳╳╳╳╳╳╳╳╳╳│ │╳╳╳╳╳╳╳╳╳╳╳│╳╳╳╳╳╳╳│╳╳╳╳╳╳▶     ├─┤
--                                          └───┐                                     │       │         ┌─┘ └─┐         │       │          ┌─┘ └─┐
-- States caused by                             └────┐Pointer                         ▼       │       ┌─┘     └─┐       ▼       │        ┌─┘     └─┐
-- old wallet                                        └deposit                  ┌────────────────────┐─┘         └┬─────────────────────┐─┘         └─
-- de-registering                                     returned─┐               │                    │            │                     │
-- stake-key 0                                                 └────┐          │                    │ ─────────▶ │                     │ ─────────▶
-- of multi-stake                                                   └────┐     │                    │            │                     │
-- key wallet                                                            └──── │        [1]         │            │        [1,2]        │
--                                                                             │1 ada held by key 2 │            │ 1 ada held by key 3 │
--                                                                             │                    │            │                     │
--                                                                             │                    │◀────────── │                     │◀──────────
--                                                                             │                    │            │                     │
--                                                                             │                    │            │                     │
--                                                                             └────────────────────┘            └─────────────────────┘
-- @
data DelegationState k = DelegationState
    { -- | The account public key from which the stake keys should be derived.
      DelegationState k -> k 'AccountK XPub
rewardAccountKey :: k 'AccountK XPub
    , DelegationState k -> State
state :: State
    } deriving ((forall x. DelegationState k -> Rep (DelegationState k) x)
-> (forall x. Rep (DelegationState k) x -> DelegationState k)
-> Generic (DelegationState k)
forall x. Rep (DelegationState k) x -> DelegationState k
forall x. DelegationState k -> Rep (DelegationState k) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (k :: Depth -> * -> *) x.
Rep (DelegationState k) x -> DelegationState k
forall (k :: Depth -> * -> *) x.
DelegationState k -> Rep (DelegationState k) x
$cto :: forall (k :: Depth -> * -> *) x.
Rep (DelegationState k) x -> DelegationState k
$cfrom :: forall (k :: Depth -> * -> *) x.
DelegationState k -> Rep (DelegationState k) x
Generic)

-- | Construct the initial delegation state.
initialDelegationState
    :: k 'AccountK XPub
    -> DelegationState k
initialDelegationState :: k 'AccountK XPub -> DelegationState k
initialDelegationState k 'AccountK XPub
accK = k 'AccountK XPub -> State -> DelegationState k
forall (k :: Depth -> * -> *).
k 'AccountK XPub -> State -> DelegationState k
DelegationState k 'AccountK XPub
accK State
Zero

-- | The internal state, without the account key.
--
-- TODO: Perhaps we should model this as
-- @S = S1 * S2, where S1 = Bool, S2 = ix * UTxOPointer@ - having two
-- "concurrent" states tracking stake keys, where the first one is identical to
-- legacy single-stake key wallets.
--
-- Maybe that would help simplify `applyTx` and `setPortfolioOf`...
data State
    -- | No active stake keys. The initial state of a new wallet.
    = Zero

    -- | The first stake-key (index 0) is registered and either delegating or
    -- about to be delegating.
    | One

    -- | There is more than one active stake keys. Can only be reached using
    -- wallets with support for multiple stake keys.
    | More
        !(Index 'Soft 'AddressK)
          -- nextKeyIx - the ix of the next unused key
        PointerUTxO
          -- ^ pointer utxo that need to be spent when changing state.
        !Key0Status
    deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show, (forall x. State -> Rep State x)
-> (forall x. Rep State x -> State) -> Generic State
forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic)

instance NFData State

-- | Is key 0 still registered? For compatibility with
-- single-stake-key wallets, we need to track this.
--
-- >>> activeKeys (More (toEnum 3) p ValidKey0)
-- [0, 1, 2]
--
-- >>> activeKeys (More (toEnum 3) p MissingKey0)
-- [1, 2]
--
-- (pseudocode; requires a bit more boilerplate to compile)
--
-- See the implementation of @applyTx@ for how it is used.
data Key0Status = ValidKey0 | MissingKey0
    deriving (Key0Status -> Key0Status -> Bool
(Key0Status -> Key0Status -> Bool)
-> (Key0Status -> Key0Status -> Bool) -> Eq Key0Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key0Status -> Key0Status -> Bool
$c/= :: Key0Status -> Key0Status -> Bool
== :: Key0Status -> Key0Status -> Bool
$c== :: Key0Status -> Key0Status -> Bool
Eq, Int -> Key0Status -> ShowS
[Key0Status] -> ShowS
Key0Status -> String
(Int -> Key0Status -> ShowS)
-> (Key0Status -> String)
-> ([Key0Status] -> ShowS)
-> Show Key0Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key0Status] -> ShowS
$cshowList :: [Key0Status] -> ShowS
show :: Key0Status -> String
$cshow :: Key0Status -> String
showsPrec :: Int -> Key0Status -> ShowS
$cshowsPrec :: Int -> Key0Status -> ShowS
Show, (forall x. Key0Status -> Rep Key0Status x)
-> (forall x. Rep Key0Status x -> Key0Status) -> Generic Key0Status
forall x. Rep Key0Status x -> Key0Status
forall x. Key0Status -> Rep Key0Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key0Status x -> Key0Status
$cfrom :: forall x. Key0Status -> Rep Key0Status x
Generic)

instance NFData Key0Status

instance (NFData (k 'AccountK XPub), NFData (k 'AddressK XPub))
    => NFData (DelegationState k)

deriving instance
    ( Show (k 'AccountK XPub)
    , Show (k 'AddressK XPub)
    ) => Show (DelegationState k)

deriving instance
    ( Eq (k 'AccountK XPub)
    , Eq (k 'AddressK XPub)
    ) => Eq (DelegationState k)

keyAtIx
    :: (SoftDerivation k)
    => DelegationState k
    -> Index 'Soft 'AddressK
    -> k 'AddressK XPub
keyAtIx :: DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
s = k 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (key :: Depth -> * -> *).
SoftDerivation key =>
key 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> key 'AddressK XPub
deriveAddressPublicKey (DelegationState k -> k 'AccountK XPub
forall (k :: Depth -> * -> *).
DelegationState k -> k 'AccountK XPub
rewardAccountKey DelegationState k
s) Role
MutableAccount

nextKeyIx
    :: DelegationState k
    -> Index 'Soft 'AddressK
nextKeyIx :: DelegationState k -> Index 'Soft 'AddressK
nextKeyIx DelegationState k
s = case DelegationState k -> State
forall (k :: Depth -> * -> *). DelegationState k -> State
state DelegationState k
s of
    State
Zero -> Index 'Soft 'AddressK
forall a. Bounded a => a
minBound
    State
One -> Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
succ Index 'Soft 'AddressK
forall a. Bounded a => a
minBound
    More Index 'Soft 'AddressK
ix PointerUTxO
_ Key0Status
_ -> Index 'Soft 'AddressK
ix

lastActiveIx
    :: DelegationState k
    -> Maybe (Index 'Soft 'AddressK)
lastActiveIx :: DelegationState k -> Maybe (Index 'Soft 'AddressK)
lastActiveIx DelegationState k
s
    | DelegationState k -> Index 'Soft 'AddressK
forall (k :: Depth -> * -> *).
DelegationState k -> Index 'Soft 'AddressK
nextKeyIx DelegationState k
s Index 'Soft 'AddressK -> Index 'Soft 'AddressK -> Bool
forall a. Eq a => a -> a -> Bool
== Index 'Soft 'AddressK
forall a. Bounded a => a
minBound = Maybe (Index 'Soft 'AddressK)
forall a. Maybe a
Nothing
    | Bool
otherwise               = Index 'Soft 'AddressK -> Maybe (Index 'Soft 'AddressK)
forall a. a -> Maybe a
Just (Index 'Soft 'AddressK -> Maybe (Index 'Soft 'AddressK))
-> Index 'Soft 'AddressK -> Maybe (Index 'Soft 'AddressK)
forall a b. (a -> b) -> a -> b
$ Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
pred (Index 'Soft 'AddressK -> Index 'Soft 'AddressK)
-> Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a b. (a -> b) -> a -> b
$ DelegationState k -> Index 'Soft 'AddressK
forall (k :: Depth -> * -> *).
DelegationState k -> Index 'Soft 'AddressK
nextKeyIx DelegationState k
s

data PointerUTxO = PointerUTxO { PointerUTxO -> TxIn
pTxIn :: TxIn, PointerUTxO -> Coin
pCoin :: Coin }
    deriving ((forall x. PointerUTxO -> Rep PointerUTxO x)
-> (forall x. Rep PointerUTxO x -> PointerUTxO)
-> Generic PointerUTxO
forall x. Rep PointerUTxO x -> PointerUTxO
forall x. PointerUTxO -> Rep PointerUTxO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PointerUTxO x -> PointerUTxO
$cfrom :: forall x. PointerUTxO -> Rep PointerUTxO x
Generic, PointerUTxO -> PointerUTxO -> Bool
(PointerUTxO -> PointerUTxO -> Bool)
-> (PointerUTxO -> PointerUTxO -> Bool) -> Eq PointerUTxO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointerUTxO -> PointerUTxO -> Bool
$c/= :: PointerUTxO -> PointerUTxO -> Bool
== :: PointerUTxO -> PointerUTxO -> Bool
$c== :: PointerUTxO -> PointerUTxO -> Bool
Eq, Int -> PointerUTxO -> ShowS
[PointerUTxO] -> ShowS
PointerUTxO -> String
(Int -> PointerUTxO -> ShowS)
-> (PointerUTxO -> String)
-> ([PointerUTxO] -> ShowS)
-> Show PointerUTxO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointerUTxO] -> ShowS
$cshowList :: [PointerUTxO] -> ShowS
show :: PointerUTxO -> String
$cshow :: PointerUTxO -> String
showsPrec :: Int -> PointerUTxO -> ShowS
$cshowsPrec :: Int -> PointerUTxO -> ShowS
Show)
    deriving anyclass PointerUTxO -> ()
(PointerUTxO -> ()) -> NFData PointerUTxO
forall a. (a -> ()) -> NFData a
rnf :: PointerUTxO -> ()
$crnf :: PointerUTxO -> ()
NFData

-- | Returns the index corresponding to the payment key the `PointerUTxO`
-- should be locked with for a portfolio of a given size @n@.
--
-- In our current implementation we require the `PointerUTxO` to be created in
-- the @[0] -> [0,1] transition@, i.e. @nextKeyIx 1 -> nextKeyIx 2@.
pointerIx
    :: Int
    -> Maybe (Index 'Soft 'AddressK)
pointerIx :: Int -> Maybe (Index 'Soft 'AddressK)
pointerIx Int
0 = Maybe (Index 'Soft 'AddressK)
forall a. Maybe a
Nothing
pointerIx Int
1 = Maybe (Index 'Soft 'AddressK)
forall a. Maybe a
Nothing
pointerIx Int
n = Index 'Soft 'AddressK -> Maybe (Index 'Soft 'AddressK)
forall a. a -> Maybe a
Just (Index 'Soft 'AddressK -> Maybe (Index 'Soft 'AddressK))
-> Index 'Soft 'AddressK -> Maybe (Index 'Soft 'AddressK)
forall a b. (a -> b) -> a -> b
$ Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum Int
n

-- | Retrieve the `PointerUTxO` from a `DelegationState` if it has one.
pointer :: DelegationState k -> Maybe PointerUTxO
pointer :: DelegationState k -> Maybe PointerUTxO
pointer (DelegationState k 'AccountK XPub
_ (More Index 'Soft 'AddressK
_ PointerUTxO
p Key0Status
_)) = PointerUTxO -> Maybe PointerUTxO
forall a. a -> Maybe a
Just PointerUTxO
p
pointer DelegationState k
_ = Maybe PointerUTxO
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- Chain
--------------------------------------------------------------------------------

-- | A transaction type specific to `DelegationState`.
--
-- Intended to be converted both from and to a more real transaction type.
--
-- When constructing a real transaction from `Tx`, these `outputs`
-- should appear before other outputs. In the theoretical event that there's
-- also a user-specified output with the same payment key as the pointer output,
-- `applyTx` will track the first one as the new pointer.
data Tx = Tx
    { Tx -> [Cert]
certs :: [Cert]
    , Tx -> [(TxIn, Coin)]
inputs :: [(TxIn, Coin)]
    , Tx -> [TxOut]
outputs :: [TxOut]
    }
    deriving (Tx -> Tx -> Bool
(Tx -> Tx -> Bool) -> (Tx -> Tx -> Bool) -> Eq Tx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tx -> Tx -> Bool
$c/= :: Tx -> Tx -> Bool
== :: Tx -> Tx -> Bool
$c== :: Tx -> Tx -> Bool
Eq, (forall x. Tx -> Rep Tx x)
-> (forall x. Rep Tx x -> Tx) -> Generic Tx
forall x. Rep Tx x -> Tx
forall x. Tx -> Rep Tx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tx x -> Tx
$cfrom :: forall x. Tx -> Rep Tx x
Generic)
    deriving Int -> Tx -> ShowS
[Tx] -> ShowS
Tx -> String
(Int -> Tx -> ShowS)
-> (Tx -> String) -> ([Tx] -> ShowS) -> Show Tx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tx] -> ShowS
$cshowList :: [Tx] -> ShowS
show :: Tx -> String
$cshow :: Tx -> String
showsPrec :: Int -> Tx -> ShowS
$cshowsPrec :: Int -> Tx -> ShowS
Show via (Quiet Tx)

instance Semigroup Tx where
    (Tx [Cert]
cs1 [(TxIn, Coin)]
is1 [TxOut]
os1) <> :: Tx -> Tx -> Tx
<> (Tx [Cert]
cs2 [(TxIn, Coin)]
is2 [TxOut]
os2) =
        [Cert] -> [(TxIn, Coin)] -> [TxOut] -> Tx
Tx ([Cert]
cs1 [Cert] -> [Cert] -> [Cert]
forall a. Semigroup a => a -> a -> a
<> [Cert]
cs2) ([(TxIn, Coin)]
is1 [(TxIn, Coin)] -> [(TxIn, Coin)] -> [(TxIn, Coin)]
forall a. Semigroup a => a -> a -> a
<> [(TxIn, Coin)]
is2) ([TxOut]
os1 [TxOut] -> [TxOut] -> [TxOut]
forall a. Semigroup a => a -> a -> a
<> [TxOut]
os2)

data Cert
    = RegisterKey RewardAccount
    | Delegate RewardAccount
      -- ^ Which pool we're delegating to is here (and for now) irrelevant.
      -- The main thing is that there exists a witness on-chain for this stake
      -- key (registration certs don't require witnesses)
      --
      -- TODO: We may also want to add the PoolId here.
    | DeRegisterKey RewardAccount
    deriving (Cert -> Cert -> Bool
(Cert -> Cert -> Bool) -> (Cert -> Cert -> Bool) -> Eq Cert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cert -> Cert -> Bool
$c/= :: Cert -> Cert -> Bool
== :: Cert -> Cert -> Bool
$c== :: Cert -> Cert -> Bool
Eq, Int -> Cert -> ShowS
[Cert] -> ShowS
Cert -> String
(Int -> Cert -> ShowS)
-> (Cert -> String) -> ([Cert] -> ShowS) -> Show Cert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cert] -> ShowS
$cshowList :: [Cert] -> ShowS
show :: Cert -> String
$cshow :: Cert -> String
showsPrec :: Int -> Cert -> ShowS
$cshowsPrec :: Int -> Cert -> ShowS
Show, (forall x. Cert -> Rep Cert x)
-> (forall x. Rep Cert x -> Cert) -> Generic Cert
forall x. Rep Cert x -> Cert
forall x. Cert -> Rep Cert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cert x -> Cert
$cfrom :: forall x. Cert -> Rep Cert x
Generic)

-- | Given a `DelegationState`, produce a `Tx` registering or de-registering
-- stake-keys, in order to have @n@ stake-keys.
--
-- E.g. @setPortfolioOf s0 _ _ 2@ creates a tx which after application causes
-- the state to have @activeKeys == [0,1]@
--
-- Returns @Nothing@ if the target @n@ is already reached.
setPortfolioOf
    :: (SoftDerivation k, ToRewardAccount k)
    => DelegationState k
    -> Coin
        -- ^ minUTxOVal
    -> (k 'AddressK XPub -> Address)
        -- ^ A way to construct an Address
    -> (RewardAccount -> Bool)
        -- ^ Whether or not the key is registered.
        --
        -- TODO: Need a Set or Map for the real implementation with LSQ.
    -> Int
        -- ^ Target number of stake keys.
    -> Maybe Tx
setPortfolioOf :: DelegationState k
-> Coin
-> (k 'AddressK XPub -> Address)
-> (RewardAccount -> Bool)
-> Int
-> Maybe Tx
setPortfolioOf DelegationState k
ds Coin
minUTxOVal k 'AddressK XPub -> Address
mkAddress RewardAccount -> Bool
isReg Int
n =
    Maybe Tx
repairKey0IfNeededTx Maybe Tx -> Maybe Tx -> Maybe Tx
forall a. Semigroup a => a -> a -> a
<> Maybe Tx
changeStateTx
  where
    -- The `changeStateTx` calculation assumes that key 0 is registered. If it
    -- is not, we fix it here.
    --
    -- At some point we will need to take a `Set PoolId` instead of `n`. If
    -- we're in the state of key 1 and 2 delegating to pools B and C
    -- respectively, we likely want:
    -- - `setPortfolio [A,B,C]` to delegate key 0 to A, instead of key 3.
    -- - `setPortfolio [B,C]` to replace key 2 with key 0
    repairKey0IfNeededTx :: Maybe Tx
    repairKey0IfNeededTx :: Maybe Tx
repairKey0IfNeededTx = case State -> [Cert]
repairKey0 (State -> [Cert]) -> State -> [Cert]
forall a b. (a -> b) -> a -> b
$ DelegationState k -> State
forall (k :: Depth -> * -> *). DelegationState k -> State
state DelegationState k
ds of
        [] -> Maybe Tx
forall a. Maybe a
Nothing
        [Cert]
cs -> Tx -> Maybe Tx
forall a. a -> Maybe a
Just (Tx -> Maybe Tx) -> Tx -> Maybe Tx
forall a b. (a -> b) -> a -> b
$ [Cert] -> [(TxIn, Coin)] -> [TxOut] -> Tx
Tx [Cert]
cs [] []
      where
        repairKey0 :: State -> [Cert]
repairKey0 (More Index 'Soft 'AddressK
_ PointerUTxO
_ Key0Status
MissingKey0) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = [Index 'Soft 'AddressK] -> [Cert]
deleg [Index 'Soft 'AddressK
forall a. Bounded a => a
minBound]
        repairKey0 State
_ = []

    changeStateTx :: Maybe Tx
    changeStateTx :: Maybe Tx
changeStateTx = [Cert] -> Maybe Tx
txWithCerts ([Cert] -> Maybe Tx) -> [Cert] -> Maybe Tx
forall a b. (a -> b) -> a -> b
$ case Index 'Soft 'AddressK -> Index 'Soft 'AddressK -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum Int
n) (DelegationState k -> Index 'Soft 'AddressK
forall (k :: Depth -> * -> *).
DelegationState k -> Index 'Soft 'AddressK
nextKeyIx DelegationState k
ds) of
        Ordering
GT -> [Index 'Soft 'AddressK] -> [Cert]
deleg [DelegationState k -> Index 'Soft 'AddressK
forall (k :: Depth -> * -> *).
DelegationState k -> Index 'Soft 'AddressK
nextKeyIx DelegationState k
ds .. Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
        Ordering
EQ -> []
        Ordering
LT -> [Index 'Soft 'AddressK] -> [Cert]
dereg ([Index 'Soft 'AddressK] -> [Cert])
-> [Index 'Soft 'AddressK] -> [Cert]
forall a b. (a -> b) -> a -> b
$ [Index 'Soft 'AddressK] -> [Index 'Soft 'AddressK]
forall a. [a] -> [a]
reverse [Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum Int
n .. (Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
pred (Index 'Soft 'AddressK -> Index 'Soft 'AddressK)
-> Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a b. (a -> b) -> a -> b
$ DelegationState k -> Index 'Soft 'AddressK
forall (k :: Depth -> * -> *).
DelegationState k -> Index 'Soft 'AddressK
nextKeyIx DelegationState k
ds)]

      where
        txWithCerts :: [Cert] -> Maybe Tx
txWithCerts [] = Maybe Tx
forall a. Maybe a
Nothing
        txWithCerts [Cert]
cs = Tx -> Maybe Tx
forall a. a -> Maybe a
Just (Tx -> Maybe Tx) -> Tx -> Maybe Tx
forall a b. (a -> b) -> a -> b
$ Tx :: [Cert] -> [(TxIn, Coin)] -> [TxOut] -> Tx
Tx
            { certs :: [Cert]
certs = [Cert]
cs
            , inputs :: [(TxIn, Coin)]
inputs = Maybe (TxIn, Coin) -> [(TxIn, Coin)]
forall a. Maybe a -> [a]
maybeToList (PointerUTxO -> (TxIn, Coin)
mkTxIn (PointerUTxO -> (TxIn, Coin))
-> Maybe PointerUTxO -> Maybe (TxIn, Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelegationState k -> Maybe PointerUTxO
forall (k :: Depth -> * -> *).
DelegationState k -> Maybe PointerUTxO
pointer DelegationState k
ds)
            , outputs :: [TxOut]
outputs = Maybe TxOut -> [TxOut]
forall a. Maybe a -> [a]
maybeToList (Maybe TxOut -> [TxOut]) -> Maybe TxOut -> [TxOut]
forall a b. (a -> b) -> a -> b
$
                -- Note that this is the only place where we move the pointer.
                -- I.e. repairKey0IfNeededTx won't do it on its own.
                (\Index 'Soft 'AddressK
i -> Address -> TokenBundle -> TxOut
TxOut
                    (k 'AddressK XPub -> Address
mkAddress (k 'AddressK XPub -> Address) -> k 'AddressK XPub -> Address
forall a b. (a -> b) -> a -> b
$ DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
ds Index 'Soft 'AddressK
i)
                    (Coin -> TokenBundle
TB.fromCoin Coin
minUTxOVal)
                ) (Index 'Soft 'AddressK -> TxOut)
-> Maybe (Index 'Soft 'AddressK) -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe (Index 'Soft 'AddressK)
pointerIx Int
n
            }
          where
            mkTxIn :: PointerUTxO -> (TxIn, Coin)
mkTxIn (PointerUTxO TxIn
txIx Coin
coin) = (TxIn
txIx, Coin
coin)
            -- Note: If c > minUTxOVal we need to rely on the wallet to return the
            -- difference to the user as change.

    deleg :: [Index 'Soft 'AddressK] -> [Cert]
    deleg :: [Index 'Soft 'AddressK] -> [Cert]
deleg = ([Index 'Soft 'AddressK]
-> (Index 'Soft 'AddressK -> [Cert]) -> [Cert]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Index 'Soft 'AddressK
ix ->
        if RewardAccount -> Bool
isReg (Index 'Soft 'AddressK -> RewardAccount
acct Index 'Soft 'AddressK
ix)
        then [RewardAccount -> Cert
Delegate (Index 'Soft 'AddressK -> RewardAccount
acct Index 'Soft 'AddressK
ix)]
        else [RewardAccount -> Cert
RegisterKey (Index 'Soft 'AddressK -> RewardAccount
acct Index 'Soft 'AddressK
ix),  RewardAccount -> Cert
Delegate (Index 'Soft 'AddressK -> RewardAccount
acct Index 'Soft 'AddressK
ix)]
        )


    dereg :: [Index 'Soft 'AddressK] -> [Cert]
    dereg :: [Index 'Soft 'AddressK] -> [Cert]
dereg [Index 'Soft 'AddressK]
ixs =
        [ RewardAccount -> Cert
DeRegisterKey (Index 'Soft 'AddressK -> RewardAccount
acct Index 'Soft 'AddressK
ix)
        | Index 'Soft 'AddressK
ix <- [Index 'Soft 'AddressK]
ixs
        , RewardAccount -> Bool
isReg (RewardAccount -> Bool)
-> (Index 'Soft 'AddressK -> RewardAccount)
-> Index 'Soft 'AddressK
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index 'Soft 'AddressK -> RewardAccount
acct (Index 'Soft 'AddressK -> Bool) -> Index 'Soft 'AddressK -> Bool
forall a b. (a -> b) -> a -> b
$ Index 'Soft 'AddressK
ix
        -- We need to /at least/ check @isReg (key 0)@, because the user could
        -- have deregistered it using old wallet software.
        ]

    acct :: Index 'Soft 'AddressK -> RewardAccount
acct = k 'AddressK XPub -> RewardAccount
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
k 'AddressK XPub -> RewardAccount
toRewardAccount (k 'AddressK XPub -> RewardAccount)
-> (Index 'Soft 'AddressK -> k 'AddressK XPub)
-> Index 'Soft 'AddressK
-> RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
ds

-- | Apply a `Tx` to a `DelegationState`.
--
-- Expects the @PointerUTxO@ to be correctly managed, and will panic otherwise.
applyTx
    :: forall k. ( SoftDerivation k
        , ToRewardAccount k
        , MkKeyFingerprint k Address
        , MkKeyFingerprint k (k 'AddressK XPub))
    => Tx
    -> Hash "Tx"
    -> DelegationState k
    -> DelegationState k
applyTx :: Tx -> Hash "Tx" -> DelegationState k -> DelegationState k
applyTx (Tx [Cert]
cs [(TxIn, Coin)]
_ins [TxOut]
outs) Hash "Tx"
h DelegationState k
ds0 = (DelegationState k -> Cert -> DelegationState k)
-> DelegationState k -> [Cert] -> DelegationState k
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DelegationState k -> Cert -> DelegationState k
applyCert DelegationState k
ds0 [Cert]
cs
  where
    applyCert :: DelegationState k -> Cert -> DelegationState k
applyCert DelegationState k
ds Cert
cert = ((State -> State) -> DelegationState k -> DelegationState k)
-> DelegationState k -> (State -> State) -> DelegationState k
forall a b c. (a -> b -> c) -> b -> a -> c
flip (State -> State) -> DelegationState k -> DelegationState k
modifyState DelegationState k
ds ((State -> State) -> DelegationState k)
-> (State -> State) -> DelegationState k
forall a b. (a -> b) -> a -> b
$ case Cert
cert of
            RegisterKey RewardAccount
_                   -> State -> State
forall a. a -> a
id
            Delegate RewardAccount
k
               | RewardAccount
k RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== DelegationState k -> RewardAccount
forall (k :: Depth -> * -> *).
(ToRewardAccount k, SoftDerivation k) =>
DelegationState k -> RewardAccount
nextKey DelegationState k
ds            -> State -> State
inc
               | Bool
otherwise                  -> Cert -> State -> State
modifyKey0 Cert
cert
            DeRegisterKey RewardAccount
k
               | RewardAccount -> Maybe RewardAccount
forall a. a -> Maybe a
Just RewardAccount
k Maybe RewardAccount -> Maybe RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== DelegationState k -> Maybe RewardAccount
forall (k :: Depth -> * -> *).
(ToRewardAccount k, SoftDerivation k) =>
DelegationState k -> Maybe RewardAccount
lastActiveKey DelegationState k
ds -> State -> State
dec
               | Bool
otherwise                  -> Cert -> State -> State
modifyKey0 Cert
cert
      where
        inc :: State -> State
inc State
s = case State
s of
            State
Zero -> State
One
            State
One -> Index 'Soft 'AddressK -> PointerUTxO -> Key0Status -> State
More (Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum Int
2) (Index 'Soft 'AddressK -> PointerUTxO
findOut (Index 'Soft 'AddressK -> PointerUTxO)
-> Index 'Soft 'AddressK -> PointerUTxO
forall a b. (a -> b) -> a -> b
$ Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum Int
2) Key0Status
ValidKey0
            More Index 'Soft 'AddressK
ix PointerUTxO
_ Key0Status
is0Reg -> let ix' :: Index 'Soft 'AddressK
ix' = Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
succ Index 'Soft 'AddressK
ix in Index 'Soft 'AddressK -> PointerUTxO -> Key0Status -> State
More Index 'Soft 'AddressK
ix' (Index 'Soft 'AddressK -> PointerUTxO
findOut Index 'Soft 'AddressK
ix') Key0Status
is0Reg
        dec :: State -> State
dec State
s = case State
s of
            State
Zero -> String -> State
forall a. HasCallStack => String -> a
error String
"impossible: can't decrement beyond zero"
            State
One -> State
Zero
            More Index 'Soft 'AddressK
ix PointerUTxO
_ Key0Status
is0Reg
                | Index 'Soft 'AddressK -> Int
forall a. Enum a => a -> Int
fromEnum Index 'Soft 'AddressK
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 -> let ix' :: Index 'Soft 'AddressK
ix' = Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
pred Index 'Soft 'AddressK
ix in Index 'Soft 'AddressK -> PointerUTxO -> Key0Status -> State
More Index 'Soft 'AddressK
ix' (Index 'Soft 'AddressK -> PointerUTxO
findOut Index 'Soft 'AddressK
ix') Key0Status
is0Reg
                | Bool
otherwise -> case Key0Status
is0Reg of
                    Key0Status
ValidKey0   -> State
One
                    Key0Status
MissingKey0 -> State
Zero

        findOut :: Index 'Soft 'AddressK -> PointerUTxO
findOut Index 'Soft 'AddressK
ix = case ((Word32, TxOut) -> PointerUTxO)
-> [(Word32, TxOut)] -> [PointerUTxO]
forall a b. (a -> b) -> [a] -> [b]
map (Word32, TxOut) -> PointerUTxO
mkPointer [(Word32, TxOut)]
pointerOuts of
            (PointerUTxO
x:[PointerUTxO]
_) -> PointerUTxO
x
            [PointerUTxO]
_     -> String -> PointerUTxO
forall a. HasCallStack => String -> a
error (String -> PointerUTxO) -> String -> PointerUTxO
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"couldn't find pointer output for ix "
                , Index 'Soft 'AddressK -> String
forall a. Show a => a -> String
show Index 'Soft 'AddressK
ix
                , String
" with state "
                , State -> String
forall a. Show a => a -> String
show (State -> String) -> State -> String
forall a b. (a -> b) -> a -> b
$ DelegationState k -> State
forall (k :: Depth -> * -> *). DelegationState k -> State
state DelegationState k
ds
                ]
          where
            isOurOut :: TxOut -> Bool
isOurOut (TxOut Address
addr TokenBundle
_b) =
                case (forall from.
MkKeyFingerprint k from =>
from
-> Either (ErrMkKeyFingerprint k from) (KeyFingerprint "payment" k)
forall (key :: Depth -> * -> *) from.
MkKeyFingerprint key from =>
from
-> Either
     (ErrMkKeyFingerprint key from) (KeyFingerprint "payment" key)
paymentKeyFingerprint @k (k 'AddressK XPub
 -> Either
      (ErrMkKeyFingerprint k (k 'AddressK XPub))
      (KeyFingerprint "payment" k))
-> k 'AddressK XPub
-> Either
     (ErrMkKeyFingerprint k (k 'AddressK XPub))
     (KeyFingerprint "payment" k)
forall a b. (a -> b) -> a -> b
$ DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
ds Index 'Soft 'AddressK
ix, Address
-> Either
     (ErrMkKeyFingerprint k Address) (KeyFingerprint "payment" k)
forall (key :: Depth -> * -> *) from.
MkKeyFingerprint key from =>
from
-> Either
     (ErrMkKeyFingerprint key from) (KeyFingerprint "payment" key)
paymentKeyFingerprint Address
addr) of
                (Right KeyFingerprint "payment" k
fp, Right KeyFingerprint "payment" k
fp')
                    | KeyFingerprint "payment" k
fp KeyFingerprint "payment" k -> KeyFingerprint "payment" k -> Bool
forall a. Eq a => a -> a -> Bool
== KeyFingerprint "payment" k
fp' -> Bool
True
                    | Bool
otherwise -> Bool
False
                (Either
   (ErrMkKeyFingerprint k (k 'AddressK XPub))
   (KeyFingerprint "payment" k),
 Either
   (ErrMkKeyFingerprint k Address) (KeyFingerprint "payment" k))
_ -> Bool
False
            mkPointer :: (Word32, TxOut) -> PointerUTxO
mkPointer (Word32
txIx, TxOut Address
_ TokenBundle
tb) = TxIn -> Coin -> PointerUTxO
PointerUTxO (Hash "Tx" -> Word32 -> TxIn
TxIn Hash "Tx"
h Word32
txIx) (TokenBundle -> Coin
TB.getCoin TokenBundle
tb)
            pointerOuts :: [(Word32, TxOut)]
pointerOuts = ((Word32, TxOut) -> Bool) -> [(Word32, TxOut)] -> [(Word32, TxOut)]
forall a. (a -> Bool) -> [a] -> [a]
filter (TxOut -> Bool
isOurOut (TxOut -> Bool)
-> ((Word32, TxOut) -> TxOut) -> (Word32, TxOut) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) ([(Word32, TxOut)] -> [(Word32, TxOut)])
-> [(Word32, TxOut)] -> [(Word32, TxOut)]
forall a b. (a -> b) -> a -> b
$ [Word32] -> [TxOut] -> [(Word32, TxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0..] [TxOut]
outs

    modifyState
        :: (State -> State)
        -> DelegationState k
        -> DelegationState k
    modifyState :: (State -> State) -> DelegationState k -> DelegationState k
modifyState State -> State
f DelegationState k
s = DelegationState k
s { state :: State
state = State -> State
f (DelegationState k -> State
forall (k :: Depth -> * -> *). DelegationState k -> State
state DelegationState k
s) }

    -- | Modifies the "isKey0Reg" of the `More` constructor.
    modifyKey0 :: Cert -> State -> State
modifyKey0 Cert
cert s :: State
s@(More Index 'Soft 'AddressK
i PointerUTxO
p Key0Status
_) = case Cert
cert of
        Delegate RewardAccount
k
            | RewardAccount
k RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> RewardAccount
acct Int
0 -> Index 'Soft 'AddressK -> PointerUTxO -> Key0Status -> State
More Index 'Soft 'AddressK
i PointerUTxO
p Key0Status
ValidKey0
            | Bool
otherwise   -> State
s
        DeRegisterKey RewardAccount
k
            | RewardAccount
k RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> RewardAccount
acct Int
0 -> Index 'Soft 'AddressK -> PointerUTxO -> Key0Status -> State
More Index 'Soft 'AddressK
i PointerUTxO
p Key0Status
MissingKey0
            | Bool
otherwise   -> State
s
        Cert
_                 -> State
s
      where
        acct :: Int -> RewardAccount
acct = k 'AddressK XPub -> RewardAccount
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
k 'AddressK XPub -> RewardAccount
toRewardAccount (k 'AddressK XPub -> RewardAccount)
-> (Int -> k 'AddressK XPub) -> Int -> RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
ds0 (Index 'Soft 'AddressK -> k 'AddressK XPub)
-> (Int -> Index 'Soft 'AddressK) -> Int -> k 'AddressK XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum
    modifyKey0 Cert
_ State
s = State
s

    lastActiveKey :: DelegationState k -> Maybe RewardAccount
lastActiveKey DelegationState k
ds' = k 'AddressK XPub -> RewardAccount
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
k 'AddressK XPub -> RewardAccount
toRewardAccount (k 'AddressK XPub -> RewardAccount)
-> (Index 'Soft 'AddressK -> k 'AddressK XPub)
-> Index 'Soft 'AddressK
-> RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
ds' (Index 'Soft 'AddressK -> RewardAccount)
-> Maybe (Index 'Soft 'AddressK) -> Maybe RewardAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelegationState k -> Maybe (Index 'Soft 'AddressK)
forall (k :: Depth -> * -> *).
DelegationState k -> Maybe (Index 'Soft 'AddressK)
lastActiveIx DelegationState k
ds'
    nextKey :: DelegationState k -> RewardAccount
nextKey DelegationState k
ds' = k 'AddressK XPub -> RewardAccount
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
k 'AddressK XPub -> RewardAccount
toRewardAccount (k 'AddressK XPub -> RewardAccount)
-> (Index 'Soft 'AddressK -> k 'AddressK XPub)
-> Index 'Soft 'AddressK
-> RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
ds' (Index 'Soft 'AddressK -> RewardAccount)
-> Index 'Soft 'AddressK -> RewardAccount
forall a b. (a -> b) -> a -> b
$ DelegationState k -> Index 'Soft 'AddressK
forall (k :: Depth -> * -> *).
DelegationState k -> Index 'Soft 'AddressK
nextKeyIx DelegationState k
ds'

--------------------------------------------------------------------------------
-- Operations
--------------------------------------------------------------------------------

-- | All stake keys worth listing to the user.
--
-- May include:
-- 1. Active stake keys
-- 2. The next un-active key
--
-- NOTE: In theory we might want also present stake keys that are unexpectedly
-- registered, as they could be de-registered to reclaim the deposit, but this
-- should in-practice never happen.
--
-- If @sn@ denotes the state with @n@ registered and delegating keys:
-- >>> presentableKeys s0
-- [0]
-- >>> presentableKeys s1
-- [0, 1]
-- >>> presentableKeys s2
-- [0, 1, 2]
presentableKeys :: SoftDerivation k => DelegationState k -> [k 'AddressK XPub]
presentableKeys :: DelegationState k -> [k 'AddressK XPub]
presentableKeys DelegationState k
s = case DelegationState k -> Maybe (Index 'Soft 'AddressK)
forall (k :: Depth -> * -> *).
DelegationState k -> Maybe (Index 'Soft 'AddressK)
lastActiveIx DelegationState k
s of
    Just Index 'Soft 'AddressK
i -> (Index 'Soft 'AddressK -> k 'AddressK XPub)
-> [Index 'Soft 'AddressK] -> [k 'AddressK XPub]
forall a b. (a -> b) -> [a] -> [b]
map (DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
s) [Index 'Soft 'AddressK
forall a. Bounded a => a
minBound .. (Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
succ Index 'Soft 'AddressK
i)]
    Maybe (Index 'Soft 'AddressK)
Nothing -> [DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
s Index 'Soft 'AddressK
forall a. Bounded a => a
minBound]

-- Keys meant to be used in addresses.
--
-- If @sn@ denotes the state with @n@ registered and delegating keys:
-- >>> usableKeys s0
-- [0]
-- >>> usableKeys s1
-- [0]
-- >>> usableKeys s2
-- [0, 1]
--
-- Note that for @s0@, we have no active stake keys, but we still want to use
-- key 0 as part of addresses.
--
-- Also note that old wallet software may unregister the first stake key 0
-- despite stake key 1 being active. This doesn't affect `usableKeys`
-- (it still includes key 0), as we view the state as incorrect and temporary.
usableKeys :: SoftDerivation k => DelegationState k -> [k 'AddressK XPub]
usableKeys :: DelegationState k -> [k 'AddressK XPub]
usableKeys DelegationState k
s = case DelegationState k -> Maybe (Index 'Soft 'AddressK)
forall (k :: Depth -> * -> *).
DelegationState k -> Maybe (Index 'Soft 'AddressK)
lastActiveIx DelegationState k
s of
    Just Index 'Soft 'AddressK
i -> (Index 'Soft 'AddressK -> k 'AddressK XPub)
-> [Index 'Soft 'AddressK] -> [k 'AddressK XPub]
forall a b. (a -> b) -> [a] -> [b]
map (DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
s) [Index 'Soft 'AddressK
forall a. Bounded a => a
minBound .. Index 'Soft 'AddressK
i]
    Maybe (Index 'Soft 'AddressK)
Nothing -> [DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
s Index 'Soft 'AddressK
forall a. Bounded a => a
minBound]

-- | For testing. Returns all registered and delegating stake keys.
activeKeys :: SoftDerivation k => DelegationState k -> [k 'AddressK XPub]
activeKeys :: DelegationState k -> [k 'AddressK XPub]
activeKeys DelegationState k
ds = (Index 'Soft 'AddressK -> k 'AddressK XPub)
-> [Index 'Soft 'AddressK] -> [k 'AddressK XPub]
forall a b. (a -> b) -> [a] -> [b]
map (DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
forall (k :: Depth -> * -> *).
SoftDerivation k =>
DelegationState k -> Index 'Soft 'AddressK -> k 'AddressK XPub
keyAtIx DelegationState k
ds) ([Index 'Soft 'AddressK] -> [k 'AddressK XPub])
-> [Index 'Soft 'AddressK] -> [k 'AddressK XPub]
forall a b. (a -> b) -> a -> b
$ case DelegationState k -> State
forall (k :: Depth -> * -> *). DelegationState k -> State
state DelegationState k
ds of
    State
Zero                      -> []
    State
One                       -> [Index 'Soft 'AddressK
forall a. Bounded a => a
minBound]
    More Index 'Soft 'AddressK
nextIx PointerUTxO
_ Key0Status
ValidKey0   -> [Index 'Soft 'AddressK
forall a. Bounded a => a
minBound .. Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
pred Index 'Soft 'AddressK
nextIx]
    More Index 'Soft 'AddressK
nextIx PointerUTxO
_ Key0Status
MissingKey0 -> [Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
succ Index 'Soft 'AddressK
forall a. Bounded a => a
minBound .. Index 'Soft 'AddressK -> Index 'Soft 'AddressK
forall a. Enum a => a -> a
pred Index 'Soft 'AddressK
nextIx]