{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}


-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- An implementation of the production pool 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.Pool.DB.Model
    (
    -- * Model Types
      PoolDatabase (..)
    , emptyPoolDatabase
    -- * Model Operation Types
    , ModelOp
    , PoolErr (..)
    -- * Model pool database functions
    , mCleanDatabase
    , mCleanPoolMetadata
    , mPutPoolProduction
    , mPutHeader
    , mListHeaders
    , mReadPoolProduction
    , mReadTotalProduction
    , mPutStakeDistribution
    , mReadStakeDistribution
    , mReadPoolMetadata
    , mPutPoolRegistration
    , mReadPoolRegistration
    , mPutPoolRetirement
    , mReadPoolRetirement
    , mUnfetchedPoolMetadataRefs
    , mPutDelistedPools
    , mPutFetchAttempt
    , mPutPoolMetadata
    , mListPoolLifeCycleData
    , mListRegisteredPools
    , mListRetiredPools
    , mReadPoolLifeCycleStatus
    , mReadSystemSeed
    , mRollbackTo
    , mReadCursor
    , mRemovePools
    , mReadDelistedPools
    , mRemoveRetiredPools
    , mReadSettings
    , mPutSettings
    , mPutLastMetadataGC
    , mReadLastMetadataGC
    ) where

import Prelude

import Cardano.Pool.DB
    ( determinePoolLifeCycleStatus )
import Cardano.Wallet.Primitive.Slotting
    ( TimeInterpreter, epochOf, interpretQuery )
import Cardano.Wallet.Primitive.Types
    ( BlockHeader (..)
    , CertificatePublicationTime
    , EpochNo (..)
    , InternalState (..)
    , PoolId
    , PoolLifeCycleStatus (..)
    , PoolOwner (..)
    , PoolRegistrationCertificate (..)
    , PoolRetirementCertificate (..)
    , Settings
    , SlotNo (..)
    , StakePoolMetadata (..)
    , StakePoolMetadataHash
    , StakePoolMetadataUrl
    , defaultInternalState
    , defaultSettings
    )
import Control.Monad.Trans.Class
    ( lift )
import Control.Monad.Trans.State.Strict
    ( StateT )
import Data.Bifunctor
    ( first )
import Data.Foldable
    ( fold )
import Data.Function
    ( (&) )
import Data.Functor.Const
    ( Const (..) )
import Data.Functor.Identity
    ( Identity (..) )
import Data.Generics.Internal.VL.Lens
    ( over, view )
import Data.Map.Strict
    ( Map )
import Data.Ord
    ( Down (..) )
import Data.Quantity
    ( Quantity (..) )
import Data.Set
    ( Set )
import Data.Time.Clock.POSIX
    ( POSIXTime )
import Data.Word
    ( Word64 )
import GHC.Generics
    ( Generic )
import System.Random
    ( StdGen, newStdGen )

import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.List as L
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

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

data PoolDatabase = PoolDatabase
    { PoolDatabase -> Map PoolId [BlockHeader]
pools :: !(Map PoolId [BlockHeader])
    -- ^ Information of what blocks were produced by which stake pools

    , PoolDatabase -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
distributions :: !(Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
    -- ^ Store known stake distributions for epochs

    , PoolDatabase -> Map PoolId [PoolOwner]
owners :: !(Map PoolId [PoolOwner])
    -- ^ Mapping between pool ids and owners

    , PoolDatabase
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
registrations ::
        !(Map (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
    -- ^ On-chain registrations associated with pools

    , PoolDatabase
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
retirements ::
        !(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
    -- ^ On-chain retirements associated with pools

    , PoolDatabase -> Set PoolId
delisted :: !(Set PoolId)

    , PoolDatabase -> Map StakePoolMetadataHash StakePoolMetadata
metadata :: !(Map StakePoolMetadataHash StakePoolMetadata)
    -- ^ Off-chain metadata cached in database

    , PoolDatabase
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
fetchAttempts :: !(Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
    -- ^ Metadata (failed) fetch attempts

    , PoolDatabase -> SystemSeed
seed :: !SystemSeed
    -- ^ Store an arbitrary random generator seed

    , PoolDatabase -> [BlockHeader]
blockHeaders :: [BlockHeader]
    -- ^ Store headers during syncing

    , PoolDatabase -> Settings
settings :: Settings

    , PoolDatabase -> InternalState
internalState :: InternalState
    -- ^ Various internal states that need to persist across
    -- wallet restarts.
    } deriving ((forall x. PoolDatabase -> Rep PoolDatabase x)
-> (forall x. Rep PoolDatabase x -> PoolDatabase)
-> Generic PoolDatabase
forall x. Rep PoolDatabase x -> PoolDatabase
forall x. PoolDatabase -> Rep PoolDatabase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolDatabase x -> PoolDatabase
$cfrom :: forall x. PoolDatabase -> Rep PoolDatabase x
Generic, Int -> PoolDatabase -> ShowS
[PoolDatabase] -> ShowS
PoolDatabase -> String
(Int -> PoolDatabase -> ShowS)
-> (PoolDatabase -> String)
-> ([PoolDatabase] -> ShowS)
-> Show PoolDatabase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolDatabase] -> ShowS
$cshowList :: [PoolDatabase] -> ShowS
show :: PoolDatabase -> String
$cshow :: PoolDatabase -> String
showsPrec :: Int -> PoolDatabase -> ShowS
$cshowsPrec :: Int -> PoolDatabase -> ShowS
Show, PoolDatabase -> PoolDatabase -> Bool
(PoolDatabase -> PoolDatabase -> Bool)
-> (PoolDatabase -> PoolDatabase -> Bool) -> Eq PoolDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolDatabase -> PoolDatabase -> Bool
$c/= :: PoolDatabase -> PoolDatabase -> Bool
== :: PoolDatabase -> PoolDatabase -> Bool
$c== :: PoolDatabase -> PoolDatabase -> Bool
Eq)

data SystemSeed
    = SystemSeed StdGen
    | NotSeededYet
    deriving ((forall x. SystemSeed -> Rep SystemSeed x)
-> (forall x. Rep SystemSeed x -> SystemSeed) -> Generic SystemSeed
forall x. Rep SystemSeed x -> SystemSeed
forall x. SystemSeed -> Rep SystemSeed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SystemSeed x -> SystemSeed
$cfrom :: forall x. SystemSeed -> Rep SystemSeed x
Generic, Int -> SystemSeed -> ShowS
[SystemSeed] -> ShowS
SystemSeed -> String
(Int -> SystemSeed -> ShowS)
-> (SystemSeed -> String)
-> ([SystemSeed] -> ShowS)
-> Show SystemSeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemSeed] -> ShowS
$cshowList :: [SystemSeed] -> ShowS
show :: SystemSeed -> String
$cshow :: SystemSeed -> String
showsPrec :: Int -> SystemSeed -> ShowS
$cshowsPrec :: Int -> SystemSeed -> ShowS
Show)

-- | Shallow / weak equality on seeds.
instance Eq SystemSeed where
    (SystemSeed StdGen
_) == :: SystemSeed -> SystemSeed -> Bool
== (SystemSeed StdGen
_) = Bool
True
    SystemSeed
NotSeededYet == SystemSeed
NotSeededYet = Bool
True
    SystemSeed
_ == SystemSeed
_ = Bool
False

-- | Produces an empty model pool production database.
emptyPoolDatabase :: PoolDatabase
emptyPoolDatabase :: PoolDatabase
emptyPoolDatabase = Map PoolId [BlockHeader]
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
-> Map PoolId [PoolOwner]
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Set PoolId
-> Map StakePoolMetadataHash StakePoolMetadata
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
-> SystemSeed
-> [BlockHeader]
-> Settings
-> InternalState
-> PoolDatabase
PoolDatabase
    Map PoolId [BlockHeader]
forall a. Monoid a => a
mempty Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
forall a. Monoid a => a
mempty Map PoolId [PoolOwner]
forall a. Monoid a => a
mempty Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall a. Monoid a => a
mempty Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
forall a. Monoid a => a
mempty Set PoolId
forall a. Monoid a => a
mempty Map StakePoolMetadataHash StakePoolMetadata
forall a. Monoid a => a
mempty Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
forall a. Monoid a => a
mempty SystemSeed
NotSeededYet
    [BlockHeader]
forall a. Monoid a => a
mempty Settings
defaultSettings InternalState
defaultInternalState

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

type ModelOp a = StateT PoolDatabase (Either PoolErr) a

newtype PoolErr = PointAlreadyExists BlockHeader
    deriving (Int -> PoolErr -> ShowS
[PoolErr] -> ShowS
PoolErr -> String
(Int -> PoolErr -> ShowS)
-> (PoolErr -> String) -> ([PoolErr] -> ShowS) -> Show PoolErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolErr] -> ShowS
$cshowList :: [PoolErr] -> ShowS
show :: PoolErr -> String
$cshow :: PoolErr -> String
showsPrec :: Int -> PoolErr -> ShowS
$cshowsPrec :: Int -> PoolErr -> ShowS
Show, PoolErr -> PoolErr -> Bool
(PoolErr -> PoolErr -> Bool)
-> (PoolErr -> PoolErr -> Bool) -> Eq PoolErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolErr -> PoolErr -> Bool
$c/= :: PoolErr -> PoolErr -> Bool
== :: PoolErr -> PoolErr -> Bool
$c== :: PoolErr -> PoolErr -> Bool
Eq)

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

mCleanDatabase :: ModelOp ()
mCleanDatabase :: ModelOp ()
mCleanDatabase = PoolDatabase -> ModelOp ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put PoolDatabase
emptyPoolDatabase

mCleanPoolMetadata :: ModelOp ()
mCleanPoolMetadata :: ModelOp ()
mCleanPoolMetadata = do
    ((Map StakePoolMetadataHash StakePoolMetadata
  -> Identity (Map StakePoolMetadataHash StakePoolMetadata))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map StakePoolMetadataHash StakePoolMetadata
    -> Map StakePoolMetadataHash StakePoolMetadata)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "metadata"
  ((Map StakePoolMetadataHash StakePoolMetadata
    -> Identity (Map StakePoolMetadataHash StakePoolMetadata))
   -> PoolDatabase -> Identity PoolDatabase)
(Map StakePoolMetadataHash StakePoolMetadata
 -> Identity (Map StakePoolMetadataHash StakePoolMetadata))
-> PoolDatabase -> Identity PoolDatabase
#metadata
        ((Map StakePoolMetadataHash StakePoolMetadata
  -> Map StakePoolMetadataHash StakePoolMetadata)
 -> ModelOp ())
-> (Map StakePoolMetadataHash StakePoolMetadata
    -> Map StakePoolMetadataHash StakePoolMetadata)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ Map StakePoolMetadataHash StakePoolMetadata
-> Map StakePoolMetadataHash StakePoolMetadata
-> Map StakePoolMetadataHash StakePoolMetadata
forall a b. a -> b -> a
const Map StakePoolMetadataHash StakePoolMetadata
forall a. Monoid a => a
mempty
    [PoolId] -> ModelOp ()
mPutDelistedPools []

mPutPoolProduction :: BlockHeader -> PoolId -> ModelOp ()
mPutPoolProduction :: BlockHeader -> PoolId -> ModelOp ()
mPutPoolProduction BlockHeader
point PoolId
poolId = ModelOp [BlockHeader]
getPoints ModelOp [BlockHeader]
-> ([BlockHeader] -> ModelOp ()) -> ModelOp ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[BlockHeader]
points -> if
    | BlockHeader
point BlockHeader -> [BlockHeader] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BlockHeader]
points ->
        Either PoolErr () -> ModelOp ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either PoolErr () -> ModelOp ())
