{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- An implementation of the wallet database using only pure functions.
--
-- These functions and types model the behaviour of the SQLite database backend,
-- and are used for QuickCheck state machine testing, and the MVar database
-- backend.

module Cardano.Wallet.DB.Pure.Implementation
    (
    -- * Model Types
      Database (..)
    , WalletDatabase (..)
    , emptyDatabase
    , TxHistory
    , TxHistoryMap
    , filterTxHistory

    -- * Model Operation Types
    , ModelOp
    , Err (..)

    -- * Model database functions
    , mCleanDB
    , mInitializeWallet
    , mRemoveWallet
    , mListWallets
    , mPutCheckpoint
    , mReadCheckpoint
    , mListCheckpoints
    , mRollbackTo
    , mPutWalletMeta
    , mReadWalletMeta
    , mPutDelegationCertificate
    , mIsStakeKeyRegistered
    , mPutTxHistory
    , mReadTxHistory
    , mPutLocalTxSubmission
    , mReadLocalTxSubmissionPending
    , mUpdatePendingTxForExpiry
    , mRemovePendingOrExpiredTx
    , mPutPrivateKey
    , mReadPrivateKey
    , mReadGenesisParameters
    , mPutDelegationRewardBalance
    , mReadDelegationRewardBalance
    , mCheckWallet
    ) where

import Prelude

import Cardano.Wallet.Primitive.Model
    ( Wallet, currentTip, utxo )
import Cardano.Wallet.Primitive.Slotting
    ( TimeInterpreter, epochOf, interpretQuery, slotToUTCTime )
import Cardano.Wallet.Primitive.Types
    ( BlockHeader (blockHeight, slotNo)
    , ChainPoint
    , DelegationCertificate (..)
    , EpochNo (..)
    , GenesisParameters (..)
    , PoolId
    , Range (..)
    , Slot
    , SlotNo (..)
    , SortOrder (..)
    , StakeKeyCertificate (..)
    , WalletDelegation (..)
    , WalletDelegationNext (..)
    , WalletDelegationStatus (..)
    , WalletMetadata (..)
    , chainPointFromBlockHeader
    , dlgCertPoolId
    , isWithinRange
    , toSlot
    )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.Tx
    ( Direction (..)
    , LocalTxSubmissionStatus (..)
    , SealedTx (..)
    , TransactionInfo (..)
    , Tx (..)
    , TxMeta (..)
    , TxStatus (..)
    )
import Cardano.Wallet.Primitive.Types.UTxO
    ( UTxO (..) )
import Control.DeepSeq
    ( NFData )
import Control.Monad
    ( when )
import Data.Bifunctor
    ( first )
import Data.Function
    ( (&) )
import Data.Functor.Identity
    ( Identity (..) )
import Data.Generics.Internal.VL.Lens
    ( view, (^.) )
import Data.List
    ( sort, sortOn )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( catMaybes, fromMaybe, mapMaybe )
import Data.Ord
    ( Down (..) )
import Data.Quantity
    ( Quantity (..) )
import Data.Word
    ( Word32 )
import GHC.Generics
    ( Generic )

import qualified Data.Map.Strict as Map

{-------------------------------------------------------------------------------
                            Model Database Types
-------------------------------------------------------------------------------}

-- | Model database, parameterised by the wallet ID type, the wallet AD state
-- type, the target backend, and the private key type.
--
-- Tne type parameters exist so that simpler mock types can be used in place of
-- actual wallet types.
data Database wid s xprv = Database
    { Database wid s xprv -> Map wid (WalletDatabase s xprv)
wallets :: !(Map wid (WalletDatabase s xprv))
    -- ^ Wallet-related information.
    , Database wid s xprv -> Map (Hash "Tx") Tx
txs :: !(Map (Hash "Tx") Tx)
    -- ^ In the database, transactions are global and not associated with any
    -- particular wallet.
    } deriving ((forall x. Database wid s xprv -> Rep (Database wid s xprv) x)
-> (forall x. Rep (Database wid s xprv) x -> Database wid s xprv)
-> Generic (Database wid s xprv)
forall x. Rep (Database wid s xprv) x -> Database wid s xprv
forall x. Database wid s xprv -> Rep (Database wid s xprv) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall wid s xprv x.
Rep (Database wid s xprv) x -> Database wid s xprv
forall wid s xprv x.
Database wid s xprv -> Rep (Database wid s xprv) x
$cto :: forall wid s xprv x.
Rep (Database wid s xprv) x -> Database wid s xprv
$cfrom :: forall wid s xprv x.
Database wid s xprv -> Rep (Database wid s xprv) x
Generic, Database wid s xprv -> ()
(Database wid s xprv -> ()) -> NFData (Database wid s xprv)
forall a. (a -> ()) -> NFData a
forall wid s xprv.
(NFData wid, NFData s, NFData xprv) =>
Database wid s xprv -> ()
rnf :: Database wid s xprv -> ()
$crnf :: forall wid s xprv.
(NFData wid, NFData s, NFData xprv) =>
Database wid s xprv -> ()
NFData)

deriving instance (Show wid, Show s, Show xprv) => Show (Database wid s xprv)
deriving instance (Eq wid, Eq xprv, Eq s) => Eq (Database wid s xprv)

-- | Model database record for a single wallet.
data WalletDatabase s xprv = WalletDatabase
    { WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints :: !(Map SlotNo (Wallet s))
    , WalletDatabase s xprv -> Map SlotNo (Maybe PoolId)
certificates :: !(Map SlotNo (Maybe PoolId))
    , WalletDatabase s xprv -> Map SlotNo StakeKeyCertificate
stakeKeys :: !(Map SlotNo StakeKeyCertificate)
    , WalletDatabase s xprv -> WalletMetadata
metadata :: !WalletMetadata
    , WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory :: !(Map (Hash "Tx") TxMeta)
    , WalletDatabase s xprv -> Maybe xprv
xprv :: !(Maybe xprv)
    , WalletDatabase s xprv -> GenesisParameters
genesisParameters :: !GenesisParameters
    , WalletDatabase s xprv -> Coin
rewardAccountBalance :: !Coin
    , WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs :: !(Map (Hash "Tx") (SealedTx, SlotNo))
    } deriving (Int -> WalletDatabase s xprv -> ShowS
[WalletDatabase s xprv] -> ShowS
WalletDatabase s xprv -> String
(Int -> WalletDatabase s xprv -> ShowS)
-> (WalletDatabase s xprv -> String)
-> ([WalletDatabase s xprv] -> ShowS)
-> Show (WalletDatabase s xprv)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s xprv.
(Show s, Show xprv) =>
Int -> WalletDatabase s xprv -> ShowS
forall s xprv.
(Show s, Show xprv) =>
[WalletDatabase s xprv] -> ShowS
forall s xprv.
(Show s, Show xprv) =>
WalletDatabase s xprv -> String
showList :: [WalletDatabase s xprv] -> ShowS
$cshowList :: forall s xprv.
(Show s, Show xprv) =>
[WalletDatabase s xprv] -> ShowS
show :: WalletDatabase s xprv -> String
$cshow :: forall s xprv.
(Show s, Show xprv) =>
WalletDatabase s xprv -> String
showsPrec :: Int -> WalletDatabase s xprv -> ShowS
$cshowsPrec :: forall s xprv.
(Show s, Show xprv) =>
Int -> WalletDatabase s xprv -> ShowS
Show, WalletDatabase s xprv -> WalletDatabase s xprv -> Bool
(WalletDatabase s xprv -> WalletDatabase s xprv -> Bool)
-> (WalletDatabase s xprv -> WalletDatabase s xprv -> Bool)
-> Eq (WalletDatabase s xprv)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s xprv.
(Eq s, Eq xprv) =>
WalletDatabase s xprv -> WalletDatabase s xprv -> Bool
/= :: WalletDatabase s xprv -> WalletDatabase s xprv -> Bool
$c/= :: forall s xprv.
(Eq s, Eq xprv) =>
WalletDatabase s xprv -> WalletDatabase s xprv -> Bool
== :: WalletDatabase s xprv -> WalletDatabase s xprv -> Bool
$c== :: forall s xprv.
(Eq s, Eq xprv) =>
WalletDatabase s xprv -> WalletDatabase s xprv -> Bool
Eq, (forall x. WalletDatabase s xprv -> Rep (WalletDatabase s xprv) x)
-> (forall x.
    Rep (WalletDatabase s xprv) x -> WalletDatabase s xprv)
-> Generic (WalletDatabase s xprv)
forall x. Rep (WalletDatabase s xprv) x -> WalletDatabase s xprv
forall x. WalletDatabase s xprv -> Rep (WalletDatabase s xprv) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s xprv x.
Rep (WalletDatabase s xprv) x -> WalletDatabase s xprv
forall s xprv x.
WalletDatabase s xprv -> Rep (WalletDatabase s xprv) x
$cto :: forall s xprv x.
Rep (WalletDatabase s xprv) x -> WalletDatabase s xprv
$cfrom :: forall s xprv x.
WalletDatabase s xprv -> Rep (WalletDatabase s xprv) x
Generic, WalletDatabase s xprv -> ()
(WalletDatabase s xprv -> ()) -> NFData (WalletDatabase s xprv)
forall a. (a -> ()) -> NFData a
forall s xprv.
(NFData s, NFData xprv) =>
WalletDatabase s xprv -> ()
rnf :: WalletDatabase s xprv -> ()
$crnf :: forall s xprv.
(NFData s, NFData xprv) =>
WalletDatabase s xprv -> ()
NFData)

-- | Shorthand for the putTxHistory argument type.
type TxHistoryMap = Map (Hash "Tx") (Tx, TxMeta)

-- | Shorthand for the readTxHistory result type.
type TxHistory = [(Tx, TxMeta)]

-- | Produces an empty model database.
emptyDatabase :: Ord wid => Database wid s xprv
emptyDatabase :: Database wid s xprv
emptyDatabase = Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
forall wid s xprv.
Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
Database Map wid (WalletDatabase s xprv)
forall a. Monoid a => a
mempty Map (Hash "Tx") Tx
forall a. Monoid a => a
mempty

{-------------------------------------------------------------------------------
                                  Model Operation Types
-------------------------------------------------------------------------------}

-- | A database model operation, which is a function that takes a database and
-- returns:
--  * a value, which is a query of the database, or an error; and
--  * a (possibly) modified database.
type ModelOp wid s xprv a =
    Database wid s xprv -> (Either (Err wid) a, Database wid s xprv)

-- | All of the possible errors that any of the model database functions might
-- return.
data Err wid
    = NoSuchWallet wid
    | WalletAlreadyExists wid
    | NoSuchTx wid (Hash "Tx")
    | CantRemoveTxInLedger wid (Hash "Tx")
    deriving (Int -> Err wid -> ShowS
[Err wid] -> ShowS
Err wid -> String
(Int -> Err wid -> ShowS)
-> (Err wid -> String) -> ([Err wid] -> ShowS) -> Show (Err wid)
forall wid. Show wid => Int -> Err wid -> ShowS
forall wid. Show wid => [Err wid] -> ShowS
forall wid. Show wid => Err wid -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Err wid] -> ShowS
$cshowList :: forall wid. Show wid => [Err wid] -> ShowS
show :: Err wid -> String
$cshow :: forall wid. Show wid => Err wid -> String
showsPrec :: Int -> Err wid -> ShowS
$cshowsPrec :: forall wid. Show wid => Int -> Err wid -> ShowS
Show, Err wid -> Err wid -> Bool
(Err wid -> Err wid -> Bool)
-> (Err wid -> Err wid -> Bool) -> Eq (Err wid)
forall wid. Eq wid => Err wid -> Err wid -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Err wid -> Err wid -> Bool
$c/= :: forall wid. Eq wid => Err wid -> Err wid -> Bool
== :: Err wid -> Err wid -> Bool
$c== :: forall wid. Eq wid => Err wid -> Err wid -> Bool
Eq, a -> Err b -> Err a
(a -> b) -> Err a -> Err b
(forall a b. (a -> b) -> Err a -> Err b)
-> (forall a b. a -> Err b -> Err a) -> Functor Err
forall a b. a -> Err b -> Err a
forall a b. (a -> b) -> Err a -> Err b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Err b -> Err a
$c<$ :: forall a b. a -> Err b -> Err a
fmap :: (a -> b) -> Err a -> Err b
$cfmap :: forall a b. (a -> b) -> Err a -> Err b
Functor, Err a -> Bool
(a -> m) -> Err a -> m
(a -> b -> b) -> b -> Err a -> b
(forall m. Monoid m => Err m -> m)
-> (forall m a. Monoid m => (a -> m) -> Err a -> m)
-> (forall m a. Monoid m => (a -> m) -> Err a -> m)
-> (forall a b. (a -> b -> b) -> b -> Err a -> b)
-> (forall a b. (a -> b -> b) -> b -> Err a -> b)
-> (forall b a. (b -> a -> b) -> b -> Err a -> b)
-> (forall b a. (b -> a -> b) -> b -> Err a -> b)
-> (forall a. (a -> a -> a) -> Err a -> a)
-> (forall a. (a -> a -> a) -> Err a -> a)
-> (forall a. Err a -> [a])
-> (forall a. Err a -> Bool)
-> (forall a. Err a -> Int)
-> (forall a. Eq a => a -> Err a -> Bool)
-> (forall a. Ord a => Err a -> a)
-> (forall a. Ord a => Err a -> a)
-> (forall a. Num a => Err a -> a)
-> (forall a. Num a => Err a -> a)
-> Foldable Err
forall a. Eq a => a -> Err a -> Bool
forall a. Num a => Err a -> a
forall a. Ord a => Err a -> a
forall m. Monoid m => Err m -> m
forall a. Err a -> Bool
forall a. Err a -> Int
forall a. Err a -> [a]
forall a. (a -> a -> a) -> Err a -> a
forall m a. Monoid m => (a -> m) -> Err a -> m
forall b a. (b -> a -> b) -> b -> Err a -> b
forall a b. (a -> b -> b) -> b -> Err a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Err a -> a
$cproduct :: forall a. Num a => Err a -> a
sum :: Err a -> a
$csum :: forall a. Num a => Err a -> a
minimum :: Err a -> a
$cminimum :: forall a. Ord a => Err a -> a
maximum :: Err a -> a
$cmaximum :: forall a. Ord a => Err a -> a
elem :: a -> Err a -> Bool
$celem :: forall a. Eq a => a -> Err a -> Bool
length :: Err a -> Int
$clength :: forall a. Err a -> Int
null :: Err a -> Bool
$cnull :: forall a. Err a -> Bool
toList :: Err a -> [a]
$ctoList :: forall a. Err a -> [a]
foldl1 :: (a -> a -> a) -> Err a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Err a -> a
foldr1 :: (a -> a -> a) -> Err a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Err a -> a
foldl' :: (b -> a -> b) -> b -> Err a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Err a -> b
foldl :: (b -> a -> b) -> b -> Err a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Err a -> b
foldr' :: (a -> b -> b) -> b -> Err a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Err a -> b
foldr :: (a -> b -> b) -> b -> Err a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Err a -> b
foldMap' :: (a -> m) -> Err a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Err a -> m
foldMap :: (a -> m) -> Err a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Err a -> m
fold :: Err m -> m
$cfold :: forall m. Monoid m => Err m -> m
Foldable, Functor Err
Foldable Err
Functor Err
-> Foldable Err
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Err a -> f (Err b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Err (f a) -> f (Err a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Err a -> m (Err b))
-> (forall (m :: * -> *) a. Monad m => Err (m a) -> m (Err a))
-> Traversable Err
(a -> f b) -> Err a -> f (Err b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Err (m a) -> m (Err a)
forall (f :: * -> *) a. Applicative f => Err (f a) -> f (Err a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Err a -> m (Err b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Err a -> f (Err b)
sequence :: Err (m a) -> m (Err a)
$csequence :: forall (m :: * -> *) a. Monad m => Err (m a) -> m (Err a)
mapM :: (a -> m b) -> Err a -> m (Err b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Err a -> m (Err b)
sequenceA :: Err (f a) -> f (Err a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Err (f a) -> f (Err a)
traverse :: (a -> f b) -> Err a -> f (Err b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Err a -> f (Err b)
$cp2Traversable :: Foldable Err
$cp1Traversable :: Functor Err
Traversable)

{-------------------------------------------------------------------------------
                            Model Database Functions
-------------------------------------------------------------------------------}

mCleanDB :: Ord wid => ModelOp wid s xprv ()
mCleanDB :: ModelOp wid s xprv ()
mCleanDB Database wid s xprv
_ = (() -> Either (Err wid) ()
forall a b. b -> Either a b
Right (), Database wid s xprv
forall wid s xprv. Ord wid => Database wid s xprv
emptyDatabase)

mInitializeWallet
    :: forall wid s xprv. Ord wid
    => wid
    -> Wallet s
    -> WalletMetadata
    -> TxHistory
    -> GenesisParameters
    -> ModelOp wid s xprv ()
mInitializeWallet :: wid
-> Wallet s
-> WalletMetadata
-> TxHistory
-> GenesisParameters
-> ModelOp wid s xprv ()
mInitializeWallet wid
wid Wallet s
cp WalletMetadata
meta TxHistory
txs0 GenesisParameters
gp db :: Database wid s xprv
db@Database{Map wid (WalletDatabase s xprv)
wallets :: Map wid (WalletDatabase s xprv)
$sel:wallets:Database :: forall wid s xprv.
Database wid s xprv -> Map wid (WalletDatabase s xprv)
wallets,Map (Hash "Tx") Tx
txs :: Map (Hash "Tx") Tx
$sel:txs:Database :: forall wid s xprv. Database wid s xprv -> Map (Hash "Tx") Tx
txs}
    | wid
wid wid -> Map wid (WalletDatabase s xprv) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map wid (WalletDatabase s xprv)
wallets = (Err wid -> Either (Err wid) ()
forall a b. a -> Either a b
Left (wid -> Err wid
forall wid. wid -> Err wid
WalletAlreadyExists wid
wid), Database wid s xprv
db)
    | Bool
otherwise =
        let
            wal :: WalletDatabase s xprv
wal = WalletDatabase :: forall s xprv.
Map SlotNo (Wallet s)
-> Map SlotNo (Maybe PoolId)
-> Map SlotNo StakeKeyCertificate
-> WalletMetadata
-> Map (Hash "Tx") TxMeta
-> Maybe xprv
-> GenesisParameters
-> Coin
-> Map (Hash "Tx") (SealedTx, SlotNo)
-> WalletDatabase s xprv
WalletDatabase
                { $sel:checkpoints:WalletDatabase :: Map SlotNo (Wallet s)
checkpoints = SlotNo -> Wallet s -> Map SlotNo (Wallet s)
forall k a. k -> a -> Map k a
Map.singleton (Wallet s -> SlotNo
forall s. Wallet s -> SlotNo
tip Wallet s
cp) Wallet s
cp
                , $sel:stakeKeys:WalletDatabase :: Map SlotNo StakeKeyCertificate
stakeKeys = Map SlotNo StakeKeyCertificate
forall a. Monoid a => a
mempty
                , $sel:certificates:WalletDatabase :: Map SlotNo (Maybe PoolId)
certificates = Map SlotNo (Maybe PoolId)
forall a. Monoid a => a
mempty
                , $sel:metadata:WalletDatabase :: WalletMetadata
metadata = WalletMetadata
meta
                , $sel:txHistory:WalletDatabase :: Map (Hash "Tx") TxMeta
txHistory = Map (Hash "Tx") TxMeta
history
                , $sel:xprv:WalletDatabase :: Maybe xprv
xprv = Maybe xprv
forall a. Maybe a
Nothing
                , $sel:genesisParameters:WalletDatabase :: GenesisParameters
genesisParameters = GenesisParameters
gp
                , $sel:rewardAccountBalance:WalletDatabase :: Coin
rewardAccountBalance = Natural -> Coin
Coin Natural
0
                , $sel:submittedTxs:WalletDatabase :: Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs = Map (Hash "Tx") (SealedTx, SlotNo)
forall a. Monoid a => a
mempty
                }
            txs' :: Map (Hash "Tx") Tx
txs' = [(Hash "Tx", Tx)] -> Map (Hash "Tx") Tx
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Hash "Tx", Tx)] -> Map (Hash "Tx") Tx)
-> [(Hash "Tx", Tx)] -> Map (Hash "Tx") Tx
forall a b. (a -> b) -> a -> b
$ (\(Tx
tx, TxMeta
_) -> (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> Tx -> Const (Hash "Tx") Tx)
-> Tx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId Tx
tx, Tx
tx)) ((Tx, TxMeta) -> (Hash "Tx", Tx)) -> TxHistory -> [(Hash "Tx", Tx)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHistory
txs0
            history :: Map (Hash "Tx") TxMeta
history = [(Hash "Tx", TxMeta)] -> Map (Hash "Tx") TxMeta
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Hash "Tx", TxMeta)] -> Map (Hash "Tx") TxMeta)
-> [(Hash "Tx", TxMeta)] -> Map (Hash "Tx") TxMeta
forall a b. (a -> b) -> a -> b
$ (Tx -> Hash "Tx") -> (Tx, TxMeta) -> (Hash "Tx", TxMeta)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> Tx -> Const (Hash "Tx") Tx)
-> Tx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId) ((Tx, TxMeta) -> (Hash "Tx", TxMeta))
-> TxHistory -> [(Hash "Tx", TxMeta)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHistory
txs0
        in
            (() -> Either (Err wid) ()
forall a b. b -> Either a b
Right (), Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
forall wid s xprv.
Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
Database (wid
-> WalletDatabase s xprv
-> Map wid (WalletDatabase s xprv)
-> Map wid (WalletDatabase s xprv)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert wid
wid WalletDatabase s xprv
wal Map wid (WalletDatabase s xprv)
wallets) (Map (Hash "Tx") Tx
txs Map (Hash "Tx") Tx -> Map (Hash "Tx") Tx -> Map (Hash "Tx") Tx
forall a. Semigroup a => a -> a -> a
<> Map (Hash "Tx") Tx
txs'))

mRemoveWallet :: Ord wid => wid -> ModelOp wid s xprv ()
mRemoveWallet :: wid -> ModelOp wid s xprv ()
mRemoveWallet wid
wid db :: Database wid s xprv
db@Database{Map wid (WalletDatabase s xprv)
wallets :: Map wid (WalletDatabase s xprv)
$sel:wallets:Database :: forall wid s xprv.
Database wid s xprv -> Map wid (WalletDatabase s xprv)
wallets,Map (Hash "Tx") Tx
txs :: Map (Hash "Tx") Tx
$sel:txs:Database :: forall wid s xprv. Database wid s xprv -> Map (Hash "Tx") Tx
txs}
    | wid
wid wid -> Map wid (WalletDatabase s xprv) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map wid (WalletDatabase s xprv)
wallets =
        (() -> Either (Err wid) ()
forall a b. b -> Either a b
Right (), Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
forall wid s xprv.
Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
Database (wid
-> Map wid (WalletDatabase s xprv)
-> Map wid (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete wid
wid Map wid (WalletDatabase s xprv)
wallets) Map (Hash "Tx") Tx
txs)
    | Bool
otherwise = (Err wid -> Either (Err wid) ()
forall a b. a -> Either a b
Left (wid -> Err wid
forall wid. wid -> Err wid
NoSuchWallet wid
wid), Database wid s xprv
db)

mCheckWallet :: Ord wid => wid -> ModelOp wid s xprv ()
mCheckWallet :: wid -> ModelOp wid s xprv ()
mCheckWallet wid
wid db :: Database wid s xprv
db@Database{Map wid (WalletDatabase s xprv)
wallets :: Map wid (WalletDatabase s xprv)
$sel:wallets:Database :: forall wid s xprv.
Database wid s xprv -> Map wid (WalletDatabase s xprv)
wallets}
    | wid
wid wid -> Map wid (WalletDatabase s xprv) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map wid (WalletDatabase s xprv)
wallets =
        (() -> Either (Err wid) ()
forall a b. b -> Either a b
Right (), Database wid s xprv
db)
    | Bool
otherwise = (Err wid -> Either (Err wid) ()
forall a b. a -> Either a b
Left (wid -> Err wid
forall wid. wid -> Err wid
NoSuchWallet wid
wid), Database wid s xprv
db)

mListWallets :: Ord wid => ModelOp wid s xprv [wid]
mListWallets :: ModelOp wid s xprv [wid]
mListWallets db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
_) = ([wid] -> Either (Err wid) [wid]
forall a b. b -> Either a b
Right ([wid] -> [wid]
forall a. Ord a => [a] -> [a]
sort ([wid] -> [wid]) -> [wid] -> [wid]
forall a b. (a -> b) -> a -> b
$ Map wid (WalletDatabase s xprv) -> [wid]
forall k a. Map k a -> [k]
Map.keys Map wid (WalletDatabase s xprv)
wallets), Database wid s xprv
db)

mPutCheckpoint
    :: Ord wid => wid -> Wallet s -> ModelOp wid s xprv ()
mPutCheckpoint :: wid -> Wallet s -> ModelOp wid s xprv ()
mPutCheckpoint wid
wid Wallet s
cp = wid
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid ((WalletDatabase s xprv -> ((), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ \WalletDatabase s xprv
wal ->
    ((), WalletDatabase s xprv
wal { $sel:checkpoints:WalletDatabase :: Map SlotNo (Wallet s)
checkpoints = SlotNo
-> Wallet s -> Map SlotNo (Wallet s) -> Map SlotNo (Wallet s)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Wallet s -> SlotNo
forall s. Wallet s -> SlotNo
tip Wallet s
cp) Wallet s
cp (WalletDatabase s xprv -> Map SlotNo (Wallet s)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints WalletDatabase s xprv
wal) })

mReadCheckpoint
    :: Ord wid => wid -> ModelOp wid s xprv (Maybe (Wallet s))
mReadCheckpoint :: wid -> ModelOp wid s xprv (Maybe (Wallet s))
mReadCheckpoint wid
wid db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
_) =
    (Maybe (Wallet s) -> Either (Err wid) (Maybe (Wallet s))
forall a b. b -> Either a b
Right (wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets Maybe (WalletDatabase s xprv)
-> (WalletDatabase s xprv -> Maybe (Wallet s)) -> Maybe (Wallet s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WalletDatabase s xprv -> Maybe (Wallet s)
forall s xprv. WalletDatabase s xprv -> Maybe (Wallet s)
mostRecentCheckpoint), Database wid s xprv
db)

mostRecentCheckpoint :: WalletDatabase s xprv -> Maybe (Wallet s)
mostRecentCheckpoint :: WalletDatabase s xprv -> Maybe (Wallet s)
mostRecentCheckpoint = ((SlotNo, Wallet s) -> Wallet s)
-> Maybe (SlotNo, Wallet s) -> Maybe (Wallet s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SlotNo, Wallet s) -> Wallet s
forall a b. (a, b) -> b
snd (Maybe (SlotNo, Wallet s) -> Maybe (Wallet s))
-> (WalletDatabase s xprv -> Maybe (SlotNo, Wallet s))
-> WalletDatabase s xprv
-> Maybe (Wallet s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SlotNo (Wallet s) -> Maybe (SlotNo, Wallet s)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax (Map SlotNo (Wallet s) -> Maybe (SlotNo, Wallet s))
-> (WalletDatabase s xprv -> Map SlotNo (Wallet s))
-> WalletDatabase s xprv
-> Maybe (SlotNo, Wallet s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletDatabase s xprv -> Map SlotNo (Wallet s)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints

mListCheckpoints
    :: Ord wid => wid -> ModelOp wid s xprv [ChainPoint]
mListCheckpoints :: wid -> ModelOp wid s xprv [ChainPoint]
mListCheckpoints wid
wid db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
_) =
    ([ChainPoint] -> Either (Err wid) [ChainPoint]
forall a b. b -> Either a b
Right ([ChainPoint] -> Either (Err wid) [ChainPoint])
-> [ChainPoint] -> Either (Err wid) [ChainPoint]
forall a b. (a -> b) -> a -> b
$ [ChainPoint] -> [ChainPoint]
forall a. Ord a => [a] -> [a]
sort ([ChainPoint] -> [ChainPoint]) -> [ChainPoint] -> [ChainPoint]
forall a b. (a -> b) -> a -> b
$ [ChainPoint]
-> (WalletDatabase s xprv -> [ChainPoint])
-> Maybe (WalletDatabase s xprv)
-> [ChainPoint]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] WalletDatabase s xprv -> [ChainPoint]
forall s xprv. WalletDatabase s xprv -> [ChainPoint]
tips (wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets), Database wid s xprv
db)
  where
    tips :: WalletDatabase s xprv -> [ChainPoint]
tips = (Wallet s -> ChainPoint) -> [Wallet s] -> [ChainPoint]
forall a b. (a -> b) -> [a] -> [b]
map (BlockHeader -> ChainPoint
chainPointFromBlockHeader (BlockHeader -> ChainPoint)
-> (Wallet s -> BlockHeader) -> Wallet s -> ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet s -> BlockHeader
forall s. Wallet s -> BlockHeader
currentTip) ([Wallet s] -> [ChainPoint])
-> (WalletDatabase s xprv -> [Wallet s])
-> WalletDatabase s xprv
-> [ChainPoint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SlotNo (Wallet s) -> [Wallet s]
forall k a. Map k a -> [a]
Map.elems (Map SlotNo (Wallet s) -> [Wallet s])
-> (WalletDatabase s xprv -> Map SlotNo (Wallet s))
-> WalletDatabase s xprv
-> [Wallet s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletDatabase s xprv -> Map SlotNo (Wallet s)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints

mUpdatePendingTxForExpiry :: Ord wid => wid -> SlotNo -> ModelOp wid s xprv ()
mUpdatePendingTxForExpiry :: wid -> SlotNo -> ModelOp wid s xprv ()
mUpdatePendingTxForExpiry wid
wid SlotNo
tipSlot = wid
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid ((WalletDatabase s xprv -> ((), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ ((),) (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> (WalletDatabase s xprv -> WalletDatabase s xprv)
-> WalletDatabase s xprv
-> ((), WalletDatabase s xprv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletDatabase s xprv -> WalletDatabase s xprv
forall s xprv. WalletDatabase s xprv -> WalletDatabase s xprv
updatePending
  where
    updatePending :: WalletDatabase s xprv -> WalletDatabase s xprv
updatePending WalletDatabase s xprv
wal = WalletDatabase s xprv
wal
        { $sel:txHistory:WalletDatabase :: Map (Hash "Tx") TxMeta
txHistory = TxMeta -> TxMeta
setExpired (TxMeta -> TxMeta)
-> Map (Hash "Tx") TxMeta -> Map (Hash "Tx") TxMeta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal
        , $sel:submittedTxs:WalletDatabase :: Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs = Map (Hash "Tx") (SealedTx, SlotNo)
-> Set (Hash "Tx") -> Map (Hash "Tx") (SealedTx, SlotNo)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys (WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
forall s xprv.
WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs WalletDatabase s xprv
wal) (Set (Hash "Tx") -> Map (Hash "Tx") (SealedTx, SlotNo))
-> Set (Hash "Tx") -> Map (Hash "Tx") (SealedTx, SlotNo)
forall a b. (a -> b) -> a -> b
$
            Map (Hash "Tx") TxMeta -> Set (Hash "Tx")
forall k a. Map k a -> Set k
Map.keysSet (Map (Hash "Tx") TxMeta -> Set (Hash "Tx"))
-> Map (Hash "Tx") TxMeta -> Set (Hash "Tx")
forall a b. (a -> b) -> a -> b
$ (TxMeta -> Bool)
-> Map (Hash "Tx") TxMeta -> Map (Hash "Tx") TxMeta
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter TxMeta -> Bool
isExpired (WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal)
        }

    setExpired :: TxMeta -> TxMeta
    setExpired :: TxMeta -> TxMeta
setExpired TxMeta
txMeta
        | TxMeta -> Bool
isExpired TxMeta
txMeta = TxMeta
txMeta { $sel:status:TxMeta :: TxStatus
status = TxStatus
Expired }
        | Bool
otherwise = TxMeta
txMeta

    isExpired :: TxMeta -> Bool
    isExpired :: TxMeta -> Bool
isExpired TxMeta{TxStatus
status :: TxStatus
$sel:status:TxMeta :: TxMeta -> TxStatus
status,Maybe SlotNo
$sel:expiry:TxMeta :: TxMeta -> Maybe SlotNo
expiry :: Maybe SlotNo
expiry} = case (TxStatus
status, Maybe SlotNo
expiry) of
        (TxStatus
Pending, Just SlotNo
txExp) | SlotNo
txExp SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
tipSlot -> Bool
True
        (TxStatus, Maybe SlotNo)
_ -> Bool
False

mRemovePendingOrExpiredTx :: Ord wid => wid -> Hash "Tx" -> ModelOp wid s xprv ()
mRemovePendingOrExpiredTx :: wid -> Hash "Tx" -> ModelOp wid s xprv ()
mRemovePendingOrExpiredTx wid
wid Hash "Tx"
tid = wid
-> (WalletDatabase s xprv
    -> (Either (Err wid) (), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv
    -> (Either (Err wid) a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModelErr wid
wid ((WalletDatabase s xprv
  -> (Either (Err wid) (), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv
    -> (Either (Err wid) (), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ \WalletDatabase s xprv
wal ->
    case Hash "Tx" -> Map (Hash "Tx") TxMeta -> Maybe TxMeta
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Hash "Tx"
tid (WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal) of
        Maybe TxMeta
Nothing ->
            ( Err wid -> Either (Err wid) ()
forall a b. a -> Either a b
Left (wid -> Hash "Tx" -> Err wid
forall wid. wid -> Hash "Tx" -> Err wid
NoSuchTx wid
wid Hash "Tx"
tid), WalletDatabase s xprv
wal )
        Just TxMeta
txMeta | TxMeta
txMeta TxMeta
-> ((TxStatus -> Const TxStatus TxStatus)
    -> TxMeta -> Const TxStatus TxMeta)
-> TxStatus
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "status"
  ((TxStatus -> Const TxStatus TxStatus)
   -> TxMeta -> Const TxStatus TxMeta)
(TxStatus -> Const TxStatus TxStatus)
-> TxMeta -> Const TxStatus TxMeta
#status TxStatus -> TxStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TxStatus
InLedger ->
            ( Err wid -> Either (Err wid) ()
forall a b. a -> Either a b
Left (wid -> Hash "Tx" -> Err wid
forall wid. wid -> Hash "Tx" -> Err wid
CantRemoveTxInLedger wid
wid Hash "Tx"
tid), WalletDatabase s xprv
wal )
        Just TxMeta
_ ->
            ( () -> Either (Err wid) ()
forall a b. b -> Either a b
Right (), WalletDatabase s xprv
wal
                { $sel:txHistory:WalletDatabase :: Map (Hash "Tx") TxMeta
txHistory = Hash "Tx" -> Map (Hash "Tx") TxMeta -> Map (Hash "Tx") TxMeta
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Hash "Tx"
tid (WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal)
                , $sel:submittedTxs:WalletDatabase :: Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs = Hash "Tx"
-> Map (Hash "Tx") (SealedTx, SlotNo)
-> Map (Hash "Tx") (SealedTx, SlotNo)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Hash "Tx"
tid (WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
forall s xprv.
WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs WalletDatabase s xprv
wal)
                } )

mRollbackTo :: Ord wid => wid -> Slot -> ModelOp wid s xprv ChainPoint
mRollbackTo :: wid -> Slot -> ModelOp wid s xprv ChainPoint
mRollbackTo wid
wid Slot
requested db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
txs) = case wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets of
    Maybe (WalletDatabase s xprv)
Nothing ->
        ( Err wid -> Either (Err wid) ChainPoint
forall a b. a -> Either a b
Left (wid -> Err wid
forall wid. wid -> Err wid
NoSuchWallet wid
wid), Database wid s xprv
db )
    Just WalletDatabase s xprv
wal ->
        case [Wallet s] -> Maybe SlotNo
forall s. [Wallet s] -> Maybe SlotNo
findNearestPoint (Map SlotNo (Wallet s) -> [Wallet s]
forall k a. Map k a -> [a]
Map.elems (Map SlotNo (Wallet s) -> [Wallet s])
-> Map SlotNo (Wallet s) -> [Wallet s]
forall a b. (a -> b) -> a -> b
$ WalletDatabase s xprv -> Map SlotNo (Wallet s)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints WalletDatabase s xprv
wal) of
            Maybe SlotNo
Nothing -> (Err wid -> Either (Err wid) ChainPoint
forall a b. a -> Either a b
Left (wid -> Err wid
forall wid. wid -> Err wid
NoSuchWallet wid
wid), Database wid s xprv
db)
            Just SlotNo
point ->
                let
                    wal' :: WalletDatabase s xprv
wal' = WalletDatabase s xprv
wal
                        { $sel:checkpoints:WalletDatabase :: Map SlotNo (Wallet s)
checkpoints =
                            (Wallet s -> Bool)
-> Map SlotNo (Wallet s) -> Map SlotNo (Wallet s)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
point) (SlotNo -> Bool) -> (Wallet s -> SlotNo) -> Wallet s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet s -> SlotNo
forall s. Wallet s -> SlotNo
tip) (WalletDatabase s xprv -> Map SlotNo (Wallet s)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints WalletDatabase s xprv
wal)
                        , $sel:certificates:WalletDatabase :: Map SlotNo (Maybe PoolId)
certificates =
                            (SlotNo -> Maybe PoolId -> Bool)
-> Map SlotNo (Maybe PoolId) -> Map SlotNo (Maybe PoolId)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\SlotNo
k Maybe PoolId
_ -> SlotNo
k SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
point) (WalletDatabase s xprv -> Map SlotNo (Maybe PoolId)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Maybe PoolId)
certificates WalletDatabase s xprv
wal)
                        , $sel:txHistory:WalletDatabase :: Map (Hash "Tx") TxMeta
txHistory =
                            (TxMeta -> Maybe TxMeta)
-> Map (Hash "Tx") TxMeta -> Map (Hash "Tx") TxMeta
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (SlotNo -> TxMeta -> Maybe TxMeta
rescheduleOrForget SlotNo
point) (WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal)
                        }
                in
                    ( ChainPoint -> Either (Err wid) ChainPoint
forall a b. b -> Either a b
Right
                        (ChainPoint -> Either (Err wid) ChainPoint)
-> ChainPoint -> Either (Err wid) ChainPoint
forall a b. (a -> b) -> a -> b
$ BlockHeader -> ChainPoint
chainPointFromBlockHeader
                        (BlockHeader -> ChainPoint) -> BlockHeader -> ChainPoint
forall a b. (a -> b) -> a -> b
$ ((BlockHeader -> Const BlockHeader BlockHeader)
 -> Wallet s -> Const BlockHeader (Wallet s))
-> Wallet s -> BlockHeader
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "currentTip"
  ((BlockHeader -> Const BlockHeader BlockHeader)
   -> Wallet s -> Const BlockHeader (Wallet s))
(BlockHeader -> Const BlockHeader BlockHeader)
-> Wallet s -> Const BlockHeader (Wallet s)
#currentTip
                        (Wallet s -> BlockHeader) -> Wallet s -> BlockHeader
forall a b. (a -> b) -> a -> b
$ WalletDatabase s xprv -> Map SlotNo (Wallet s)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints WalletDatabase s xprv
wal Map SlotNo (Wallet s) -> SlotNo -> Wallet s
forall k a. Ord k => Map k a -> k -> a
Map.! SlotNo
point
                    , Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
forall wid s xprv.
Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
Database (wid
-> WalletDatabase s xprv
-> Map wid (WalletDatabase s xprv)
-> Map wid (WalletDatabase s xprv)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert wid
wid WalletDatabase s xprv
wal' Map wid (WalletDatabase s xprv)
wallets) Map (Hash "Tx") Tx
txs
                    )
  where
    -- | Removes 'Incoming' transaction beyond the rollback point, and
    -- reschedule as 'Pending' the 'Outgoing' one beyond the rollback point.
    rescheduleOrForget :: SlotNo -> TxMeta -> Maybe TxMeta
    rescheduleOrForget :: SlotNo -> TxMeta -> Maybe TxMeta
rescheduleOrForget SlotNo
point TxMeta
meta = do
        let isAfter :: Bool
isAfter = (TxMeta -> SlotNo
slotNo :: TxMeta -> SlotNo) TxMeta
meta SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
> SlotNo
point
        let isIncoming :: Bool
isIncoming = TxMeta -> Direction
direction TxMeta
meta Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Incoming
        Bool -> Maybe () -> Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isIncoming Bool -> Bool -> Bool
&& Bool
isAfter) Maybe ()
forall a. Maybe a
Nothing
        TxMeta -> Maybe TxMeta
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMeta -> Maybe TxMeta) -> TxMeta -> Maybe TxMeta
forall a b. (a -> b) -> a -> b
$ if Bool
isAfter
            then TxMeta
meta { $sel:slotNo:TxMeta :: SlotNo
slotNo = SlotNo
point , $sel:status:TxMeta :: TxStatus
status = TxStatus
Pending }
            else TxMeta
meta

    -- | Find nearest checkpoint's slot before or equal to 'requested'.
    findNearestPoint :: [Wallet s] -> Maybe SlotNo
    findNearestPoint :: [Wallet s] -> Maybe SlotNo
findNearestPoint = [SlotNo] -> Maybe SlotNo
forall a. [a] -> Maybe a
safeHead ([SlotNo] -> Maybe SlotNo)
-> ([Wallet s] -> [SlotNo]) -> [Wallet s] -> Maybe SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlotNo -> Down SlotNo) -> [SlotNo] -> [SlotNo]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn SlotNo -> Down SlotNo
forall a. a -> Down a
Down ([SlotNo] -> [SlotNo])
-> ([Wallet s] -> [SlotNo]) -> [Wallet s] -> [SlotNo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Wallet s -> Maybe SlotNo) -> [Wallet s] -> [SlotNo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Wallet s -> Maybe SlotNo
forall s. Wallet s -> Maybe SlotNo
fn
      where
        fn :: Wallet s -> Maybe SlotNo
        fn :: Wallet s -> Maybe SlotNo
fn Wallet s
cp = if Wallet s -> Slot
forall s. Wallet s -> Slot
stip Wallet s
cp Slot -> Slot -> Bool
forall a. Ord a => a -> a -> Bool
<= Slot
requested then SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just (Wallet s -> SlotNo
forall s. Wallet s -> SlotNo
tip Wallet s
cp) else Maybe SlotNo
forall a. Maybe a
Nothing
          where
            stip :: Wallet s -> Slot
stip = ChainPoint -> Slot
toSlot (ChainPoint -> Slot)
-> (Wallet s -> ChainPoint) -> Wallet s -> Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> ChainPoint
chainPointFromBlockHeader (BlockHeader -> ChainPoint)
-> (Wallet s -> BlockHeader) -> Wallet s -> ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet s -> BlockHeader
forall s. Wallet s -> BlockHeader
currentTip

    safeHead :: [a] -> Maybe a
    safeHead :: [a] -> Maybe a
safeHead [] = Maybe a
forall a. Maybe a
Nothing
    safeHead (a
h:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
h

mPutWalletMeta :: Ord wid => wid -> WalletMetadata -> ModelOp wid s xprv ()
mPutWalletMeta :: wid -> WalletMetadata -> ModelOp wid s xprv ()
mPutWalletMeta wid
wid WalletMetadata
meta = wid
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid ((WalletDatabase s xprv -> ((), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ \WalletDatabase s xprv
wal ->
    ((), WalletDatabase s xprv
wal { $sel:metadata:WalletDatabase :: WalletMetadata
metadata = WalletMetadata
meta })

mReadWalletMeta
    :: Ord wid
    => TimeInterpreter Identity
    -> wid
    -> ModelOp wid s xprv (Maybe WalletMetadata)
mReadWalletMeta :: TimeInterpreter Identity
-> wid -> ModelOp wid s xprv (Maybe WalletMetadata)
mReadWalletMeta TimeInterpreter Identity
ti wid
wid db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
_) =
    (Maybe WalletMetadata -> Either (Err wid) (Maybe WalletMetadata)
forall a b. b -> Either a b
Right (WalletDatabase s xprv -> Maybe WalletMetadata
forall s xprv. WalletDatabase s xprv -> Maybe WalletMetadata
mkMetadata (WalletDatabase s xprv -> Maybe WalletMetadata)
-> Maybe (WalletDatabase s xprv) -> Maybe WalletMetadata
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets), Database wid s xprv
db)
  where
    epochOf' :: SlotNo -> EpochNo
epochOf' = Identity EpochNo -> EpochNo
forall a. Identity a -> a
runIdentity (Identity EpochNo -> EpochNo)
-> (SlotNo -> Identity EpochNo) -> SlotNo -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeInterpreter Identity -> Qry EpochNo -> Identity EpochNo
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter Identity
ti (Qry EpochNo -> Identity EpochNo)
-> (SlotNo -> Qry EpochNo) -> SlotNo -> Identity EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Qry EpochNo
epochOf
    mkMetadata :: WalletDatabase s xprv -> Maybe WalletMetadata
    mkMetadata :: WalletDatabase s xprv -> Maybe WalletMetadata
mkMetadata WalletDatabase{Map SlotNo (Wallet s)
checkpoints :: Map SlotNo (Wallet s)
$sel:checkpoints:WalletDatabase :: forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints,Map SlotNo (Maybe PoolId)
certificates :: Map SlotNo (Maybe PoolId)
$sel:certificates:WalletDatabase :: forall s xprv. WalletDatabase s xprv -> Map SlotNo (Maybe PoolId)
certificates,WalletMetadata
metadata :: WalletMetadata
$sel:metadata:WalletDatabase :: forall s xprv. WalletDatabase s xprv -> WalletMetadata
metadata} = do
        (SlotNo
slot, Wallet s
_) <- Map SlotNo (Wallet s) -> Maybe (SlotNo, Wallet s)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map SlotNo (Wallet s)
checkpoints
        let currentEpoch :: EpochNo
currentEpoch = SlotNo -> EpochNo
epochOf' SlotNo
slot
        WalletMetadata -> Maybe WalletMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletMetadata -> Maybe WalletMetadata)
-> WalletMetadata -> Maybe WalletMetadata
forall a b. (a -> b) -> a -> b
$ WalletMetadata
metadata { $sel:delegation:WalletMetadata :: WalletDelegation
delegation = Map SlotNo (Maybe PoolId) -> EpochNo -> WalletDelegation
readWalletDelegation Map SlotNo (Maybe PoolId)
certificates EpochNo
currentEpoch }

    readWalletDelegation :: Map SlotNo (Maybe PoolId) -> EpochNo -> WalletDelegation
    readWalletDelegation :: Map SlotNo (Maybe PoolId) -> EpochNo -> WalletDelegation
readWalletDelegation Map SlotNo (Maybe PoolId)
certificates EpochNo
currentEpoch
        | EpochNo
currentEpoch EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
== EpochNo
0 = WalletDelegationStatus
-> [WalletDelegationNext] -> WalletDelegation
WalletDelegation WalletDelegationStatus
NotDelegating []
        | Bool
otherwise =
            let active :: WalletDelegationStatus
active = Map SlotNo (Maybe PoolId)
certificates
                    Map SlotNo (Maybe PoolId)
-> (Map SlotNo (Maybe PoolId) -> Map SlotNo (Maybe PoolId))
-> Map SlotNo (Maybe PoolId)
forall a b. a -> (a -> b) -> b
& (SlotNo -> Maybe PoolId -> Bool)
-> Map SlotNo (Maybe PoolId) -> Map SlotNo (Maybe PoolId)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\SlotNo
sl Maybe PoolId
_ -> (SlotNo -> EpochNo
epochOf' SlotNo
sl) EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< EpochNo
currentEpoch EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
- EpochNo
1)
                    Map SlotNo (Maybe PoolId)
-> (Map SlotNo (Maybe PoolId) -> Maybe (SlotNo, Maybe PoolId))
-> Maybe (SlotNo, Maybe PoolId)
forall a b. a -> (a -> b) -> b
& Map SlotNo (Maybe PoolId) -> Maybe (SlotNo, Maybe PoolId)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax
                    Maybe (SlotNo, Maybe PoolId)
-> (Maybe (SlotNo, Maybe PoolId) -> Maybe PoolId) -> Maybe PoolId
forall a b. a -> (a -> b) -> b
& ((SlotNo, Maybe PoolId) -> Maybe PoolId
forall a b. (a, b) -> b
snd ((SlotNo, Maybe PoolId) -> Maybe PoolId)
-> Maybe (SlotNo, Maybe PoolId) -> Maybe PoolId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
                    Maybe PoolId
-> (Maybe PoolId -> WalletDelegationStatus)
-> WalletDelegationStatus
forall a b. a -> (a -> b) -> b
& WalletDelegationStatus
-> (PoolId -> WalletDelegationStatus)
-> Maybe PoolId
-> WalletDelegationStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WalletDelegationStatus
NotDelegating PoolId -> WalletDelegationStatus
Delegating
                next1 :: [WalletDelegationNext]
next1 = Map SlotNo (Maybe PoolId)
certificates
                    Map SlotNo (Maybe PoolId)
-> (Map SlotNo (Maybe PoolId) -> Map SlotNo (Maybe PoolId))
-> Map SlotNo (Maybe PoolId)
forall a b. a -> (a -> b) -> b
& (SlotNo -> Maybe PoolId -> Bool)
-> Map SlotNo (Maybe PoolId) -> Map SlotNo (Maybe PoolId)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\SlotNo
sl Maybe PoolId
_ -> let ep :: EpochNo
ep = SlotNo -> EpochNo
epochOf' SlotNo
sl in
                        EpochNo
ep EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
>= EpochNo
currentEpoch EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
- EpochNo
1 Bool -> Bool -> Bool
&& EpochNo
ep EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< EpochNo
currentEpoch)
                    Map SlotNo (Maybe PoolId)
-> (Map SlotNo (Maybe PoolId) -> Maybe (SlotNo, Maybe PoolId))
-> Maybe (SlotNo, Maybe PoolId)
forall a b. a -> (a -> b) -> b
& Map SlotNo (Maybe PoolId) -> Maybe (SlotNo, Maybe PoolId)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax
                    Maybe (SlotNo, Maybe PoolId)
-> (Maybe (SlotNo, Maybe PoolId) -> [WalletDelegationNext])
-> [WalletDelegationNext]
forall a b. a -> (a -> b) -> b
& [WalletDelegationNext]
-> ((SlotNo, Maybe PoolId) -> [WalletDelegationNext])
-> Maybe (SlotNo, Maybe PoolId)
-> [WalletDelegationNext]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (EpochNo -> Maybe PoolId -> [WalletDelegationNext]
mkDelegationNext (EpochNo
currentEpoch EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
+ EpochNo
1) (Maybe PoolId -> [WalletDelegationNext])
-> ((SlotNo, Maybe PoolId) -> Maybe PoolId)
-> (SlotNo, Maybe PoolId)
-> [WalletDelegationNext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlotNo, Maybe PoolId) -> Maybe PoolId
forall a b. (a, b) -> b
snd)
                next2 :: [WalletDelegationNext]
next2 = Map SlotNo (Maybe PoolId)
certificates
                    Map SlotNo (Maybe PoolId)
-> (Map SlotNo (Maybe PoolId) -> Map SlotNo (Maybe PoolId))
-> Map SlotNo (Maybe PoolId)
forall a b. a -> (a -> b) -> b
& (SlotNo -> Maybe PoolId -> Bool)
-> Map SlotNo (Maybe PoolId) -> Map SlotNo (Maybe PoolId)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\SlotNo
sl Maybe PoolId
_ -> SlotNo -> EpochNo
epochOf' SlotNo
sl EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
>= EpochNo
currentEpoch)
                    Map SlotNo (Maybe PoolId)
-> (Map SlotNo (Maybe PoolId) -> Maybe (SlotNo, Maybe PoolId))
-> Maybe (SlotNo, Maybe PoolId)
forall a b. a -> (a -> b) -> b
& Map SlotNo (Maybe PoolId) -> Maybe (SlotNo, Maybe PoolId)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax
                    Maybe (SlotNo, Maybe PoolId)
-> (Maybe (SlotNo, Maybe PoolId) -> [WalletDelegationNext])
-> [WalletDelegationNext]
forall a b. a -> (a -> b) -> b
& [WalletDelegationNext]
-> ((SlotNo, Maybe PoolId) -> [WalletDelegationNext])
-> Maybe (SlotNo, Maybe PoolId)
-> [WalletDelegationNext]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (EpochNo -> Maybe PoolId -> [WalletDelegationNext]
mkDelegationNext (EpochNo
currentEpoch EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
+ EpochNo
2) (Maybe PoolId -> [WalletDelegationNext])
-> ((SlotNo, Maybe PoolId) -> Maybe PoolId)
-> (SlotNo, Maybe PoolId)
-> [WalletDelegationNext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlotNo, Maybe PoolId) -> Maybe PoolId
forall a b. (a, b) -> b
snd)
            in
                WalletDelegationStatus
-> [WalletDelegationNext] -> WalletDelegation
WalletDelegation WalletDelegationStatus
active ([WalletDelegationNext]
next1 [WalletDelegationNext]
-> [WalletDelegationNext] -> [WalletDelegationNext]
forall a. [a] -> [a] -> [a]
++ [WalletDelegationNext]
next2)

    mkDelegationNext :: EpochNo -> Maybe PoolId -> [WalletDelegationNext]
    mkDelegationNext :: EpochNo -> Maybe PoolId -> [WalletDelegationNext]
mkDelegationNext EpochNo
ep = WalletDelegationNext -> [WalletDelegationNext]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletDelegationNext -> [WalletDelegationNext])
-> (Maybe PoolId -> WalletDelegationNext)
-> Maybe PoolId
-> [WalletDelegationNext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Maybe PoolId
Nothing -> EpochNo -> WalletDelegationStatus -> WalletDelegationNext
WalletDelegationNext EpochNo
ep WalletDelegationStatus
NotDelegating
        Just PoolId
pid -> EpochNo -> WalletDelegationStatus -> WalletDelegationNext
WalletDelegationNext EpochNo
ep (PoolId -> WalletDelegationStatus
Delegating PoolId
pid)

mPutDelegationCertificate
    :: Ord wid
    => wid
    -> DelegationCertificate
    -> SlotNo
    -> ModelOp wid s xprv ()
mPutDelegationCertificate :: wid -> DelegationCertificate -> SlotNo -> ModelOp wid s xprv ()
mPutDelegationCertificate wid
wid DelegationCertificate
cert SlotNo
slot = wid
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid
    ((WalletDatabase s xprv -> ((), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ \wal :: WalletDatabase s xprv
wal@WalletDatabase{Map SlotNo (Maybe PoolId)
certificates :: Map SlotNo (Maybe PoolId)
$sel:certificates:WalletDatabase :: forall s xprv. WalletDatabase s xprv -> Map SlotNo (Maybe PoolId)
certificates,Map SlotNo StakeKeyCertificate
stakeKeys :: Map SlotNo StakeKeyCertificate
$sel:stakeKeys:WalletDatabase :: forall s xprv.
WalletDatabase s xprv -> Map SlotNo StakeKeyCertificate
stakeKeys} ->
        ( ()
        , WalletDatabase s xprv
wal
            { $sel:certificates:WalletDatabase :: Map SlotNo (Maybe PoolId)
certificates = SlotNo
-> Maybe PoolId
-> Map SlotNo (Maybe PoolId)
-> Map SlotNo (Maybe PoolId)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SlotNo
slot (DelegationCertificate -> Maybe PoolId
dlgCertPoolId DelegationCertificate
cert) Map SlotNo (Maybe PoolId)
certificates
            , $sel:stakeKeys:WalletDatabase :: Map SlotNo StakeKeyCertificate
stakeKeys = case DelegationCertificate
cert of
                CertDelegateNone{} -> SlotNo
-> StakeKeyCertificate
-> Map SlotNo StakeKeyCertificate
-> Map SlotNo StakeKeyCertificate
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SlotNo
slot StakeKeyCertificate
StakeKeyDeregistration Map SlotNo StakeKeyCertificate
stakeKeys
                CertDelegateFull{} -> Map SlotNo StakeKeyCertificate
stakeKeys
                CertRegisterKey{}  -> SlotNo
-> StakeKeyCertificate
-> Map SlotNo StakeKeyCertificate
-> Map SlotNo StakeKeyCertificate
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SlotNo
slot StakeKeyCertificate
StakeKeyRegistration Map SlotNo StakeKeyCertificate
stakeKeys
            }
        )

mIsStakeKeyRegistered
    :: Ord wid
    => wid
    -> ModelOp wid s xprv Bool
mIsStakeKeyRegistered :: wid -> ModelOp wid s xprv Bool
mIsStakeKeyRegistered wid
wid = wid
-> (WalletDatabase s xprv -> (Bool, WalletDatabase s xprv))
-> ModelOp wid s xprv Bool
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid ((WalletDatabase s xprv -> (Bool, WalletDatabase s xprv))
 -> ModelOp wid s xprv Bool)
-> (WalletDatabase s xprv -> (Bool, WalletDatabase s xprv))
-> ModelOp wid s xprv Bool
forall a b. (a -> b) -> a -> b
$ \wal :: WalletDatabase s xprv
wal@WalletDatabase{Map SlotNo StakeKeyCertificate
stakeKeys :: Map SlotNo StakeKeyCertificate
$sel:stakeKeys:WalletDatabase :: forall s xprv.
WalletDatabase s xprv -> Map SlotNo StakeKeyCertificate
stakeKeys} ->
    ( Bool
-> ((SlotNo, StakeKeyCertificate) -> Bool)
-> Maybe (SlotNo, StakeKeyCertificate)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((StakeKeyCertificate -> StakeKeyCertificate -> Bool
forall a. Eq a => a -> a -> Bool
== StakeKeyCertificate
StakeKeyRegistration) (StakeKeyCertificate -> Bool)
-> ((SlotNo, StakeKeyCertificate) -> StakeKeyCertificate)
-> (SlotNo, StakeKeyCertificate)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlotNo, StakeKeyCertificate) -> StakeKeyCertificate
forall a b. (a, b) -> b
snd) (Map SlotNo StakeKeyCertificate
-> Maybe (SlotNo, StakeKeyCertificate)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map SlotNo StakeKeyCertificate
stakeKeys)
    , WalletDatabase s xprv
wal
    )

mPutTxHistory
    :: forall wid s xprv. Ord wid
    => wid
    -> TxHistory
    -> ModelOp wid s xprv ()
mPutTxHistory :: wid -> TxHistory -> ModelOp wid s xprv ()
mPutTxHistory wid
wid TxHistory
txList db :: Database wid s xprv
db@Database{Map wid (WalletDatabase s xprv)
wallets :: Map wid (WalletDatabase s xprv)
$sel:wallets:Database :: forall wid s xprv.
Database wid s xprv -> Map wid (WalletDatabase s xprv)
wallets,Map (Hash "Tx") Tx
txs :: Map (Hash "Tx") Tx
$sel:txs:Database :: forall wid s xprv. Database wid s xprv -> Map (Hash "Tx") Tx
txs} =
    case wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets of
        Just WalletDatabase s xprv
wal ->
            ( () -> Either (Err wid) ()
forall a b. b -> Either a b
Right ()
            , Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
forall wid s xprv.
Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
Database (wid
-> WalletDatabase s xprv
-> Map wid (WalletDatabase s xprv)
-> Map wid (WalletDatabase s xprv)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert wid
wid WalletDatabase s xprv
wal' Map wid (WalletDatabase s xprv)
wallets) (Map (Hash "Tx") Tx
txs Map (Hash "Tx") Tx -> Map (Hash "Tx") Tx -> Map (Hash "Tx") Tx
forall a. Semigroup a => a -> a -> a
<> Map (Hash "Tx") Tx
txs')
            )
          where
            wal' :: WalletDatabase s xprv
wal' = WalletDatabase s xprv
wal { $sel:txHistory:WalletDatabase :: Map (Hash "Tx") TxMeta
txHistory = WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal Map (Hash "Tx") TxMeta
-> Map (Hash "Tx") TxMeta -> Map (Hash "Tx") TxMeta
forall a. Semigroup a => a -> a -> a
<> Map (Hash "Tx") TxMeta
txHistory' }
            txHistory' :: Map (Hash "Tx") TxMeta
txHistory' = [(Hash "Tx", TxMeta)] -> Map (Hash "Tx") TxMeta
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Hash "Tx", TxMeta)] -> Map (Hash "Tx") TxMeta)
-> [(Hash "Tx", TxMeta)] -> Map (Hash "Tx") TxMeta
forall a b. (a -> b) -> a -> b
$ (Tx -> Hash "Tx") -> (Tx, TxMeta) -> (Hash "Tx", TxMeta)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> Tx -> Const (Hash "Tx") Tx)
-> Tx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId) ((Tx, TxMeta) -> (Hash "Tx", TxMeta))
-> TxHistory -> [(Hash "Tx", TxMeta)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHistory
txList
            txs' :: Map (Hash "Tx") Tx
txs' = [(Hash "Tx", Tx)] -> Map (Hash "Tx") Tx
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Hash "Tx", Tx)] -> Map (Hash "Tx") Tx)
-> [(Hash "Tx", Tx)] -> Map (Hash "Tx") Tx
forall a b. (a -> b) -> a -> b
$ (\(Tx
tx, TxMeta
_) -> (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> Tx -> Const (Hash "Tx") Tx)
-> Tx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId Tx
tx, Tx
tx)) ((Tx, TxMeta) -> (Hash "Tx", Tx)) -> TxHistory -> [(Hash "Tx", Tx)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHistory
txList
        Maybe (WalletDatabase s xprv)
Nothing -> (Err wid -> Either (Err wid) ()
forall a b. a -> Either a b
Left (wid -> Err wid
forall wid. wid -> Err wid
NoSuchWallet wid
wid), Database wid s xprv
db)

mReadTxHistory
    :: forall wid s xprv . Ord wid
    => TimeInterpreter Identity
    -> wid
    -> Maybe Coin
    -> SortOrder
    -> Range SlotNo
    -> Maybe TxStatus
    -> ModelOp wid s xprv [TransactionInfo]
mReadTxHistory :: TimeInterpreter Identity
-> wid
-> Maybe Coin
-> SortOrder
-> Range SlotNo
-> Maybe TxStatus
-> ModelOp wid s xprv [TransactionInfo]
mReadTxHistory TimeInterpreter Identity
ti wid
wid Maybe Coin
minWithdrawal SortOrder
order Range SlotNo
range Maybe TxStatus
mstatus db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
txs) =
    ([TransactionInfo] -> Either (Err wid) [TransactionInfo]
forall a b. b -> Either a b
Right [TransactionInfo]
res, Database wid s xprv
db)
  where
    slotStartTime' :: SlotNo -> UTCTime
slotStartTime' = Identity UTCTime -> UTCTime
forall a. Identity a -> a
runIdentity (Identity UTCTime -> UTCTime)
-> (SlotNo -> Identity UTCTime) -> SlotNo -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeInterpreter Identity -> Qry UTCTime -> Identity UTCTime
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter Identity
ti (Qry UTCTime -> Identity UTCTime)
-> (SlotNo -> Qry UTCTime) -> SlotNo -> Identity UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Qry UTCTime
slotToUTCTime
    res :: [TransactionInfo]
res = [TransactionInfo] -> Maybe [TransactionInfo] -> [TransactionInfo]
forall a. a -> Maybe a -> a
fromMaybe [TransactionInfo]
forall a. Monoid a => a
mempty (Maybe [TransactionInfo] -> [TransactionInfo])
-> Maybe [TransactionInfo] -> [TransactionInfo]
forall a b. (a -> b) -> a -> b
$ do
        WalletDatabase s xprv
wal <- wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets
        (SlotNo
_, Wallet s
cp) <- Map SlotNo (Wallet s) -> Maybe (SlotNo, Wallet s)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax (WalletDatabase s xprv -> Map SlotNo (Wallet s)
forall s xprv. WalletDatabase s xprv -> Map SlotNo (Wallet s)
checkpoints WalletDatabase s xprv
wal)
        [TransactionInfo] -> Maybe [TransactionInfo]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TransactionInfo] -> Maybe [TransactionInfo])
-> [TransactionInfo] -> Maybe [TransactionInfo]
forall a b. (a -> b) -> a -> b
$ Wallet s -> Map (Hash "Tx") TxMeta -> [TransactionInfo]
getTxs Wallet s
cp (WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal)

    getTxs :: Wallet s -> Map (Hash "Tx") TxMeta -> [TransactionInfo]
getTxs Wallet s
cp Map (Hash "Tx") TxMeta
history
            = ((Tx, TxMeta) -> TransactionInfo) -> TxHistory -> [TransactionInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Wallet s -> (Tx, TxMeta) -> TransactionInfo
mkTransactionInfo Wallet s
cp)
            (TxHistory -> [TransactionInfo]) -> TxHistory -> [TransactionInfo]
forall a b. (a -> b) -> a -> b
$ Maybe Coin -> SortOrder -> Range SlotNo -> TxHistory -> TxHistory
filterTxHistory Maybe Coin
minWithdrawal SortOrder
order Range SlotNo
range
            (TxHistory -> TxHistory) -> TxHistory -> TxHistory
forall a b. (a -> b) -> a -> b
$ [Maybe (Tx, TxMeta)] -> TxHistory
forall a. [Maybe a] -> [a]
catMaybes
            [ (Tx -> (Tx, TxMeta)) -> Maybe Tx -> Maybe (Tx, TxMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, TxMeta
meta) (Hash "Tx" -> Map (Hash "Tx") Tx -> Maybe Tx
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Hash "Tx"
tid Map (Hash "Tx") Tx
txs)
            | (Hash "Tx"
tid, TxMeta
meta) <- Map (Hash "Tx") TxMeta -> [(Hash "Tx", TxMeta)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash "Tx") TxMeta
history
            , case Maybe TxStatus
mstatus of
                Maybe TxStatus
Nothing -> Bool
True
                Just TxStatus
s -> (TxMeta -> TxStatus
status :: TxMeta -> TxStatus) TxMeta
meta TxStatus -> TxStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TxStatus
s
            ]

    mkTransactionInfo :: Wallet s -> (Tx, TxMeta) -> TransactionInfo
mkTransactionInfo Wallet s
cp (Tx
tx, TxMeta
meta) = TransactionInfo :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Coin, Maybe TxOut)]
-> [(TxIn, Coin, Maybe TxOut)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> TxMeta
-> Quantity "block" Natural
-> UTCTime
-> Maybe TxMetadata
-> Maybe TxScriptValidity
-> TransactionInfo
TransactionInfo
        { $sel:txInfoId:TransactionInfo :: Hash "Tx"
txInfoId =
            ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> Tx -> Const (Hash "Tx") Tx)
-> Tx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId Tx
tx
        , $sel:txInfoFee:TransactionInfo :: Maybe Coin
txInfoFee =
            Tx -> Maybe Coin
fee Tx
tx
        , $sel:txInfoInputs:TransactionInfo :: [(TxIn, Coin, Maybe TxOut)]
txInfoInputs =
            (\(TxIn
inp, Coin
amt) -> (TxIn
inp, Coin
amt, TxIn -> Map TxIn TxOut -> Maybe TxOut
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
inp (Map TxIn TxOut -> Maybe TxOut) -> Map TxIn TxOut -> Maybe TxOut
forall a b. (a -> b) -> a -> b
$ UTxO -> Map TxIn TxOut
unUTxO (UTxO -> Map TxIn TxOut) -> UTxO -> Map TxIn TxOut
forall a b. (a -> b) -> a -> b
$ Wallet s -> UTxO
forall s. Wallet s -> UTxO
utxo Wallet s
cp))
                ((TxIn, Coin) -> (TxIn, Coin, Maybe TxOut))
-> [(TxIn, Coin)] -> [(TxIn, Coin, Maybe TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx -> [(TxIn, Coin)]
resolvedInputs Tx
tx
        , $sel:txInfoCollateralInputs:TransactionInfo :: [(TxIn, Coin, Maybe TxOut)]
txInfoCollateralInputs =
            (\(TxIn
inp, Coin
amt) -> (TxIn
inp, Coin
amt, TxIn -> Map TxIn TxOut -> Maybe TxOut
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
inp (Map TxIn TxOut -> Maybe TxOut) -> Map TxIn TxOut -> Maybe TxOut
forall a b. (a -> b) -> a -> b
$ UTxO -> Map TxIn TxOut
unUTxO (UTxO -> Map TxIn TxOut) -> UTxO -> Map TxIn TxOut
forall a b. (a -> b) -> a -> b
$ Wallet s -> UTxO
forall s. Wallet s -> UTxO
utxo Wallet s
cp))
                ((TxIn, Coin) -> (TxIn, Coin, Maybe TxOut))
-> [(TxIn, Coin)] -> [(TxIn, Coin, Maybe TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx -> [(TxIn, Coin)]
resolvedCollateralInputs Tx
tx
        , $sel:txInfoOutputs:TransactionInfo :: [TxOut]
txInfoOutputs =
            Tx -> [TxOut]
outputs Tx
tx
        , $sel:txInfoCollateralOutput:TransactionInfo :: Maybe TxOut
txInfoCollateralOutput =
            Tx -> Maybe TxOut
collateralOutput Tx
tx
        , $sel:txInfoWithdrawals:TransactionInfo :: Map RewardAccount Coin
txInfoWithdrawals =
            Tx -> Map RewardAccount Coin
withdrawals Tx
tx
        , $sel:txInfoMeta:TransactionInfo :: TxMeta
txInfoMeta =
            TxMeta
meta
        , $sel:txInfoDepth:TransactionInfo :: Quantity "block" Natural
txInfoDepth =
            Natural -> Quantity "block" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "block" Natural)
-> Natural -> Quantity "block" Natural
forall a b. (a -> b) -> a -> b
$ Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> Word32 -> Natural
forall a b. (a -> b) -> a -> b
$ if Word32
tipH Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
txH then Word32
tipH Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
txH else Word32
0
        , $sel:txInfoTime:TransactionInfo :: UTCTime
txInfoTime =
            SlotNo -> UTCTime
slotStartTime' (TxMeta
meta TxMeta
-> ((SlotNo -> Const SlotNo SlotNo)
    -> TxMeta -> Const SlotNo TxMeta)
-> SlotNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo) -> TxMeta -> Const SlotNo TxMeta)
(SlotNo -> Const SlotNo SlotNo) -> TxMeta -> Const SlotNo TxMeta
#slotNo)
        , $sel:txInfoMetadata:TransactionInfo :: Maybe TxMetadata
txInfoMetadata =
            (Tx
tx Tx
-> ((Maybe TxMetadata
     -> Const (Maybe TxMetadata) (Maybe TxMetadata))
    -> Tx -> Const (Maybe TxMetadata) Tx)
-> Maybe TxMetadata
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "metadata"
  ((Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
   -> Tx -> Const (Maybe TxMetadata) Tx)
(Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
-> Tx -> Const (Maybe TxMetadata) Tx
#metadata)
        , $sel:txInfoScriptValidity:TransactionInfo :: Maybe TxScriptValidity
txInfoScriptValidity =
            (Tx
tx Tx
-> ((Maybe TxScriptValidity
     -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
    -> Tx -> Const (Maybe TxScriptValidity) Tx)
-> Maybe TxScriptValidity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "scriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> Tx -> Const (Maybe TxScriptValidity) Tx)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> Tx -> Const (Maybe TxScriptValidity) Tx
#scriptValidity)
        }
      where
        txH :: Word32
txH  = Quantity "block" Word32 -> Word32
forall (unit :: Symbol) a. Quantity unit a -> a
getQuantity
             (Quantity "block" Word32 -> Word32)
-> Quantity "block" Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ (TxMeta -> Quantity "block" Word32
blockHeight :: TxMeta -> Quantity "block" Word32)
             TxMeta
meta
        tipH :: Word32
tipH = Quantity "block" Word32 -> Word32
forall (unit :: Symbol) a. Quantity unit a -> a
getQuantity
             (Quantity "block" Word32 -> Word32)
-> Quantity "block" Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ (BlockHeader -> Quantity "block" Word32
blockHeight :: BlockHeader -> Quantity "block" Word32)
             (BlockHeader -> Quantity "block" Word32)
-> BlockHeader -> Quantity "block" Word32
forall a b. (a -> b) -> a -> b
$ Wallet s -> BlockHeader
forall s. Wallet s -> BlockHeader
currentTip Wallet s
cp

mPutPrivateKey :: Ord wid => wid -> xprv -> ModelOp wid s xprv ()
mPutPrivateKey :: wid -> xprv -> ModelOp wid s xprv ()
mPutPrivateKey wid
wid xprv
pk = wid
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid ((WalletDatabase s xprv -> ((), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ \WalletDatabase s xprv
wal ->
    ((), WalletDatabase s xprv
wal { $sel:xprv:WalletDatabase :: Maybe xprv
xprv = xprv -> Maybe xprv
forall a. a -> Maybe a
Just xprv
pk })

mReadPrivateKey :: Ord wid => wid -> ModelOp wid s xprv (Maybe xprv)
mReadPrivateKey :: wid -> ModelOp wid s xprv (Maybe xprv)
mReadPrivateKey wid
wid db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
_) =
    (Maybe xprv -> Either (Err wid) (Maybe xprv)
forall a b. b -> Either a b
Right (wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets Maybe (WalletDatabase s xprv)
-> (WalletDatabase s xprv -> Maybe xprv) -> Maybe xprv
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WalletDatabase s xprv -> Maybe xprv
forall s xprv. WalletDatabase s xprv -> Maybe xprv
xprv), Database wid s xprv
db)

mReadGenesisParameters
    :: Ord wid => wid -> ModelOp wid s xprv (Maybe GenesisParameters)
mReadGenesisParameters :: wid -> ModelOp wid s xprv (Maybe GenesisParameters)
mReadGenesisParameters wid
wid db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
_) =
    (Maybe GenesisParameters
-> Either (Err wid) (Maybe GenesisParameters)
forall a b. b -> Either a b
Right (WalletDatabase s xprv -> GenesisParameters
forall s xprv. WalletDatabase s xprv -> GenesisParameters
genesisParameters (WalletDatabase s xprv -> GenesisParameters)
-> Maybe (WalletDatabase s xprv) -> Maybe GenesisParameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets), Database wid s xprv
db)

mPutDelegationRewardBalance
    :: Ord wid => wid -> Coin -> ModelOp wid s xprv ()
mPutDelegationRewardBalance :: wid -> Coin -> ModelOp wid s xprv ()
mPutDelegationRewardBalance wid
wid Coin
amt = wid
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid ((WalletDatabase s xprv -> ((), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv -> ((), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ \WalletDatabase s xprv
wal ->
    ((), WalletDatabase s xprv
wal { $sel:rewardAccountBalance:WalletDatabase :: Coin
rewardAccountBalance = Coin
amt })

mReadDelegationRewardBalance
    :: Ord wid => wid -> ModelOp wid s xprv Coin
mReadDelegationRewardBalance :: wid -> ModelOp wid s xprv Coin
mReadDelegationRewardBalance wid
wid db :: Database wid s xprv
db@(Database Map wid (WalletDatabase s xprv)
wallets Map (Hash "Tx") Tx
_) =
    (Coin -> Either (Err wid) Coin
forall a b. b -> Either a b
Right (Coin
-> (WalletDatabase s xprv -> Coin)
-> Maybe (WalletDatabase s xprv)
-> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Natural -> Coin
Coin Natural
0) WalletDatabase s xprv -> Coin
forall s xprv. WalletDatabase s xprv -> Coin
rewardAccountBalance (Maybe (WalletDatabase s xprv) -> Coin)
-> Maybe (WalletDatabase s xprv) -> Coin
forall a b. (a -> b) -> a -> b
$ wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets), Database wid s xprv
db)

mPutLocalTxSubmission :: Ord wid => wid -> Hash "Tx" -> SealedTx -> SlotNo -> ModelOp wid s xprv ()
mPutLocalTxSubmission :: wid -> Hash "Tx" -> SealedTx -> SlotNo -> ModelOp wid s xprv ()
mPutLocalTxSubmission wid
wid Hash "Tx"
tid SealedTx
tx SlotNo
sl = wid
-> (WalletDatabase s xprv
    -> (Either (Err wid) (), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv
    -> (Either (Err wid) a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModelErr wid
wid ((WalletDatabase s xprv
  -> (Either (Err wid) (), WalletDatabase s xprv))
 -> ModelOp wid s xprv ())
-> (WalletDatabase s xprv
    -> (Either (Err wid) (), WalletDatabase s xprv))
-> ModelOp wid s xprv ()
forall a b. (a -> b) -> a -> b
$ \WalletDatabase s xprv
wal ->
    case Hash "Tx" -> Map (Hash "Tx") TxMeta -> Maybe TxMeta
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Hash "Tx"
tid (WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory WalletDatabase s xprv
wal) of
        Maybe TxMeta
Nothing -> (Err wid -> Either (Err wid) ()
forall a b. a -> Either a b
Left (wid -> Hash "Tx" -> Err wid
forall wid. wid -> Hash "Tx" -> Err wid
NoSuchTx wid
wid Hash "Tx"
tid), WalletDatabase s xprv
wal)
        Just TxMeta
_ -> (() -> Either (Err wid) ()
forall a b. b -> Either a b
Right (), WalletDatabase s xprv -> WalletDatabase s xprv
insertSubmittedTx WalletDatabase s xprv
wal)
  where
    insertSubmittedTx :: WalletDatabase s xprv -> WalletDatabase s xprv
insertSubmittedTx WalletDatabase s xprv
wal = WalletDatabase s xprv
wal { $sel:submittedTxs:WalletDatabase :: Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs = Map (Hash "Tx") (SealedTx, SlotNo)
-> Map (Hash "Tx") (SealedTx, SlotNo)
putTx (WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
forall s xprv.
WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs WalletDatabase s xprv
wal) }
    putTx :: Map (Hash "Tx") (SealedTx, SlotNo)
-> Map (Hash "Tx") (SealedTx, SlotNo)
putTx = ((SealedTx, SlotNo) -> (SealedTx, SlotNo) -> (SealedTx, SlotNo))
-> Hash "Tx"
-> (SealedTx, SlotNo)
-> Map (Hash "Tx") (SealedTx, SlotNo)
-> Map (Hash "Tx") (SealedTx, SlotNo)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (SealedTx, SlotNo) -> (SealedTx, SlotNo) -> (SealedTx, SlotNo)
forall a b a b. (a, b) -> (a, b) -> (a, b)
upsert Hash "Tx"
tid (SealedTx
tx, SlotNo
sl)
    upsert :: (a, b) -> (a, b) -> (a, b)
upsert (a
_, b
newSl) (a
origTx, b
_) = (a
origTx, b
newSl)

mReadLocalTxSubmissionPending
    :: Ord wid
    => wid
    -> ModelOp wid s xprv [LocalTxSubmissionStatus SealedTx]
mReadLocalTxSubmissionPending :: wid -> ModelOp wid s xprv [LocalTxSubmissionStatus SealedTx]
mReadLocalTxSubmissionPending wid
wid = wid
-> (WalletDatabase s xprv -> [LocalTxSubmissionStatus SealedTx])
-> ModelOp wid s xprv [LocalTxSubmissionStatus SealedTx]
forall wid a s xprv.
(Ord wid, Monoid a) =>
wid -> (WalletDatabase s xprv -> a) -> ModelOp wid s xprv a
readWalletModel wid
wid ((WalletDatabase s xprv -> [LocalTxSubmissionStatus SealedTx])
 -> ModelOp wid s xprv [LocalTxSubmissionStatus SealedTx])
-> (WalletDatabase s xprv -> [LocalTxSubmissionStatus SealedTx])
-> ModelOp wid s xprv [LocalTxSubmissionStatus SealedTx]
forall a b. (a -> b) -> a -> b
$ \WalletDatabase s xprv
wal ->
    (LocalTxSubmissionStatus SealedTx -> Hash "Tx")
-> [LocalTxSubmissionStatus SealedTx]
-> [LocalTxSubmissionStatus SealedTx]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> LocalTxSubmissionStatus SealedTx
 -> Const (Hash "Tx") (LocalTxSubmissionStatus SealedTx))
-> LocalTxSubmissionStatus SealedTx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> LocalTxSubmissionStatus SealedTx
   -> Const (Hash "Tx") (LocalTxSubmissionStatus SealedTx))
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> LocalTxSubmissionStatus SealedTx
-> Const (Hash "Tx") (LocalTxSubmissionStatus SealedTx)
#txId) ([LocalTxSubmissionStatus SealedTx]
 -> [LocalTxSubmissionStatus SealedTx])
-> [LocalTxSubmissionStatus SealedTx]
-> [LocalTxSubmissionStatus SealedTx]
forall a b. (a -> b) -> a -> b
$ ((Hash "Tx", SlotNo) -> Maybe (LocalTxSubmissionStatus SealedTx))
-> [(Hash "Tx", SlotNo)] -> [LocalTxSubmissionStatus SealedTx]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (WalletDatabase s xprv
-> (Hash "Tx", SlotNo) -> Maybe (LocalTxSubmissionStatus SealedTx)
forall s xprv.
WalletDatabase s xprv
-> (Hash "Tx", SlotNo) -> Maybe (LocalTxSubmissionStatus SealedTx)
getSubmission WalletDatabase s xprv
wal) (WalletDatabase s xprv -> [(Hash "Tx", SlotNo)]
forall s xprv. WalletDatabase s xprv -> [(Hash "Tx", SlotNo)]
pendings WalletDatabase s xprv
wal)
  where
    pendings :: WalletDatabase s xprv -> [(Hash "Tx", SlotNo)]
pendings = ((Hash "Tx", TxMeta) -> Maybe (Hash "Tx", SlotNo))
-> [(Hash "Tx", TxMeta)] -> [(Hash "Tx", SlotNo)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Hash "Tx", TxMeta) -> Maybe (Hash "Tx", SlotNo)
getPending ([(Hash "Tx", TxMeta)] -> [(Hash "Tx", SlotNo)])
-> (WalletDatabase s xprv -> [(Hash "Tx", TxMeta)])
-> WalletDatabase s xprv
-> [(Hash "Tx", SlotNo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Hash "Tx") TxMeta -> [(Hash "Tx", TxMeta)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Hash "Tx") TxMeta -> [(Hash "Tx", TxMeta)])
-> (WalletDatabase s xprv -> Map (Hash "Tx") TxMeta)
-> WalletDatabase s xprv
-> [(Hash "Tx", TxMeta)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
forall s xprv. WalletDatabase s xprv -> Map (Hash "Tx") TxMeta
txHistory

    getPending :: (Hash "Tx", TxMeta) -> Maybe (Hash "Tx", SlotNo)
    getPending :: (Hash "Tx", TxMeta) -> Maybe (Hash "Tx", SlotNo)
getPending (Hash "Tx"
txid, TxMeta{TxStatus
status :: TxStatus
$sel:status:TxMeta :: TxMeta -> TxStatus
status,SlotNo
slotNo :: SlotNo
$sel:slotNo:TxMeta :: TxMeta -> SlotNo
slotNo})
        | TxStatus
status TxStatus -> TxStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TxStatus
Pending = (Hash "Tx", SlotNo) -> Maybe (Hash "Tx", SlotNo)
forall a. a -> Maybe a
Just (Hash "Tx"
txid, SlotNo
slotNo)
        | Bool
otherwise = Maybe (Hash "Tx", SlotNo)
forall a. Maybe a
Nothing

    getSubmission :: WalletDatabase s xprv
-> (Hash "Tx", SlotNo) -> Maybe (LocalTxSubmissionStatus SealedTx)
getSubmission WalletDatabase s xprv
wal (Hash "Tx"
tid, SlotNo
sl0) = (SealedTx, SlotNo) -> LocalTxSubmissionStatus SealedTx
make ((SealedTx, SlotNo) -> LocalTxSubmissionStatus SealedTx)
-> Maybe (SealedTx, SlotNo)
-> Maybe (LocalTxSubmissionStatus SealedTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hash "Tx"
-> Map (Hash "Tx") (SealedTx, SlotNo) -> Maybe (SealedTx, SlotNo)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Hash "Tx"
tid (WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
forall s xprv.
WalletDatabase s xprv -> Map (Hash "Tx") (SealedTx, SlotNo)
submittedTxs WalletDatabase s xprv
wal)
      where
        make :: (SealedTx, SlotNo) -> LocalTxSubmissionStatus SealedTx
make (SealedTx
tx, SlotNo
sl1) = Hash "Tx"
-> SealedTx -> SlotNo -> SlotNo -> LocalTxSubmissionStatus SealedTx
forall tx.
Hash "Tx" -> tx -> SlotNo -> SlotNo -> LocalTxSubmissionStatus tx
LocalTxSubmissionStatus Hash "Tx"
tid SealedTx
tx SlotNo
sl0 SlotNo
sl1

{-------------------------------------------------------------------------------
                             Model function helpers
-------------------------------------------------------------------------------}

-- | Create a 'ModelOp' which mutates the database for a certain wallet id.
--
-- The given function returns a value and a modified wallet database.
alterModel
    :: Ord wid
    => wid
    -> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
    -> ModelOp wid s xprv a
alterModel :: wid
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModel wid
wid WalletDatabase s xprv -> (a, WalletDatabase s xprv)
f = wid
-> (WalletDatabase s xprv
    -> (Either (Err wid) a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
forall wid s xprv a.
Ord wid =>
wid
-> (WalletDatabase s xprv
    -> (Either (Err wid) a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModelErr wid
wid ((a -> Either (Err wid) a)
-> (a, WalletDatabase s xprv)
-> (Either (Err wid) a, WalletDatabase s xprv)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> Either (Err wid) a
forall a b. b -> Either a b
Right ((a, WalletDatabase s xprv)
 -> (Either (Err wid) a, WalletDatabase s xprv))
-> (WalletDatabase s xprv -> (a, WalletDatabase s xprv))
-> WalletDatabase s xprv
-> (Either (Err wid) a, WalletDatabase s xprv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletDatabase s xprv -> (a, WalletDatabase s xprv)
f)

-- | Create a 'ModelOp' which mutates the database for a certain wallet id.
--
-- The given function returns a either a value or error, and a modified wallet
-- database.
alterModelErr
    :: Ord wid
    => wid
    -> (WalletDatabase s xprv -> (Either (Err wid) a, WalletDatabase s xprv))
    -> ModelOp wid s xprv a
alterModelErr :: wid
-> (WalletDatabase s xprv
    -> (Either (Err wid) a, WalletDatabase s xprv))
-> ModelOp wid s xprv a
alterModelErr wid
wid WalletDatabase s xprv
-> (Either (Err wid) a, WalletDatabase s xprv)
f db :: Database wid s xprv
db@Database{Map wid (WalletDatabase s xprv)
wallets :: Map wid (WalletDatabase s xprv)
$sel:wallets:Database :: forall wid s xprv.
Database wid s xprv -> Map wid (WalletDatabase s xprv)
wallets,Map (Hash "Tx") Tx
txs :: Map (Hash "Tx") Tx
$sel:txs:Database :: forall wid s xprv. Database wid s xprv -> Map (Hash "Tx") Tx
txs} =
    case WalletDatabase s xprv
-> (Either (Err wid) a, WalletDatabase s xprv)
f (WalletDatabase s xprv
 -> (Either (Err wid) a, WalletDatabase s xprv))
-> Maybe (WalletDatabase s xprv)
-> Maybe (Either (Err wid) a, WalletDatabase s xprv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid Map wid (WalletDatabase s xprv)
wallets of
        Just (Either (Err wid) a
a, WalletDatabase s xprv
wal) -> (Either (Err wid) a
a, Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
forall wid s xprv.
Map wid (WalletDatabase s xprv)
-> Map (Hash "Tx") Tx -> Database wid s xprv
Database (wid
-> WalletDatabase s xprv
-> Map wid (WalletDatabase s xprv)
-> Map wid (WalletDatabase s xprv)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert wid
wid WalletDatabase s xprv
wal Map wid (WalletDatabase s xprv)
wallets) Map (Hash "Tx") Tx
txs)
        Maybe (Either (Err wid) a, WalletDatabase s xprv)
Nothing -> (Err wid -> Either (Err wid) a
forall a b. a -> Either a b
Left (wid -> Err wid
forall wid. wid -> Err wid
NoSuchWallet wid
wid), Database wid s xprv
db)

-- | Create a 'ModelOp' for a specific wallet which reads but does not alter the
-- database.
readWalletModelMaybe
    :: Ord wid
    => wid
    -> (WalletDatabase s xprv -> a)
    -> ModelOp wid s xprv (Maybe a)
readWalletModelMaybe :: wid -> (WalletDatabase s xprv -> a) -> ModelOp wid s xprv (Maybe a)
readWalletModelMaybe wid
wid WalletDatabase s xprv -> a
f Database wid s xprv
db = (,Database wid s xprv
db) (Either (Err wid) (Maybe a)
 -> (Either (Err wid) (Maybe a), Database wid s xprv))
-> Either (Err wid) (Maybe a)
-> (Either (Err wid) (Maybe a), Database wid s xprv)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either (Err wid) (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either (Err wid) (Maybe a))
-> Maybe a -> Either (Err wid) (Maybe a)
forall a b. (a -> b) -> a -> b
$ WalletDatabase s xprv -> a
f (WalletDatabase s xprv -> a)
-> Maybe (WalletDatabase s xprv) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> wid
-> Map wid (WalletDatabase s xprv) -> Maybe (WalletDatabase s xprv)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup wid
wid (Database wid s xprv -> Map wid (WalletDatabase s xprv)
forall wid s xprv.
Database wid s xprv -> Map wid (WalletDatabase s xprv)
wallets Database wid s xprv
db)

readWalletModel
    :: (Ord wid, Monoid a)
    => wid
    -> (WalletDatabase s xprv -> a)
    -> ModelOp wid s xprv a
readWalletModel :: wid -> (WalletDatabase s xprv -> a) -> ModelOp wid s xprv a
readWalletModel wid
wid WalletDatabase s xprv -> a
f = (Either (Err wid) (Maybe a) -> Either (Err wid) a)
-> (Either (Err wid) (Maybe a), Database wid s xprv)
-> (Either (Err wid) a, Database wid s xprv)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Maybe a -> a) -> Either (Err wid) (Maybe a) -> Either (Err wid) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Monoid a => a
mempty)) ((Either (Err wid) (Maybe a), Database wid s xprv)
 -> (Either (Err wid) a, Database wid s xprv))
-> (Database wid s xprv
    -> (Either (Err wid) (Maybe a), Database wid s xprv))
-> ModelOp wid s xprv a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. wid
-> (WalletDatabase s xprv -> a)
-> Database wid s xprv
-> (Either (Err wid) (Maybe a), Database wid s xprv)
forall wid s xprv a.
Ord wid =>
wid -> (WalletDatabase s xprv -> a) -> ModelOp wid s xprv (Maybe a)
readWalletModelMaybe wid
wid WalletDatabase s xprv -> a
f

-- | Apply optional filters on slotNo and sort using the default sort order
-- (first time/slotNo, then by TxId) to a 'TxHistory'.
filterTxHistory
    :: Maybe Coin
    -> SortOrder
    -> Range SlotNo
    -> TxHistory
    -> TxHistory
filterTxHistory :: Maybe Coin -> SortOrder -> Range SlotNo -> TxHistory -> TxHistory
filterTxHistory Maybe Coin
minWithdrawal SortOrder
order Range SlotNo
range =
    ((Tx, TxMeta) -> Bool) -> TxHistory -> TxHistory
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Coin -> (Tx, TxMeta) -> Bool
forall b. Maybe Coin -> (Tx, b) -> Bool
filterWithdrawals Maybe Coin
minWithdrawal)
    (TxHistory -> TxHistory)
-> (TxHistory -> TxHistory) -> TxHistory -> TxHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Tx, TxMeta) -> Bool) -> TxHistory -> TxHistory
forall a. (a -> Bool) -> [a] -> [a]
filter ((SlotNo -> Range SlotNo -> Bool
forall a. Ord a => a -> Range a -> Bool
`isWithinRange` Range SlotNo
range) (SlotNo -> Bool)
-> ((Tx, TxMeta) -> SlotNo) -> (Tx, TxMeta) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMeta -> SlotNo
slotNo :: TxMeta -> SlotNo) (TxMeta -> SlotNo)
-> ((Tx, TxMeta) -> TxMeta) -> (Tx, TxMeta) -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tx, TxMeta) -> TxMeta
forall a b. (a, b) -> b
snd)
    (TxHistory -> TxHistory)
-> (TxHistory -> TxHistory) -> TxHistory -> TxHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case SortOrder
order of
        SortOrder
Ascending -> TxHistory -> TxHistory
forall a. [a] -> [a]
reverse
        SortOrder
Descending -> TxHistory -> TxHistory
forall a. a -> a
id)
    (TxHistory -> TxHistory)
-> (TxHistory -> TxHistory) -> TxHistory -> TxHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHistory -> TxHistory
forall a. [(a, TxMeta)] -> [(a, TxMeta)]
sortBySlot
    (TxHistory -> TxHistory)
-> (TxHistory -> TxHistory) -> TxHistory -> TxHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHistory -> TxHistory
forall b. [(Tx, b)] -> [(Tx, b)]
sortByTxId
  where
    sortBySlot :: [(a, TxMeta)] -> [(a, TxMeta)]
sortBySlot = ((a, TxMeta) -> Down SlotNo) -> [(a, TxMeta)] -> [(a, TxMeta)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SlotNo -> Down SlotNo
forall a. a -> Down a
Down (SlotNo -> Down SlotNo)
-> ((a, TxMeta) -> SlotNo) -> (a, TxMeta) -> Down SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMeta -> SlotNo
slotNo :: TxMeta -> SlotNo) (TxMeta -> SlotNo)
-> ((a, TxMeta) -> TxMeta) -> (a, TxMeta) -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, TxMeta) -> TxMeta
forall a b. (a, b) -> b
snd)
    sortByTxId :: [(Tx, b)] -> [(Tx, b)]
sortByTxId = ((Tx, b) -> Hash "Tx") -> [(Tx, b)] -> [(Tx, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> Tx -> Const (Hash "Tx") Tx)
-> Tx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId (Tx -> Hash "Tx") -> ((Tx, b) -> Tx) -> (Tx, b) -> Hash "Tx"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tx, b) -> Tx
forall a b. (a, b) -> a
fst)
    atLeast :: a -> Map k a -> Bool
atLeast a
inf = Bool -> Bool
not (Bool -> Bool) -> (Map k a -> Bool) -> Map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Bool
forall k a. Map k a -> Bool
Map.null (Map k a -> Bool) -> (Map k a -> Map k a) -> Map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Map k a -> Map k a
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
inf)
    filterWithdrawals :: Maybe Coin -> (Tx, b) -> Bool
filterWithdrawals = ((Tx, b) -> Bool)
-> (Coin -> (Tx, b) -> Bool) -> Maybe Coin -> (Tx, b) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Bool -> (Tx, b) -> Bool
forall a b. a -> b -> a
const Bool
True)
        (\Coin
inf -> Coin -> Map RewardAccount Coin -> Bool
forall a k. Ord a => a -> Map k a -> Bool
atLeast Coin
inf (Map RewardAccount Coin -> Bool)
-> ((Tx, b) -> Map RewardAccount Coin) -> (Tx, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> Map RewardAccount Coin
withdrawals (Tx -> Map RewardAccount Coin)
-> ((Tx, b) -> Tx) -> (Tx, b) -> Map RewardAccount Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tx, b) -> Tx
forall a b. (a, b) -> a
fst)


tip :: Wallet s -> SlotNo
tip :: Wallet s -> SlotNo
tip = (BlockHeader -> SlotNo
slotNo :: BlockHeader -> SlotNo) (BlockHeader -> SlotNo)
-> (Wallet s -> BlockHeader) -> Wallet s -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet s -> BlockHeader
forall s. Wallet s -> BlockHeader
currentTip