-> Either PoolErr () -> ModelOp ()
forall a b. (a -> b) -> a -> b
$ PoolErr -> Either PoolErr ()
forall a b. a -> Either a b
Left (PoolErr -> Either PoolErr ()) -> PoolErr -> Either PoolErr ()
forall a b. (a -> b) -> a -> b
$ BlockHeader -> PoolErr
PointAlreadyExists BlockHeader
point
    | Bool
otherwise ->
        ((Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "pools"
  ((Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
-> PoolDatabase -> Identity PoolDatabase
#pools ((Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
 -> ModelOp ())
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ (Maybe [BlockHeader] -> Maybe [BlockHeader])
-> PoolId -> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (BlockHeader -> Maybe [BlockHeader] -> Maybe [BlockHeader]
alter BlockHeader
point) PoolId
poolId
  where
    alter :: BlockHeader -> Maybe [BlockHeader] -> Maybe [BlockHeader]
alter BlockHeader
slot = \case
        Maybe [BlockHeader]
Nothing -> [BlockHeader] -> Maybe [BlockHeader]
forall a. a -> Maybe a
Just [BlockHeader
slot]
        Just [BlockHeader]
slots -> [BlockHeader] -> Maybe [BlockHeader]
forall a. a -> Maybe a
Just ([BlockHeader] -> Maybe [BlockHeader])
-> [BlockHeader] -> Maybe [BlockHeader]
forall a b. (a -> b) -> a -> b
$ [BlockHeader] -> [BlockHeader]
sortDesc ([BlockHeader] -> [BlockHeader]) -> [BlockHeader] -> [BlockHeader]
forall a b. (a -> b) -> a -> b
$ BlockHeader
slot BlockHeader -> [BlockHeader] -> [BlockHeader]
forall a. a -> [a] -> [a]
: [BlockHeader]
slots
    sortDesc :: [BlockHeader] -> [BlockHeader]
sortDesc = (BlockHeader -> BlockHeader -> Ordering)
-> [BlockHeader] -> [BlockHeader]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ((BlockHeader -> BlockHeader -> Ordering)
-> BlockHeader -> BlockHeader -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip BlockHeader -> BlockHeader -> Ordering
forall a. Ord a => a -> a -> Ordering
compare)

    getPoints :: ModelOp [BlockHeader]
    getPoints :: ModelOp [BlockHeader]
getPoints = [[BlockHeader]] -> [BlockHeader]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[BlockHeader]] -> [BlockHeader])
-> (Map PoolId [BlockHeader] -> [[BlockHeader]])
-> Map PoolId [BlockHeader]
-> [BlockHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PoolId [BlockHeader] -> [[BlockHeader]]
forall k a. Map k a -> [a]
Map.elems (Map PoolId [BlockHeader] -> [BlockHeader])
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
-> ModelOp [BlockHeader]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map PoolId [BlockHeader]
  -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
 -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "pools"
  ((Map PoolId [BlockHeader]
    -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
   -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
(Map PoolId [BlockHeader]
 -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
-> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase
#pools

mReadPoolProduction
    :: TimeInterpreter Identity
    -> EpochNo
    -> ModelOp (Map PoolId [BlockHeader])
mReadPoolProduction :: TimeInterpreter Identity
-> EpochNo
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
mReadPoolProduction TimeInterpreter Identity
timeInterpreter EpochNo
epoch =
    Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
forall k a. Map k [a] -> Map k [a]
updatePools (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> Map PoolId [BlockHeader]
-> Map PoolId [BlockHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochNo -> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
updateSlots EpochNo
epoch (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map PoolId [BlockHeader]
  -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
 -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "pools"
  ((Map PoolId [BlockHeader]
    -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
   -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
(Map PoolId [BlockHeader]
 -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
-> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase
#pools
  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
timeInterpreter (Qry EpochNo -> Identity EpochNo)
-> (SlotNo -> Qry EpochNo) -> SlotNo -> Identity EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Qry EpochNo
epochOf
    updatePools :: Map k [a] -> Map k [a]
updatePools = ([a] -> Bool) -> Map k [a] -> Map k [a]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null)
    updateSlots :: EpochNo -> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
updateSlots EpochNo
e = ([BlockHeader] -> [BlockHeader])
-> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((BlockHeader -> Bool) -> [BlockHeader] -> [BlockHeader]
forall a. (a -> Bool) -> [a] -> [a]
filter (\BlockHeader
x -> SlotNo -> EpochNo
epochOf' (BlockHeader -> SlotNo
slotNo BlockHeader
x) EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
== EpochNo
e))

mReadTotalProduction :: ModelOp (Map PoolId (Quantity "block" Word64))
mReadTotalProduction :: ModelOp (Map PoolId (Quantity "block" Word64))
mReadTotalProduction =
    ([BlockHeader] -> Quantity "block" Word64)
-> Map PoolId [BlockHeader] -> Map PoolId (Quantity "block" Word64)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Word64 -> Quantity "block" Word64
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Word64 -> Quantity "block" Word64)
-> ([BlockHeader] -> Word64)
-> [BlockHeader]
-> Quantity "block" Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64)
-> ([BlockHeader] -> Int) -> [BlockHeader] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeader] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) (Map PoolId [BlockHeader] -> Map PoolId (Quantity "block" Word64))
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
-> ModelOp (Map PoolId (Quantity "block" Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map PoolId [BlockHeader]
  -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
 -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "pools"
  ((Map PoolId [BlockHeader]
    -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
   -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
(Map PoolId [BlockHeader]
 -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
-> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase
#pools

mPutStakeDistribution
    :: EpochNo -> [(PoolId, Quantity "lovelace" Word64)] -> ModelOp ()
mPutStakeDistribution :: EpochNo -> [(PoolId, Quantity "lovelace" Word64)] -> ModelOp ()
mPutStakeDistribution EpochNo
epoch [(PoolId, Quantity "lovelace" Word64)]
distribution =
    ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
  -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "distributions"
  ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
 -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
-> PoolDatabase -> Identity PoolDatabase
#distributions ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
  -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
 -> ModelOp ())
-> (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ EpochNo
-> [(PoolId, Quantity "lovelace" Word64)]
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EpochNo
epoch [(PoolId, Quantity "lovelace" Word64)]
distribution

mReadStakeDistribution
    :: EpochNo -> ModelOp [(PoolId, Quantity "lovelace" Word64)]
mReadStakeDistribution :: EpochNo -> ModelOp [(PoolId, Quantity "lovelace" Word64)]
mReadStakeDistribution EpochNo
epoch =
    [(PoolId, Quantity "lovelace" Word64)]
-> EpochNo
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
-> [(PoolId, Quantity "lovelace" Word64)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [(PoolId, Quantity "lovelace" Word64)]
forall a. Monoid a => a
mempty EpochNo
epoch (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
 -> [(PoolId, Quantity "lovelace" Word64)])
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ModelOp [(PoolId, Quantity "lovelace" Word64)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
  -> Const
       (Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
       (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
 -> PoolDatabase
 -> Const
      (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]) PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "distributions"
  ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Const
         (Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
         (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
   -> PoolDatabase
   -> Const
        (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]) PoolDatabase)
(Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
 -> Const
      (Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
      (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
-> PoolDatabase
-> Const
     (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]) PoolDatabase
#distributions

mPutPoolRegistration
    :: CertificatePublicationTime
    -> PoolRegistrationCertificate
    -> ModelOp ()
mPutPoolRegistration :: CertificatePublicationTime
-> PoolRegistrationCertificate -> ModelOp ()
mPutPoolRegistration CertificatePublicationTime
cpt PoolRegistrationCertificate
cert = do
    ((Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "owners"
  ((Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
-> PoolDatabase -> Identity PoolDatabase
#owners
        ((Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ())
-> (Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ()
forall a b. (a -> b) -> a -> b
$ PoolId
-> [PoolOwner] -> Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PoolId
poolId [PoolOwner]
poolOwners
    ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Identity
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Identity
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase -> Identity PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Identity
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase -> Identity PoolDatabase
#registrations
        ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Map
       (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
 -> ModelOp ())
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ (CertificatePublicationTime, PoolId)
-> PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (CertificatePublicationTime
cpt, PoolId
poolId) PoolRegistrationCertificate
cert
  where
    PoolRegistrationCertificate {PoolId
$sel:poolId:PoolRegistrationCertificate :: PoolRegistrationCertificate -> PoolId
poolId :: PoolId
poolId, [PoolOwner]
$sel:poolOwners:PoolRegistrationCertificate :: PoolRegistrationCertificate -> [PoolOwner]
poolOwners :: [PoolOwner]
poolOwners} = PoolRegistrationCertificate
cert

mReadPoolRegistration
    :: PoolId
    -> ModelOp
        (Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
mReadPoolRegistration :: PoolId
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
mReadPoolRegistration PoolId
poolId =
    (((CertificatePublicationTime, PoolId),
  PoolRegistrationCertificate)
 -> (CertificatePublicationTime, PoolRegistrationCertificate))
-> Maybe
     ((CertificatePublicationTime, PoolId), PoolRegistrationCertificate)
-> Maybe (CertificatePublicationTime, PoolRegistrationCertificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CertificatePublicationTime, PoolId)
 -> CertificatePublicationTime)
-> ((CertificatePublicationTime, PoolId),
    PoolRegistrationCertificate)
-> (CertificatePublicationTime, PoolRegistrationCertificate)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (CertificatePublicationTime, PoolId) -> CertificatePublicationTime
forall a b. (a, b) -> a
fst) (Maybe
   ((CertificatePublicationTime, PoolId), PoolRegistrationCertificate)
 -> Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Maybe
         ((CertificatePublicationTime, PoolId),
          PoolRegistrationCertificate))
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Maybe (CertificatePublicationTime, PoolRegistrationCertificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Maybe
     ((CertificatePublicationTime, PoolId), PoolRegistrationCertificate)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax (Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Maybe
      ((CertificatePublicationTime, PoolId),
       PoolRegistrationCertificate))
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Maybe
     ((CertificatePublicationTime, PoolId), PoolRegistrationCertificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CertificatePublicationTime, PoolId)
 -> PoolRegistrationCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (PoolId
-> (CertificatePublicationTime, PoolId)
-> PoolRegistrationCertificate
-> Bool
forall a a p. Eq a => a -> (a, a) -> p -> Bool
only PoolId
poolId) (Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
        PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
     PoolDatabase
#registrations
  where
    only :: a -> (a, a) -> p -> Bool
only a
k (a
_, a
k') p
_ = a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k'

mPutPoolRetirement
    :: CertificatePublicationTime
    -> PoolRetirementCertificate
    -> ModelOp ()
mPutPoolRetirement :: CertificatePublicationTime
-> PoolRetirementCertificate -> ModelOp ()
mPutPoolRetirement CertificatePublicationTime
cpt PoolRetirementCertificate
cert =
    ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Identity
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "retirements"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Identity
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
   -> PoolDatabase -> Identity PoolDatabase)
(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Identity
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
-> PoolDatabase -> Identity PoolDatabase
#retirements ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Map
       (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
 -> ModelOp ())
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ (CertificatePublicationTime, PoolId)
-> PoolRetirementCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (CertificatePublicationTime
cpt, PoolId
poolId) PoolRetirementCertificate
cert
  where
    PoolRetirementCertificate PoolId
poolId EpochNo
_retirementEpoch = PoolRetirementCertificate
cert

mReadPoolRetirement
    :: PoolId
    -> ModelOp
        (Maybe (CertificatePublicationTime, PoolRetirementCertificate))
mReadPoolRetirement :: PoolId
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRetirementCertificate))
mReadPoolRetirement PoolId
poolId =
    (((CertificatePublicationTime, PoolId), PoolRetirementCertificate)
 -> (CertificatePublicationTime, PoolRetirementCertificate))
-> Maybe
     ((CertificatePublicationTime, PoolId), PoolRetirementCertificate)
-> Maybe (CertificatePublicationTime, PoolRetirementCertificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CertificatePublicationTime, PoolId)
 -> CertificatePublicationTime)
-> ((CertificatePublicationTime, PoolId),
    PoolRetirementCertificate)
-> (CertificatePublicationTime, PoolRetirementCertificate)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (CertificatePublicationTime, PoolId) -> CertificatePublicationTime
forall a b. (a, b) -> a
fst) (Maybe
   ((CertificatePublicationTime, PoolId), PoolRetirementCertificate)
 -> Maybe (CertificatePublicationTime, PoolRetirementCertificate))
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Maybe
         ((CertificatePublicationTime, PoolId), PoolRetirementCertificate))
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Maybe (CertificatePublicationTime, PoolRetirementCertificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Maybe
     ((CertificatePublicationTime, PoolId), PoolRetirementCertificate)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax (Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Maybe
      ((CertificatePublicationTime, PoolId), PoolRetirementCertificate))
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Maybe
     ((CertificatePublicationTime, PoolId), PoolRetirementCertificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CertificatePublicationTime, PoolId)
 -> PoolRetirementCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (PoolId
-> (CertificatePublicationTime, PoolId)
-> PoolRetirementCertificate
-> Bool
forall a a p. Eq a => a -> (a, a) -> p -> Bool
only PoolId
poolId)
        (Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Maybe (CertificatePublicationTime, PoolRetirementCertificate))
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRetirementCertificate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "retirements"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
        PoolDatabase)
(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
     PoolDatabase
#retirements
  where
    only :: a -> (a, a) -> p -> Bool
only a
k (a
_, a
k') p
_ = a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k'

mListPoolLifeCycleData :: EpochNo -> ModelOp [PoolLifeCycleStatus]
mListPoolLifeCycleData :: EpochNo -> ModelOp [PoolLifeCycleStatus]
mListPoolLifeCycleData EpochNo
epoch = do
    [PoolId]
registeredPools <- ModelOp [PoolId]
mListRegisteredPools
    [PoolId]
retiredPools <- (PoolRetirementCertificate -> PoolId)
-> [PoolRetirementCertificate] -> [PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((PoolId -> Const PoolId PoolId)
 -> PoolRetirementCertificate
 -> Const PoolId PoolRetirementCertificate)
-> PoolRetirementCertificate -> PoolId
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "poolId"
  ((PoolId -> Const PoolId PoolId)
   -> PoolRetirementCertificate
   -> Const PoolId PoolRetirementCertificate)
(PoolId -> Const PoolId PoolId)
-> PoolRetirementCertificate
-> Const PoolId PoolRetirementCertificate
#poolId) ([PoolRetirementCertificate] -> [PoolId])
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
-> ModelOp [PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochNo
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
mListRetiredPools EpochNo
epoch
    let nonRetiredPools :: [PoolId]
nonRetiredPools = Set PoolId -> [PoolId]
forall a. Set a -> [a]
Set.toList (Set PoolId -> [PoolId]) -> Set PoolId -> [PoolId]
forall a b. (a -> b) -> a -> b
$ Set PoolId -> Set PoolId -> Set PoolId
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
            ([PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList [PoolId]
registeredPools)
            ([PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList [PoolId]
retiredPools)
    (PoolId
 -> StateT PoolDatabase (Either PoolErr) PoolLifeCycleStatus)
-> [PoolId] -> ModelOp [PoolLifeCycleStatus]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PoolId -> StateT PoolDatabase (Either PoolErr) PoolLifeCycleStatus
mReadPoolLifeCycleStatus [PoolId]
nonRetiredPools

mListRegisteredPools :: ModelOp [PoolId]
mListRegisteredPools :: ModelOp [PoolId]
mListRegisteredPools =
    Set PoolId -> [PoolId]
forall a. Set a -> [a]
Set.toList (Set PoolId -> [PoolId])
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Set PoolId)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> [PoolId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CertificatePublicationTime, PoolId) -> PoolId)
-> Set (CertificatePublicationTime, PoolId) -> Set PoolId
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (CertificatePublicationTime, PoolId) -> PoolId
forall a b. (a, b) -> b
snd (Set (CertificatePublicationTime, PoolId) -> Set PoolId)
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Set (CertificatePublicationTime, PoolId))
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Set PoolId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Set (CertificatePublicationTime, PoolId)
forall k a. Map k a -> Set k
Map.keysSet (Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> [PoolId])
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp [PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
        PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
     PoolDatabase
#registrations

mListRetiredPools :: EpochNo -> ModelOp [PoolRetirementCertificate]
mListRetiredPools :: EpochNo
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
mListRetiredPools EpochNo
epochNo = do
    Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
retirements <- (PoolRetirementCertificate -> Maybe EpochNo)
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just (EpochNo -> Maybe EpochNo)
-> (PoolRetirementCertificate -> EpochNo)
-> PoolRetirementCertificate
-> Maybe EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((EpochNo -> Const EpochNo EpochNo)
 -> PoolRetirementCertificate
 -> Const EpochNo PoolRetirementCertificate)
-> PoolRetirementCertificate -> EpochNo
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "retirementEpoch"
  ((EpochNo -> Const EpochNo EpochNo)
   -> PoolRetirementCertificate
   -> Const EpochNo PoolRetirementCertificate)
(EpochNo -> Const EpochNo EpochNo)
-> PoolRetirementCertificate
-> Const EpochNo PoolRetirementCertificate
#retirementEpoch) (Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Map (CertificatePublicationTime, PoolId) (Maybe EpochNo))
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map (CertificatePublicationTime, PoolId) (Maybe EpochNo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "retirements"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
        PoolDatabase)
(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
     PoolDatabase
#retirements
    Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
retirementCancellations <- (PoolRegistrationCertificate -> Maybe EpochNo)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe EpochNo -> PoolRegistrationCertificate -> Maybe EpochNo
forall a b. a -> b -> a
const Maybe EpochNo
forall a. Maybe a
Nothing) (Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Map (CertificatePublicationTime, PoolId) (Maybe EpochNo))
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map (CertificatePublicationTime, PoolId) (Maybe EpochNo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
        PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
     PoolDatabase
#registrations
    let retiredPools :: Map PoolId EpochNo
retiredPools =
            -- First, merge the retirements map with the cancellations map.
            -- A retirement is represented as a 'Just retirementEpoch' value.
            -- A retirement cancellation is represented as a 'Nothing' value.
            Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
-> Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
-> Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
retirements Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
retirementCancellations
            -- Keep only the most-recently published retirement epoch for each
            -- pool (which will be 'Nothing' in the case of a cancellation):
            Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
-> (Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
    -> Map PoolId (Maybe EpochNo))
-> Map PoolId (Maybe EpochNo)
forall a b. a -> (a -> b) -> b
& Map (CertificatePublicationTime, PoolId) (Maybe EpochNo)
-> Map PoolId (Maybe EpochNo)
forall k publicationTime v.
Ord k =>
Map (publicationTime, k) v -> Map k v
retainOnlyMostRecent
            -- Remove pools that have had their retirements cancelled:
            Map PoolId (Maybe EpochNo)
-> (Map PoolId (Maybe EpochNo) -> Map PoolId EpochNo)
-> Map PoolId EpochNo
forall a b. a -> (a -> b) -> b
& Map PoolId (Maybe EpochNo) -> Map PoolId EpochNo
forall k v. Map k (Maybe v) -> Map k v
pruneEmptyValues
            -- Remove pools that have not yet retired:
            Map PoolId EpochNo
-> (Map PoolId EpochNo -> Map PoolId EpochNo) -> Map PoolId EpochNo
forall a b. a -> (a -> b) -> b
& (EpochNo -> Bool) -> Map PoolId EpochNo -> Map PoolId EpochNo
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
epochNo)
    Map PoolId EpochNo
retiredPools
        Map PoolId EpochNo
-> (Map PoolId EpochNo -> [(PoolId, EpochNo)])
-> [(PoolId, EpochNo)]
forall a b. a -> (a -> b) -> b
& Map PoolId EpochNo -> [(PoolId, EpochNo)]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(PoolId, EpochNo)]
-> ([(PoolId, EpochNo)] -> [PoolRetirementCertificate])
-> [PoolRetirementCertificate]
forall a b. a -> (a -> b) -> b
& ((PoolId, EpochNo) -> PoolRetirementCertificate)
-> [(PoolId, EpochNo)] -> [PoolRetirementCertificate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PoolId -> EpochNo -> PoolRetirementCertificate)
-> (PoolId, EpochNo) -> PoolRetirementCertificate
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PoolId -> EpochNo -> PoolRetirementCertificate
PoolRetirementCertificate)
        [PoolRetirementCertificate]
-> ([PoolRetirementCertificate]
    -> StateT
         PoolDatabase (Either PoolErr) [PoolRetirementCertificate])
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
forall a b. a -> (a -> b) -> b
& [PoolRetirementCertificate]
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    pruneEmptyValues :: Map k (Maybe v) -> Map k v
    pruneEmptyValues :: Map k (Maybe v) -> Map k v
pruneEmptyValues = (Maybe v -> Maybe v) -> Map k (Maybe v) -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe v -> Maybe v
forall a. a -> a
id

    retainOnlyMostRecent :: Ord k => Map (publicationTime, k) v -> Map k v
    retainOnlyMostRecent :: Map (publicationTime, k) v -> Map k v
retainOnlyMostRecent =
        -- If more than one key from the original map is mapped to the same key
        -- in the result map, 'Map.mapKeys' guarantees to retain only the value
        -- corresponding to the greatest of the original keys.
        ((publicationTime, k) -> k)
-> Map (publicationTime, k) v -> Map k v
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (publicationTime, k) -> k
forall a b. (a, b) -> b
snd

mReadPoolLifeCycleStatus :: PoolId -> ModelOp PoolLifeCycleStatus
mReadPoolLifeCycleStatus :: PoolId -> StateT PoolDatabase (Either PoolErr) PoolLifeCycleStatus
mReadPoolLifeCycleStatus PoolId
poolId =
    Maybe (CertificatePublicationTime, PoolRegistrationCertificate)
-> Maybe (CertificatePublicationTime, PoolRetirementCertificate)
-> PoolLifeCycleStatus
forall publicationTime.
(Ord publicationTime, Show publicationTime) =>
Maybe (publicationTime, PoolRegistrationCertificate)
-> Maybe (publicationTime, PoolRetirementCertificate)
-> PoolLifeCycleStatus
determinePoolLifeCycleStatus
        (Maybe (CertificatePublicationTime, PoolRegistrationCertificate)
 -> Maybe (CertificatePublicationTime, PoolRetirementCertificate)
 -> PoolLifeCycleStatus)
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Maybe (CertificatePublicationTime, PoolRetirementCertificate)
      -> PoolLifeCycleStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Maybe (CertificatePublicationTime, PoolRegistrationCertificate)
forall publicationTime certificate.
Map (publicationTime, PoolId) certificate
-> Maybe (publicationTime, certificate)
lookupLatestCertificate (Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRegistrationCertificate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
        PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
     PoolDatabase
#registrations)
        StateT
  PoolDatabase
  (Either PoolErr)
  (Maybe (CertificatePublicationTime, PoolRetirementCertificate)
   -> PoolLifeCycleStatus)
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRetirementCertificate))
-> StateT PoolDatabase (Either PoolErr) PoolLifeCycleStatus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Maybe (CertificatePublicationTime, PoolRetirementCertificate)
forall publicationTime certificate.
Map (publicationTime, PoolId) certificate
-> Maybe (publicationTime, certificate)
lookupLatestCertificate (Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Maybe (CertificatePublicationTime, PoolRetirementCertificate))
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp
     (Maybe (CertificatePublicationTime, PoolRetirementCertificate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "retirements"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
        PoolDatabase)
(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
     PoolDatabase
#retirements)
  where
    lookupLatestCertificate
        :: Map (publicationTime, PoolId) certificate
        -> Maybe (publicationTime, certificate)
    lookupLatestCertificate :: Map (publicationTime, PoolId) certificate
-> Maybe (publicationTime, certificate)
lookupLatestCertificate
        = (((publicationTime, PoolId), certificate)
 -> (publicationTime, certificate))
-> Maybe ((publicationTime, PoolId), certificate)
-> Maybe (publicationTime, certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((publicationTime, PoolId) -> publicationTime)
-> ((publicationTime, PoolId), certificate)
-> (publicationTime, certificate)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (publicationTime, PoolId) -> publicationTime
forall a b. (a, b) -> a
fst)
        (Maybe ((publicationTime, PoolId), certificate)
 -> Maybe (publicationTime, certificate))
-> (Map (publicationTime, PoolId) certificate
    -> Maybe ((publicationTime, PoolId), certificate))
-> Map (publicationTime, PoolId) certificate
-> Maybe (publicationTime, certificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (publicationTime, PoolId) certificate
-> Maybe ((publicationTime, PoolId), certificate)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax
        (Map (publicationTime, PoolId) certificate
 -> Maybe ((publicationTime, PoolId), certificate))
-> (Map (publicationTime, PoolId) certificate
    -> Map (publicationTime, PoolId) certificate)
-> Map (publicationTime, PoolId) certificate
-> Maybe ((publicationTime, PoolId), certificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((publicationTime, PoolId) -> certificate -> Bool)
-> Map (publicationTime, PoolId) certificate
-> Map (publicationTime, PoolId) certificate
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(publicationTime
_, PoolId
k) certificate
_ -> PoolId
k PoolId -> PoolId -> Bool
forall a. Eq a => a -> a -> Bool
== PoolId
poolId)

mUnfetchedPoolMetadataRefs
    :: Int
    -> ModelOp [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)]
mUnfetchedPoolMetadataRefs :: Int
-> ModelOp [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)]
mUnfetchedPoolMetadataRefs Int
n = Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map StakePoolMetadataHash StakePoolMetadata
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
-> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)]
inner
    (Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Map StakePoolMetadataHash StakePoolMetadata
 -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
 -> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)])
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map StakePoolMetadataHash StakePoolMetadata
      -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
      -> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Const
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Const
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase
   -> Const
        (Map
           (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
        PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Const
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase
-> Const
     (Map
        (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
     PoolDatabase
#registrations
    StateT
  PoolDatabase
  (Either PoolErr)
  (Map StakePoolMetadataHash StakePoolMetadata
   -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
   -> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)])
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map StakePoolMetadataHash StakePoolMetadata)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
      -> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Map StakePoolMetadataHash StakePoolMetadata
  -> Const
       (Map StakePoolMetadataHash StakePoolMetadata)
       (Map StakePoolMetadataHash StakePoolMetadata))
 -> PoolDatabase
 -> Const
      (Map StakePoolMetadataHash StakePoolMetadata) PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map StakePoolMetadataHash StakePoolMetadata)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "metadata"
  ((Map StakePoolMetadataHash StakePoolMetadata
    -> Const
         (Map StakePoolMetadataHash StakePoolMetadata)
         (Map StakePoolMetadataHash StakePoolMetadata))
   -> PoolDatabase
   -> Const
        (Map StakePoolMetadataHash StakePoolMetadata) PoolDatabase)
(Map StakePoolMetadataHash StakePoolMetadata
 -> Const
      (Map StakePoolMetadataHash StakePoolMetadata)
      (Map StakePoolMetadataHash StakePoolMetadata))
-> PoolDatabase
-> Const (Map StakePoolMetadataHash StakePoolMetadata) PoolDatabase
#metadata
    StateT
  PoolDatabase
  (Either PoolErr)
  (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
   -> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)])
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
-> ModelOp [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
  -> Const
       (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
       (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
 -> PoolDatabase
 -> Const
      (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
      PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "fetchAttempts"
  ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
    -> Const
         (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
         (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
   -> PoolDatabase
   -> Const
        (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
        PoolDatabase)
(Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
 -> Const
      (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
      (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
-> PoolDatabase
-> Const
     (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
     PoolDatabase
#fetchAttempts
  where
    inner :: Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map StakePoolMetadataHash StakePoolMetadata
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
-> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)]
inner Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
registrations Map StakePoolMetadataHash StakePoolMetadata
metadata Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
fetchAttempts =
        PoolRegistrationCertificate
-> (PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)
toTuple (PoolRegistrationCertificate
 -> (PoolId, StakePoolMetadataUrl, StakePoolMetadataHash))
-> [PoolRegistrationCertificate]
-> [(PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [PoolRegistrationCertificate] -> [PoolRegistrationCertificate]
forall a. Int -> [a] -> [a]
take Int
n (Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> [PoolRegistrationCertificate]
forall k a. Map k a -> [a]
Map.elems Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
unfetched)
      where
        unfetched :: Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
unfetched = ((PoolRegistrationCertificate -> Bool)
 -> Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> (PoolRegistrationCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PoolRegistrationCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Map
  (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
registrations ((PoolRegistrationCertificate -> Bool)
 -> Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> (PoolRegistrationCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall a b. (a -> b) -> a -> b
$ \PoolRegistrationCertificate
r ->
            case PoolRegistrationCertificate
-> Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
poolMetadata PoolRegistrationCertificate
r of
                Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
Nothing -> Bool
False
                Just fkey :: (StakePoolMetadataUrl, StakePoolMetadataHash)
fkey@(StakePoolMetadataUrl
_, StakePoolMetadataHash
hash) -> Bool -> Bool -> Bool
(&&)
                    (StakePoolMetadataHash
hash StakePoolMetadataHash -> [StakePoolMetadataHash] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Map StakePoolMetadataHash StakePoolMetadata
-> [StakePoolMetadataHash]
forall k a. Map k a -> [k]
Map.keys Map StakePoolMetadataHash StakePoolMetadata
metadata)
                    ((StakePoolMetadataUrl, StakePoolMetadataHash)
fkey (StakePoolMetadataUrl, StakePoolMetadataHash)
-> [(StakePoolMetadataUrl, StakePoolMetadataHash)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
-> [(StakePoolMetadataUrl, StakePoolMetadataHash)]
forall k a. Map k a -> [k]
Map.keys Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
fetchAttempts)
        toTuple :: PoolRegistrationCertificate
-> (PoolId, StakePoolMetadataUrl, StakePoolMetadataHash)
toTuple PoolRegistrationCertificate{PoolId
poolId :: PoolId
$sel:poolId:PoolRegistrationCertificate :: PoolRegistrationCertificate -> PoolId
poolId,Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
poolMetadata :: Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
$sel:poolMetadata:PoolRegistrationCertificate :: PoolRegistrationCertificate
-> Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
poolMetadata} =
            (PoolId
poolId, StakePoolMetadataUrl
metadataUrl, StakePoolMetadataHash
metadataHash)
          where
            Just (StakePoolMetadataUrl
metadataUrl, StakePoolMetadataHash
metadataHash) = Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
poolMetadata

mPutFetchAttempt
    :: (StakePoolMetadataUrl, StakePoolMetadataHash)
    -> ModelOp ()
mPutFetchAttempt :: (StakePoolMetadataUrl, StakePoolMetadataHash) -> ModelOp ()
mPutFetchAttempt (StakePoolMetadataUrl, StakePoolMetadataHash)
key =
    ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
  -> Identity
       (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
    -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "fetchAttempts"
  ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
    -> Identity
         (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
   -> PoolDatabase -> Identity PoolDatabase)
(Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
 -> Identity
      (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
-> PoolDatabase -> Identity PoolDatabase
#fetchAttempts ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
  -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
 -> ModelOp ())
-> (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
    -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> (StakePoolMetadataUrl, StakePoolMetadataHash)
-> Int
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (StakePoolMetadataUrl, StakePoolMetadataHash)
key Int
1

mPutPoolMetadata
    :: StakePoolMetadataHash
    -> StakePoolMetadata
    -> ModelOp ()
mPutPoolMetadata :: StakePoolMetadataHash -> StakePoolMetadata -> ModelOp ()
mPutPoolMetadata StakePoolMetadataHash
hash StakePoolMetadata
meta = do
    ((Map StakePoolMetadataHash StakePoolMetadata
  -> Identity (Map StakePoolMetadataHash StakePoolMetadata))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map StakePoolMetadataHash StakePoolMetadata
    -> Map StakePoolMetadataHash StakePoolMetadata)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "metadata"
  ((Map StakePoolMetadataHash StakePoolMetadata
    -> Identity (Map StakePoolMetadataHash StakePoolMetadata))
   -> PoolDatabase -> Identity PoolDatabase)
(Map StakePoolMetadataHash StakePoolMetadata
 -> Identity (Map StakePoolMetadataHash StakePoolMetadata))
-> PoolDatabase -> Identity PoolDatabase
#metadata
        ((Map StakePoolMetadataHash StakePoolMetadata
  -> Map StakePoolMetadataHash StakePoolMetadata)
 -> ModelOp ())
-> (Map StakePoolMetadataHash StakePoolMetadata
    -> Map StakePoolMetadataHash StakePoolMetadata)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ StakePoolMetadataHash
-> StakePoolMetadata
-> Map StakePoolMetadataHash StakePoolMetadata
-> Map StakePoolMetadataHash StakePoolMetadata
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert StakePoolMetadataHash
hash StakePoolMetadata
meta
    ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
  -> Identity
       (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
    -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "fetchAttempts"
  ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
    -> Identity
         (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
   -> PoolDatabase -> Identity PoolDatabase)
(Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
 -> Identity
      (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int))
-> PoolDatabase -> Identity PoolDatabase
#fetchAttempts
        ((Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
  -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
 -> ModelOp ())
-> (Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
    -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ ((StakePoolMetadataUrl, StakePoolMetadataHash) -> Int -> Bool)
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (((StakePoolMetadataUrl, StakePoolMetadataHash) -> Int -> Bool)
 -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
 -> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int)
-> ((StakePoolMetadataUrl, StakePoolMetadataHash) -> Int -> Bool)
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
-> Map (StakePoolMetadataUrl, StakePoolMetadataHash) Int
forall a b. (a -> b) -> a -> b
$ \(StakePoolMetadataUrl, StakePoolMetadataHash)
k Int
_ -> (StakePoolMetadataUrl, StakePoolMetadataHash)
-> StakePoolMetadataHash
forall a b. (a, b) -> b
snd (StakePoolMetadataUrl, StakePoolMetadataHash)
k StakePoolMetadataHash -> StakePoolMetadataHash -> Bool
forall a. Eq a => a -> a -> Bool
/= StakePoolMetadataHash
hash

mReadPoolMetadata
    :: ModelOp (Map StakePoolMetadataHash StakePoolMetadata)
mReadPoolMetadata :: StateT
  PoolDatabase
  (Either PoolErr)
  (Map StakePoolMetadataHash StakePoolMetadata)
mReadPoolMetadata = ((Map StakePoolMetadataHash StakePoolMetadata
  -> Const
       (Map StakePoolMetadataHash StakePoolMetadata)
       (Map StakePoolMetadataHash StakePoolMetadata))
 -> PoolDatabase
 -> Const
      (Map StakePoolMetadataHash StakePoolMetadata) PoolDatabase)
-> StateT
     PoolDatabase
     (Either PoolErr)
     (Map StakePoolMetadataHash StakePoolMetadata)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "metadata"
  ((Map StakePoolMetadataHash StakePoolMetadata
    -> Const
         (Map StakePoolMetadataHash StakePoolMetadata)
         (Map StakePoolMetadataHash StakePoolMetadata))
   -> PoolDatabase
   -> Const
        (Map StakePoolMetadataHash StakePoolMetadata) PoolDatabase)
(Map StakePoolMetadataHash StakePoolMetadata
 -> Const
      (Map StakePoolMetadataHash StakePoolMetadata)
      (Map StakePoolMetadataHash StakePoolMetadata))
-> PoolDatabase
-> Const (Map StakePoolMetadataHash StakePoolMetadata) PoolDatabase
#metadata

mReadSystemSeed
    :: PoolDatabase
    -> IO (StdGen, PoolDatabase)
mReadSystemSeed :: PoolDatabase -> IO (StdGen, PoolDatabase)
mReadSystemSeed db :: PoolDatabase
db@PoolDatabase{SystemSeed
seed :: SystemSeed
$sel:seed:PoolDatabase :: PoolDatabase -> SystemSeed
seed} =
    case SystemSeed
seed of
        SystemSeed
NotSeededYet -> do
            StdGen
seed' <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
            (StdGen, PoolDatabase) -> IO (StdGen, PoolDatabase)
forall (m :: * -> *) a. Monad m => a -> m a
return ( StdGen
seed', PoolDatabase
db { $sel:seed:PoolDatabase :: SystemSeed
seed = StdGen -> SystemSeed
SystemSeed StdGen
seed' })
        SystemSeed StdGen
s ->
            (StdGen, PoolDatabase) -> IO (StdGen, PoolDatabase)
forall (m :: * -> *) a. Monad m => a -> m a
return ( StdGen
s, PoolDatabase
db )

mReadCursor :: Int -> ModelOp [BlockHeader]
mReadCursor :: Int -> ModelOp [BlockHeader]
mReadCursor Int
k = do
    [BlockHeader]
allHeaders <- Map PoolId [BlockHeader] -> [BlockHeader]
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map PoolId [BlockHeader] -> [BlockHeader])
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
-> ModelOp [BlockHeader]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Map PoolId [BlockHeader]
  -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
 -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
-> StateT PoolDatabase (Either PoolErr) (Map PoolId [BlockHeader])
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "pools"
  ((Map PoolId [BlockHeader]
    -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
   -> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase)
(Map PoolId [BlockHeader]
 -> Const (Map PoolId [BlockHeader]) (Map PoolId [BlockHeader]))
-> PoolDatabase -> Const (Map PoolId [BlockHeader]) PoolDatabase
#pools
    [BlockHeader] -> ModelOp [BlockHeader]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BlockHeader] -> ModelOp [BlockHeader])
-> [BlockHeader] -> ModelOp [BlockHeader]
forall a b. (a -> b) -> a -> b
$ [BlockHeader] -> [BlockHeader]
forall a. [a] -> [a]
reverse ([BlockHeader] -> [BlockHeader]) -> [BlockHeader] -> [BlockHeader]
forall a b. (a -> b) -> a -> b
$ [BlockHeader] -> [BlockHeader]
limit ([BlockHeader] -> [BlockHeader]) -> [BlockHeader] -> [BlockHeader]
forall a b. (a -> b) -> a -> b
$ [BlockHeader] -> [BlockHeader]
sortDesc [BlockHeader]
allHeaders
  where
    sortDesc :: [BlockHeader] -> [BlockHeader]
sortDesc = (BlockHeader -> Down SlotNo) -> [BlockHeader] -> [BlockHeader]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (SlotNo -> Down SlotNo
forall a. a -> Down a
Down (SlotNo -> Down SlotNo)
-> (BlockHeader -> SlotNo) -> BlockHeader -> Down SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> SlotNo
slotNo)
    limit :: [BlockHeader] -> [BlockHeader]
limit = Int -> [BlockHeader] -> [BlockHeader]
forall a. Int -> [a] -> [a]
take Int
k

mRollbackTo :: TimeInterpreter Identity -> SlotNo -> ModelOp ()
mRollbackTo :: TimeInterpreter Identity -> SlotNo -> ModelOp ()
mRollbackTo TimeInterpreter Identity
ti SlotNo
point = do
    ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
  -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "distributions"
  ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
 -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
-> PoolDatabase -> Identity PoolDatabase
#distributions
        ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
  -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
 -> ModelOp ())
-> (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ (EpochNo
 -> [(PoolId, Quantity "lovelace" Word64)]
 -> Maybe [(PoolId, Quantity "lovelace" Word64)])
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey ((EpochNo
  -> [(PoolId, Quantity "lovelace" Word64)]
  -> Maybe [(PoolId, Quantity "lovelace" Word64)])
 -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
 -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> (EpochNo
    -> [(PoolId, Quantity "lovelace" Word64)]
    -> Maybe [(PoolId, Quantity "lovelace" Word64)])
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
forall a b. (a -> b) -> a -> b
$ (SlotNo -> EpochNo)
-> EpochNo
-> [(PoolId, Quantity "lovelace" Word64)]
-> Maybe [(PoolId, Quantity "lovelace" Word64)]
forall point a.
Ord point =>
(SlotNo -> point) -> point -> a -> Maybe a
discardBy ((SlotNo -> EpochNo)
 -> EpochNo
 -> [(PoolId, Quantity "lovelace" Word64)]
 -> Maybe [(PoolId, Quantity "lovelace" Word64)])
-> (SlotNo -> EpochNo)
-> EpochNo
-> [(PoolId, Quantity "lovelace" Word64)]
-> Maybe [(PoolId, Quantity "lovelace" Word64)]
forall a b. (a -> b) -> a -> b
$ 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
    ((Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "pools"
  ((Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
-> PoolDatabase -> Identity PoolDatabase
#pools
        ((Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
 -> ModelOp ())
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ ([BlockHeader] -> Bool)
-> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> ([BlockHeader] -> Bool) -> [BlockHeader] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeader] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null) (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> Map PoolId [BlockHeader]
-> Map PoolId [BlockHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BlockHeader] -> [BlockHeader])
-> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BlockHeader -> Bool) -> [BlockHeader] -> [BlockHeader]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
point) (SlotNo -> Bool) -> (BlockHeader -> SlotNo) -> BlockHeader -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> SlotNo
slotNo))
    ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Identity
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Identity
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase -> Identity PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Identity
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase -> Identity PoolDatabase
#registrations
        ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Map
       (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
 -> ModelOp ())
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ ((CertificatePublicationTime, PoolId)
 -> PoolRegistrationCertificate
 -> Maybe PoolRegistrationCertificate)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey (((CertificatePublicationTime, PoolId)
  -> PoolRegistrationCertificate
  -> Maybe PoolRegistrationCertificate)
 -> Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ((CertificatePublicationTime, PoolId)
    -> PoolRegistrationCertificate
    -> Maybe PoolRegistrationCertificate)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall a b. (a -> b) -> a -> b
$ (SlotNo -> SlotNo)
-> SlotNo
-> PoolRegistrationCertificate
-> Maybe PoolRegistrationCertificate
forall point a.
Ord point =>
(SlotNo -> point) -> point -> a -> Maybe a
discardBy SlotNo -> SlotNo
forall a. a -> a
id (SlotNo
 -> PoolRegistrationCertificate
 -> Maybe PoolRegistrationCertificate)
-> ((CertificatePublicationTime, PoolId) -> SlotNo)
-> (CertificatePublicationTime, PoolId)
-> PoolRegistrationCertificate
-> Maybe PoolRegistrationCertificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SlotNo -> Const SlotNo SlotNo)
 -> CertificatePublicationTime
 -> Const SlotNo CertificatePublicationTime)
-> CertificatePublicationTime -> SlotNo
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo)
   -> CertificatePublicationTime
   -> Const SlotNo CertificatePublicationTime)
(SlotNo -> Const SlotNo SlotNo)
-> CertificatePublicationTime
-> Const SlotNo CertificatePublicationTime
#slotNo (CertificatePublicationTime -> SlotNo)
-> ((CertificatePublicationTime, PoolId)
    -> CertificatePublicationTime)
-> (CertificatePublicationTime, PoolId)
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertificatePublicationTime, PoolId) -> CertificatePublicationTime
forall a b. (a, b) -> a
fst
    ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Identity
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "retirements"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Identity
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
   -> PoolDatabase -> Identity PoolDatabase)
(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Identity
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
-> PoolDatabase -> Identity PoolDatabase
#retirements
        ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Map
       (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
 -> ModelOp ())
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ ((CertificatePublicationTime, PoolId)
 -> PoolRetirementCertificate -> Maybe PoolRetirementCertificate)
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey (((CertificatePublicationTime, PoolId)
  -> PoolRetirementCertificate -> Maybe PoolRetirementCertificate)
 -> Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ((CertificatePublicationTime, PoolId)
    -> PoolRetirementCertificate -> Maybe PoolRetirementCertificate)
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
forall a b. (a -> b) -> a -> b
$ (SlotNo -> SlotNo)
-> SlotNo
-> PoolRetirementCertificate
-> Maybe PoolRetirementCertificate
forall point a.
Ord point =>
(SlotNo -> point) -> point -> a -> Maybe a
discardBy SlotNo -> SlotNo
forall a. a -> a
id (SlotNo
 -> PoolRetirementCertificate -> Maybe PoolRetirementCertificate)
-> ((CertificatePublicationTime, PoolId) -> SlotNo)
-> (CertificatePublicationTime, PoolId)
-> PoolRetirementCertificate
-> Maybe PoolRetirementCertificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SlotNo -> Const SlotNo SlotNo)
 -> CertificatePublicationTime
 -> Const SlotNo CertificatePublicationTime)
-> CertificatePublicationTime -> SlotNo
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo)
   -> CertificatePublicationTime
   -> Const SlotNo CertificatePublicationTime)
(SlotNo -> Const SlotNo SlotNo)
-> CertificatePublicationTime
-> Const SlotNo CertificatePublicationTime
#slotNo (CertificatePublicationTime -> SlotNo)
-> ((CertificatePublicationTime, PoolId)
    -> CertificatePublicationTime)
-> (CertificatePublicationTime, PoolId)
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertificatePublicationTime, PoolId) -> CertificatePublicationTime
forall a b. (a, b) -> a
fst
    ((Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "owners"
  ((Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
-> PoolDatabase -> Identity PoolDatabase
#owners
        ((Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ())
-> ([PoolId] -> Map PoolId [PoolOwner] -> Map PoolId [PoolOwner])
-> [PoolId]
-> ModelOp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map PoolId [PoolOwner] -> Set PoolId -> Map PoolId [PoolOwner])
-> Set PoolId -> Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map PoolId [PoolOwner] -> Set PoolId -> Map PoolId [PoolOwner]
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (Set PoolId -> Map PoolId [PoolOwner] -> Map PoolId [PoolOwner])
-> ([PoolId] -> Set PoolId)
-> [PoolId]
-> Map PoolId [PoolOwner]
-> Map PoolId [PoolOwner]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList ([PoolId] -> ModelOp ()) -> ModelOp [PoolId] -> ModelOp ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ModelOp [PoolId]
mListRegisteredPools
  where
    discardBy :: Ord point => (SlotNo -> point) -> point -> a -> Maybe a
    discardBy :: (SlotNo -> point) -> point -> a -> Maybe a
discardBy SlotNo -> point
getPoint point
point' a
v
        | point
point' point -> point -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo -> point
getPoint SlotNo
point = a -> Maybe a
forall a. a -> Maybe a
Just a
v
        | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

mPutDelistedPools :: [PoolId] -> ModelOp ()
mPutDelistedPools :: [PoolId] -> ModelOp ()
mPutDelistedPools = ((Set PoolId -> Identity (Set PoolId))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Set PoolId -> Set PoolId) -> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "delisted"
  ((Set PoolId -> Identity (Set PoolId))
   -> PoolDatabase -> Identity PoolDatabase)
(Set PoolId -> Identity (Set PoolId))
-> PoolDatabase -> Identity PoolDatabase
#delisted ((Set PoolId -> Set PoolId) -> ModelOp ())
-> ([PoolId] -> Set PoolId -> Set PoolId) -> [PoolId] -> ModelOp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PoolId -> Set PoolId -> Set PoolId
forall a b. a -> b -> a
const (Set PoolId -> Set PoolId -> Set PoolId)
-> ([PoolId] -> Set PoolId) -> [PoolId] -> Set PoolId -> Set PoolId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList

mReadDelistedPools :: ModelOp [PoolId]
mReadDelistedPools :: ModelOp [PoolId]
mReadDelistedPools = Set PoolId -> [PoolId]
forall a. Set a -> [a]
Set.toList (Set PoolId -> [PoolId])
-> StateT PoolDatabase (Either PoolErr) (Set PoolId)
-> ModelOp [PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Set PoolId -> Const (Set PoolId) (Set PoolId))
 -> PoolDatabase -> Const (Set PoolId) PoolDatabase)
-> StateT PoolDatabase (Either PoolErr) (Set PoolId)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "delisted"
  ((Set PoolId -> Const (Set PoolId) (Set PoolId))
   -> PoolDatabase -> Const (Set PoolId) PoolDatabase)
(Set PoolId -> Const (Set PoolId) (Set PoolId))
-> PoolDatabase -> Const (Set PoolId) PoolDatabase
#delisted

mRemovePools :: [PoolId] -> ModelOp ()
mRemovePools :: [PoolId] -> ModelOp ()
mRemovePools [PoolId]
poolsToRemove = do
    ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
  -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "distributions"
  ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
 -> Identity (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]))
-> PoolDatabase -> Identity PoolDatabase
#distributions
        ((Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
  -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
 -> ModelOp ())
-> (Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
    -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ ([(PoolId, Quantity "lovelace" Word64)]
 -> [(PoolId, Quantity "lovelace" Word64)])
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([(PoolId, Quantity "lovelace" Word64)]
  -> [(PoolId, Quantity "lovelace" Word64)])
 -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
 -> Map EpochNo [(PoolId, Quantity "lovelace" Word64)])
-> ([(PoolId, Quantity "lovelace" Word64)]
    -> [(PoolId, Quantity "lovelace" Word64)])
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
-> Map EpochNo [(PoolId, Quantity "lovelace" Word64)]
forall a b. (a -> b) -> a -> b
$ ((PoolId, Quantity "lovelace" Word64) -> Bool)
-> [(PoolId, Quantity "lovelace" Word64)]
-> [(PoolId, Quantity "lovelace" Word64)]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (((PoolId, Quantity "lovelace" Word64) -> Bool)
 -> [(PoolId, Quantity "lovelace" Word64)]
 -> [(PoolId, Quantity "lovelace" Word64)])
-> ((PoolId, Quantity "lovelace" Word64) -> Bool)
-> [(PoolId, Quantity "lovelace" Word64)]
-> [(PoolId, Quantity "lovelace" Word64)]
forall a b. (a -> b) -> a -> b
$ \(PoolId
p, Quantity "lovelace" Word64
_) -> PoolId -> Bool
retain PoolId
p
    ((Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "pools"
  ((Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map PoolId [BlockHeader] -> Identity (Map PoolId [BlockHeader]))
-> PoolDatabase -> Identity PoolDatabase
#pools
        ((Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
 -> ModelOp ())
-> (Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ (PoolId -> [BlockHeader] -> Bool)
-> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader]
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey ((PoolId -> [BlockHeader] -> Bool)
 -> Map PoolId [BlockHeader] -> Map PoolId [BlockHeader])
-> (PoolId -> [BlockHeader] -> Bool)
-> Map PoolId [BlockHeader]
-> Map PoolId [BlockHeader]
forall a b. (a -> b) -> a -> b
$ \PoolId
p [BlockHeader]
_ -> PoolId -> Bool
retain PoolId
p
    ((Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "owners"
  ((Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
   -> PoolDatabase -> Identity PoolDatabase)
(Map PoolId [PoolOwner] -> Identity (Map PoolId [PoolOwner]))
-> PoolDatabase -> Identity PoolDatabase
#owners
        ((Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ())
-> (Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]) -> ModelOp ()
forall a b. (a -> b) -> a -> b
$ (PoolId -> [PoolOwner] -> Bool)
-> Map PoolId [PoolOwner] -> Map PoolId [PoolOwner]
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey ((PoolId -> [PoolOwner] -> Bool)
 -> Map PoolId [PoolOwner] -> Map PoolId [PoolOwner])
-> (PoolId -> [PoolOwner] -> Bool)
-> Map PoolId [PoolOwner]
-> Map PoolId [PoolOwner]
forall a b. (a -> b) -> a -> b
$ \PoolId
p [PoolOwner]
_ -> PoolId -> Bool
retain PoolId
p
    ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Identity
       (Map
          (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "registrations"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Identity
         (Map
            (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
   -> PoolDatabase -> Identity PoolDatabase)
(Map
   (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Identity
      (Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate))
-> PoolDatabase -> Identity PoolDatabase
#registrations
        ((Map
    (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
  -> Map
       (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
 -> ModelOp ())
-> (Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ ((CertificatePublicationTime, PoolId)
 -> PoolRegistrationCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (((CertificatePublicationTime, PoolId)
  -> PoolRegistrationCertificate -> Bool)
 -> Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
 -> Map
      (CertificatePublicationTime, PoolId) PoolRegistrationCertificate)
-> ((CertificatePublicationTime, PoolId)
    -> PoolRegistrationCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRegistrationCertificate
forall a b. (a -> b) -> a -> b
$ \(CertificatePublicationTime
_, PoolId
p) PoolRegistrationCertificate
_ -> PoolId -> Bool
retain PoolId
p
    ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Identity
       (Map
          (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "retirements"
  ((Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Identity
         (Map
            (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
   -> PoolDatabase -> Identity PoolDatabase)
(Map (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Identity
      (Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate))
-> PoolDatabase -> Identity PoolDatabase
#retirements
        ((Map
    (CertificatePublicationTime, PoolId) PoolRetirementCertificate
  -> Map
       (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
 -> ModelOp ())
-> (Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
    -> Map
         (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ModelOp ()
forall a b. (a -> b) -> a -> b
$ ((CertificatePublicationTime, PoolId)
 -> PoolRetirementCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (((CertificatePublicationTime, PoolId)
  -> PoolRetirementCertificate -> Bool)
 -> Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate
 -> Map
      (CertificatePublicationTime, PoolId) PoolRetirementCertificate)
-> ((CertificatePublicationTime, PoolId)
    -> PoolRetirementCertificate -> Bool)
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
-> Map
     (CertificatePublicationTime, PoolId) PoolRetirementCertificate
forall a b. (a -> b) -> a -> b
$ \(CertificatePublicationTime
_, PoolId
p) PoolRetirementCertificate
_ -> PoolId -> Bool
retain PoolId
p
  where
    retain :: PoolId -> Bool
retain PoolId
p = PoolId
p PoolId -> Set PoolId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set PoolId
poolsToRemoveSet
    poolsToRemoveSet :: Set PoolId
poolsToRemoveSet = [PoolId] -> Set PoolId
forall a. Ord a => [a] -> Set a
Set.fromList [PoolId]
poolsToRemove

mRemoveRetiredPools :: EpochNo -> ModelOp [PoolRetirementCertificate]
mRemoveRetiredPools :: EpochNo
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
mRemoveRetiredPools EpochNo
epoch = do
    [PoolRetirementCertificate]
certificates <- EpochNo
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
mListRetiredPools EpochNo
epoch
    [PoolId] -> ModelOp ()
mRemovePools (((PoolId -> Const PoolId PoolId)
 -> PoolRetirementCertificate
 -> Const PoolId PoolRetirementCertificate)
-> PoolRetirementCertificate -> PoolId
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "poolId"
  ((PoolId -> Const PoolId PoolId)
   -> PoolRetirementCertificate
   -> Const PoolId PoolRetirementCertificate)
(PoolId -> Const PoolId PoolId)
-> PoolRetirementCertificate
-> Const PoolId PoolRetirementCertificate
#poolId (PoolRetirementCertificate -> PoolId)
-> [PoolRetirementCertificate] -> [PoolId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PoolRetirementCertificate]
certificates)
    [PoolRetirementCertificate]
-> StateT PoolDatabase (Either PoolErr) [PoolRetirementCertificate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [PoolRetirementCertificate]
certificates

mPutHeader :: BlockHeader -> ModelOp ()
mPutHeader :: BlockHeader -> ModelOp ()
mPutHeader BlockHeader
header = (([BlockHeader] -> Identity [BlockHeader])
 -> PoolDatabase -> Identity PoolDatabase)
-> ([BlockHeader] -> [BlockHeader]) -> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "blockHeaders"
  (([BlockHeader] -> Identity [BlockHeader])
   -> PoolDatabase -> Identity PoolDatabase)
([BlockHeader] -> Identity [BlockHeader])
-> PoolDatabase -> Identity PoolDatabase
#blockHeaders (BlockHeader
header BlockHeader -> [BlockHeader] -> [BlockHeader]
forall a. a -> [a] -> [a]
:)

mListHeaders :: Int -> ModelOp [BlockHeader]
mListHeaders :: Int -> ModelOp [BlockHeader]
mListHeaders Int
k
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = [BlockHeader] -> [BlockHeader]
forall a. [a] -> [a]
reverse ([BlockHeader] -> [BlockHeader])
-> ([BlockHeader] -> [BlockHeader])
-> [BlockHeader]
-> [BlockHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [BlockHeader] -> [BlockHeader]
forall a. Int -> [a] -> [a]
take Int
k ([BlockHeader] -> [BlockHeader])
-> ModelOp [BlockHeader] -> ModelOp [BlockHeader]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([BlockHeader] -> Const [BlockHeader] [BlockHeader])
 -> PoolDatabase -> Const [BlockHeader] PoolDatabase)
-> ModelOp [BlockHeader]
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "blockHeaders"
  (([BlockHeader] -> Const [BlockHeader] [BlockHeader])
   -> PoolDatabase -> Const [BlockHeader] PoolDatabase)
([BlockHeader] -> Const [BlockHeader] [BlockHeader])
-> PoolDatabase -> Const [BlockHeader] PoolDatabase
#blockHeaders
    | Bool
otherwise = [BlockHeader] -> [BlockHeader]
forall a. [a] -> [a]
reverse ([BlockHeader] -> [BlockHeader])
-> ModelOp [BlockHeader] -> ModelOp [BlockHeader]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([BlockHeader] -> Const [BlockHeader] [BlockHeader])
 -> PoolDatabase -> Const [BlockHeader] PoolDatabase)
-> ModelOp [BlockHeader]
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "blockHeaders"
  (([BlockHeader] -> Const [BlockHeader] [BlockHeader])
   -> PoolDatabase -> Const [BlockHeader] PoolDatabase)
([BlockHeader] -> Const [BlockHeader] [BlockHeader])
-> PoolDatabase -> Const [BlockHeader] PoolDatabase
#blockHeaders

mReadSettings
    :: ModelOp Settings
mReadSettings :: ModelOp Settings
mReadSettings = ((Settings -> Const Settings Settings)
 -> PoolDatabase -> Const Settings PoolDatabase)
-> ModelOp Settings
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get IsLabel
  "settings"
  ((Settings -> Const Settings Settings)
   -> PoolDatabase -> Const Settings PoolDatabase)
(Settings -> Const Settings Settings)
-> PoolDatabase -> Const Settings PoolDatabase
#settings

mPutSettings
    :: Settings
    -> ModelOp ()
mPutSettings :: Settings -> ModelOp ()
mPutSettings Settings
s = ((Settings -> Identity Settings)
 -> PoolDatabase -> Identity PoolDatabase)
-> (Settings -> Settings) -> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify IsLabel
  "settings"
  ((Settings -> Identity Settings)
   -> PoolDatabase -> Identity PoolDatabase)
(Settings -> Identity Settings)
-> PoolDatabase -> Identity PoolDatabase
#settings (\Settings
_ -> Settings
s)

mReadLastMetadataGC
    :: ModelOp (Maybe POSIXTime)
mReadLastMetadataGC :: ModelOp (Maybe POSIXTime)
mReadLastMetadataGC = ((Maybe POSIXTime -> Const (Maybe POSIXTime) (Maybe POSIXTime))
 -> PoolDatabase -> Const (Maybe POSIXTime) PoolDatabase)
-> ModelOp (Maybe POSIXTime)
forall a.
((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get (IsLabel
  "internalState"
  ((InternalState -> Const (Maybe POSIXTime) InternalState)
   -> PoolDatabase -> Const (Maybe POSIXTime) PoolDatabase)
(InternalState -> Const (Maybe POSIXTime) InternalState)
-> PoolDatabase -> Const (Maybe POSIXTime) PoolDatabase
#internalState ((InternalState -> Const (Maybe POSIXTime) InternalState)
 -> PoolDatabase -> Const (Maybe POSIXTime) PoolDatabase)
-> ((Maybe POSIXTime -> Const (Maybe POSIXTime) (Maybe POSIXTime))
    -> InternalState -> Const (Maybe POSIXTime) InternalState)
-> (Maybe POSIXTime -> Const (Maybe POSIXTime) (Maybe POSIXTime))
-> PoolDatabase
-> Const (Maybe POSIXTime) PoolDatabase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "lastMetadataGC"
  ((Maybe POSIXTime -> Const (Maybe POSIXTime) (Maybe POSIXTime))
   -> InternalState -> Const (Maybe POSIXTime) InternalState)
(Maybe POSIXTime -> Const (Maybe POSIXTime) (Maybe POSIXTime))
-> InternalState -> Const (Maybe POSIXTime) InternalState
#lastMetadataGC)

mPutLastMetadataGC
    :: POSIXTime
    -> ModelOp ()
mPutLastMetadataGC :: POSIXTime -> ModelOp ()
mPutLastMetadataGC POSIXTime
t = ((Maybe POSIXTime -> Identity (Maybe POSIXTime))
 -> PoolDatabase -> Identity PoolDatabase)
-> (Maybe POSIXTime -> Maybe POSIXTime) -> ModelOp ()
forall a b.
((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify (IsLabel
  "internalState"
  ((InternalState -> Identity InternalState)
   -> PoolDatabase -> Identity PoolDatabase)
(InternalState -> Identity InternalState)
-> PoolDatabase -> Identity PoolDatabase
#internalState ((InternalState -> Identity InternalState)
 -> PoolDatabase -> Identity PoolDatabase)
-> ((Maybe POSIXTime -> Identity (Maybe POSIXTime))
    -> InternalState -> Identity InternalState)
-> (Maybe POSIXTime -> Identity (Maybe POSIXTime))
-> PoolDatabase
-> Identity PoolDatabase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "lastMetadataGC"
  ((Maybe POSIXTime -> Identity (Maybe POSIXTime))
   -> InternalState -> Identity InternalState)
(Maybe POSIXTime -> Identity (Maybe POSIXTime))
-> InternalState -> Identity InternalState
#lastMetadataGC) (\Maybe POSIXTime
_ -> POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just POSIXTime
t)

--------------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------------

-- Get the value of a particular field from the database.
--
get
    :: ((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
    -- ^ Database field label.
    -> ModelOp a
get :: ((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> ModelOp a
get (a -> Const a a) -> PoolDatabase -> Const a PoolDatabase
label = (PoolDatabase -> a) -> ModelOp a
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets ((PoolDatabase -> a) -> ModelOp a)
-> (PoolDatabase -> a) -> ModelOp a
forall a b. (a -> b) -> a -> b
$ ((a -> Const a a) -> PoolDatabase -> Const a PoolDatabase)
-> PoolDatabase -> a
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (a -> Const a a) -> PoolDatabase -> Const a PoolDatabase
label

-- Modify the value of a particular field within the database.
--
modify
    :: ((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
    -- ^ Database field label.
    -> (a -> b)
    -- ^ Modification function.
    -> ModelOp ()
modify :: ((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> ModelOp ()
modify (a -> Identity b) -> PoolDatabase -> Identity PoolDatabase
label = (PoolDatabase -> PoolDatabase) -> ModelOp ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify ((PoolDatabase -> PoolDatabase) -> ModelOp ())
-> ((a -> b) -> PoolDatabase -> PoolDatabase)
-> (a -> b)
-> ModelOp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Identity b) -> PoolDatabase -> Identity PoolDatabase)
-> (a -> b) -> PoolDatabase -> PoolDatabase
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over (a -> Identity b) -> PoolDatabase -> Identity PoolDatabase
label