{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeApplications #-}

-- | Examples of the application of the delegation rules.
module Test.Byron.Spec.Ledger.Delegation.Examples (
  deleg,
) where

import Byron.Spec.Ledger.Core (
  BlockCount (BlockCount),
  Epoch (Epoch),
  Owner (Owner),
  Sig (Sig),
  Slot (Slot),
  VKey (VKey),
  VKeyGenesis (VKeyGenesis),
  owner,
 )
import Byron.Spec.Ledger.Delegation (
  ADELEG,
  ADELEGS,
  DCert (DCert),
  DELEG,
  DIState (DIState),
  DSEnv (DSEnv),
  DSState (DSState),
  DState (DState),
  SDELEG,
  _dIStateDelegationMap,
  _dIStateKeyEpochDelegations,
  _dIStateLastDelegation,
  _dIStateScheduledDelegations,
  _dSEnvAllowedDelegators,
  _dSEnvEpoch,
  _dSEnvK,
  _dSEnvSlot,
 )
import Data.Functor.Identity (runIdentity)
import Data.Set (Set, fromList)
import Data.Word (Word64)
import Numeric.Natural (Natural)
import Test.Control.State.Transition.Trace (checkTrace, (.-), (.->))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

-- | Delegation examples.
deleg :: [TestTree]
deleg :: [TestTree]
deleg =
  [ TestName -> [TestTree] -> TestTree
testGroup
      TestName
"Activation"
      [ TestName -> Assertion -> TestTree
testCase TestName
"Example 0" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @ADELEG Identity a -> a
forall a. Identity a -> a
runIdentity Set VKeyGenesis
Environment ADELEG
genKeys (ReaderT
   (State ADELEG
    -> Signal ADELEG
    -> Either (NonEmpty (PredicateFailure ADELEG)) (State ADELEG))
   IO
   (State ADELEG)
 -> Assertion)
-> ReaderT
     (State ADELEG
      -> Signal ADELEG
      -> Either (NonEmpty (PredicateFailure ADELEG)) (State ADELEG))
     IO
     (State ADELEG)
-> Assertion
forall a b. (a -> b) -> a -> b
$
            DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall a.
a
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState [] [])
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
0, (Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10)]
                [(Natural -> VKeyGenesis
gk Natural
0, Word64 -> Slot
s Word64
0)]
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
1, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
11))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10), (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
11)]
                [(Natural -> VKeyGenesis
gk Natural
0, Word64 -> Slot
s Word64
0), (Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
1)]
              -- Here we try to delegate to a key @k 11@ that is already delegated (by
              -- @gk 0@), so the state remains unaltered.
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
2, (Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
11))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10), (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
11)]
                [(Natural -> VKeyGenesis
gk Natural
0, Word64 -> Slot
s Word64
0), (Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
1)]
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
3, (Natural -> VKeyGenesis
gk Natural
2, Natural -> VKey
k Natural
12))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10), (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
11), (Natural -> VKeyGenesis
gk Natural
2, Natural -> VKey
k Natural
12)]
                [(Natural -> VKeyGenesis
gk Natural
0, Word64 -> Slot
s Word64
0), (Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
1), (Natural -> VKeyGenesis
gk Natural
2, Word64 -> Slot
s Word64
3)]
      , TestName -> Assertion -> TestTree
testCase TestName
"Example 1" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @ADELEG Identity a -> a
forall a. Identity a -> a
runIdentity Set VKeyGenesis
Environment ADELEG
genKeys (ReaderT
   (State ADELEG
    -> Signal ADELEG
    -> Either (NonEmpty (PredicateFailure ADELEG)) (State ADELEG))
   IO
   (State ADELEG)
 -> Assertion)
-> ReaderT
     (State ADELEG
      -> Signal ADELEG
      -> Either (NonEmpty (PredicateFailure ADELEG)) (State ADELEG))
     IO
     (State ADELEG)
-> Assertion
forall a b. (a -> b) -> a -> b
$
            DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall a.
a
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState [] [])
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
0, (Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
2))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
2)]
                [(Natural -> VKeyGenesis
gk Natural
0, Word64 -> Slot
s Word64
0)]
              -- Trying to delegate to a key that was delegated already has no effect
              -- should be a no-op on the delegation state.
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
1, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
2))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
2)]
                [(Natural -> VKeyGenesis
gk Natural
0, Word64 -> Slot
s Word64
0)]
      , TestName -> Assertion -> TestTree
testCase TestName
"Example 2" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @ADELEG Identity a -> a
forall a. Identity a -> a
runIdentity Set VKeyGenesis
Environment ADELEG
genKeys (ReaderT
   (State ADELEG
    -> Signal ADELEG
    -> Either (NonEmpty (PredicateFailure ADELEG)) (State ADELEG))
   IO
   (State ADELEG)
 -> Assertion)
-> ReaderT
     (State ADELEG
      -> Signal ADELEG
      -> Either (NonEmpty (PredicateFailure ADELEG)) (State ADELEG))
     IO
     (State ADELEG)
-> Assertion
forall a b. (a -> b) -> a -> b
$
            DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall a.
a
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState [] [])
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
6, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
2))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
2)]
                [(Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
6)]
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
7, (Natural -> VKeyGenesis
gk Natural
2, Natural -> VKey
k Natural
2))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
2)]
                [(Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
6)]
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
16, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
0))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
0)]
                [(Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
16)]
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> (Slot, (VKeyGenesis, VKey))
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (Word64 -> Slot
s Word64
19, (Natural -> VKeyGenesis
gk Natural
2, Natural -> VKey
k Natural
0))
              ReaderT
  (DState
   -> (Slot, (VKeyGenesis, VKey))
   -> Either (NonEmpty AdelegPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> (Slot, (VKeyGenesis, VKey))
      -> Either (NonEmpty AdelegPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
0)]
                [(Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
16)]
      ]
  , TestName -> [TestTree] -> TestTree
testGroup
      TestName
"Multiple Activations"
      [ TestName -> Assertion -> TestTree
testCase TestName
"Example 0" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @ADELEGS Identity a -> a
forall a. Identity a -> a
runIdentity Set VKeyGenesis
Environment ADELEGS
genKeys (ReaderT
   (State ADELEGS
    -> Signal ADELEGS
    -> Either (NonEmpty (PredicateFailure ADELEGS)) (State ADELEGS))
   IO
   (State ADELEGS)
 -> Assertion)
-> ReaderT
     (State ADELEGS
      -> Signal ADELEGS
      -> Either (NonEmpty (PredicateFailure ADELEGS)) (State ADELEGS))
     IO
     (State ADELEGS)
-> Assertion
forall a b. (a -> b) -> a -> b
$
            DState
-> ReaderT
     (DState
      -> [(Slot, (VKeyGenesis, VKey))]
      -> Either (NonEmpty AdelegsPredicateFailure) DState)
     IO
     DState
forall a.
a
-> ReaderT
     (DState
      -> [(Slot, (VKeyGenesis, VKey))]
      -> Either (NonEmpty AdelegsPredicateFailure) DState)
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState [] [])
              ReaderT
  (DState
   -> [(Slot, (VKeyGenesis, VKey))]
   -> Either (NonEmpty AdelegsPredicateFailure) DState)
  IO
  DState
-> [(Slot, (VKeyGenesis, VKey))]
-> ReaderT
     (DState
      -> [(Slot, (VKeyGenesis, VKey))]
      -> Either (NonEmpty AdelegsPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- [ (Word64 -> Slot
s Word64
4, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
0))
                 , (Word64 -> Slot
s Word64
5, (Natural -> VKeyGenesis
gk Natural
2, Natural -> VKey
k Natural
0))
                 , (Word64 -> Slot
s Word64
5, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
1))
                 ]
              ReaderT
  (DState
   -> [(Slot, (VKeyGenesis, VKey))]
   -> Either (NonEmpty AdelegsPredicateFailure) DState)
  IO
  DState
-> DState
-> ReaderT
     (DState
      -> [(Slot, (VKeyGenesis, VKey))]
      -> Either (NonEmpty AdelegsPredicateFailure) DState)
     IO
     DState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> Bimap VKeyGenesis VKey -> Map VKeyGenesis Slot -> DState
DState
                [(Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
1)]
                [(Natural -> VKeyGenesis
gk Natural
1, Word64 -> Slot
s Word64
5)]
      ]
  , TestName -> [TestTree] -> TestTree
testGroup
      TestName
"Scheduling"
      [ TestName -> Assertion -> TestTree
testCase TestName
"Example 0" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @SDELEG Identity a -> a
forall a. Identity a -> a
runIdentity (Set VKeyGenesis -> Epoch -> Slot -> BlockCount -> DSEnv
DSEnv [Natural -> VKeyGenesis
gk Natural
0, Natural -> VKeyGenesis
gk Natural
1, Natural -> VKeyGenesis
gk Natural
2] (Word64 -> Epoch
e Word64
8) (Word64 -> Slot
s Word64
2) (Word64 -> BlockCount
bk Word64
2160)) (ReaderT
   (State SDELEG
    -> Signal SDELEG
    -> Either (NonEmpty (PredicateFailure SDELEG)) (State SDELEG))
   IO
   (State SDELEG)
 -> Assertion)
-> ReaderT
     (State SDELEG
      -> Signal SDELEG
      -> Either (NonEmpty (PredicateFailure SDELEG)) (State SDELEG))
     IO
     (State SDELEG)
-> Assertion
forall a b. (a -> b) -> a -> b
$
            DSState
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     DSState
forall a.
a
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Slot, (VKeyGenesis, VKey))]
-> Set (Epoch, VKeyGenesis) -> DSState
DSState [] [])
              ReaderT
  (DSState
   -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
  IO
  DSState
-> DCert
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     DSState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- VKeyGenesis -> VKey -> Epoch -> DCert
dc (Natural -> VKeyGenesis
gk Natural
0) (Natural -> VKey
k Natural
10) (Word64 -> Epoch
e Word64
8)
              ReaderT
  (DSState
   -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
  IO
  DSState
-> DSState
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     DSState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> [(Slot, (VKeyGenesis, VKey))]
-> Set (Epoch, VKeyGenesis) -> DSState
DSState
                [(Word64 -> Slot
s Word64
4322, (Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10))]
                [(Word64 -> Epoch
e Word64
8, Natural -> VKeyGenesis
gk Natural
0)]
              ReaderT
  (DSState
   -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
  IO
  DSState
-> DCert
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     DSState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- VKeyGenesis -> VKey -> Epoch -> DCert
dc (Natural -> VKeyGenesis
gk Natural
1) (Natural -> VKey
k Natural
11) (Word64 -> Epoch
e Word64
8)
              ReaderT
  (DSState
   -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
  IO
  DSState
-> DSState
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     DSState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> [(Slot, (VKeyGenesis, VKey))]
-> Set (Epoch, VKeyGenesis) -> DSState
DSState
                [(Word64 -> Slot
s Word64
4322, (Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10)), (Word64 -> Slot
s Word64
4322, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
11))]
                [(Word64 -> Epoch
e Word64
8, Natural -> VKeyGenesis
gk Natural
0), (Word64 -> Epoch
e Word64
8, Natural -> VKeyGenesis
gk Natural
1)]
              ReaderT
  (DSState
   -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
  IO
  DSState
-> DCert
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     DSState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- VKeyGenesis -> VKey -> Epoch -> DCert
dc (Natural -> VKeyGenesis
gk Natural
2) (Natural -> VKey
k Natural
10) (Word64 -> Epoch
e Word64
8)
              ReaderT
  (DSState
   -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
  IO
  DSState
-> DSState
-> ReaderT
     (DSState
      -> DCert -> Either (NonEmpty SdelegPredicateFailure) DSState)
     IO
     DSState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> [(Slot, (VKeyGenesis, VKey))]
-> Set (Epoch, VKeyGenesis) -> DSState
DSState
                [(Word64 -> Slot
s Word64
4322, (Natural -> VKeyGenesis
gk Natural
0, Natural -> VKey
k Natural
10)), (Word64 -> Slot
s Word64
4322, (Natural -> VKeyGenesis
gk Natural
1, Natural -> VKey
k Natural
11)), (Word64 -> Slot
s Word64
4322, (Natural -> VKeyGenesis
gk Natural
2, Natural -> VKey
k Natural
10))]
                [(Word64 -> Epoch
e Word64
8, Natural -> VKeyGenesis
gk Natural
0), (Word64 -> Epoch
e Word64
8, Natural -> VKeyGenesis
gk Natural
1), (Word64 -> Epoch
e Word64
8, Natural -> VKeyGenesis
gk Natural
2)]
      ]
  , TestName -> [TestTree] -> TestTree
testGroup
      TestName
"Interface"
      [ TestName -> Assertion -> TestTree
testCase TestName
"Non-injective scheduled delegations are ignored." (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
          let env :: DSEnv
env =
                DSEnv
                  { _dSEnvAllowedDelegators :: Set VKeyGenesis
_dSEnvAllowedDelegators = [Natural -> VKeyGenesis
gk Natural
0, Natural -> VKeyGenesis
gk Natural
1]
                  , _dSEnvEpoch :: Epoch
_dSEnvEpoch = Word64 -> Epoch
e Word64
0
                  , _dSEnvSlot :: Slot
_dSEnvSlot = Word64 -> Slot
s Word64
21
                  , _dSEnvK :: BlockCount
_dSEnvK = Word64 -> BlockCount
bk Word64
5
                  }
              st :: DIState
st =
                DIState
                  { _dIStateDelegationMap :: Bimap VKeyGenesis VKey
_dIStateDelegationMap =
                      [
                        ( Natural -> VKeyGenesis
gk Natural
0
                        , Natural -> VKey
k Natural
0
                        )
                      ,
                        ( Natural -> VKeyGenesis
gk Natural
1
                        , Natural -> VKey
k Natural
1
                        )
                      ]
                  , _dIStateLastDelegation :: Map VKeyGenesis Slot
_dIStateLastDelegation =
                      [
                        ( Natural -> VKeyGenesis
gk Natural
0
                        , Word64 -> Slot
s Word64
15
                        )
                      ,
                        ( Natural -> VKeyGenesis
gk Natural
1
                        , Word64 -> Slot
s Word64
0
                        )
                      ]
                  , _dIStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dIStateScheduledDelegations =
                      [
                        ( Word64 -> Slot
s Word64
21
                        ,
                          ( Natural -> VKeyGenesis
gk Natural
1
                          , Natural -> VKey
k Natural
0
                          )
                        )
                      ]
                  , _dIStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dIStateKeyEpochDelegations =
                      [(Epoch, VKeyGenesis)] -> Set (Epoch, VKeyGenesis)
forall a. Ord a => [a] -> Set a
fromList
                        [
                          ( Word64 -> Epoch
e Word64
0
                          , Natural -> VKeyGenesis
gk Natural
0
                          )
                        ,
                          ( Word64 -> Epoch
e Word64
0
                          , Natural -> VKeyGenesis
gk Natural
1
                          )
                        ,
                          ( Word64 -> Epoch
e Word64
1
                          , Natural -> VKeyGenesis
gk Natural
0
                          )
                        ]
                  }
           in forall s (m :: * -> *).
(STS s, BaseM s ~ m) =>
(forall a. m a -> a)
-> Environment s
-> ReaderT
     (State s
      -> Signal s -> Either (NonEmpty (PredicateFailure s)) (State s))
     IO
     (State s)
-> Assertion
checkTrace @DELEG Identity a -> a
forall a. Identity a -> a
runIdentity DSEnv
Environment DELEG
env (ReaderT
   (State DELEG
    -> Signal DELEG
    -> Either (NonEmpty (PredicateFailure DELEG)) (State DELEG))
   IO
   (State DELEG)
 -> Assertion)
-> ReaderT
     (State DELEG
      -> Signal DELEG
      -> Either (NonEmpty (PredicateFailure DELEG)) (State DELEG))
     IO
     (State DELEG)
-> Assertion
forall a b. (a -> b) -> a -> b
$
                DIState
-> ReaderT
     (DIState
      -> [DCert] -> Either (NonEmpty DelegPredicateFailure) DIState)
     IO
     DIState
forall a.
a
-> ReaderT
     (DIState
      -> [DCert] -> Either (NonEmpty DelegPredicateFailure) DIState)
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DIState
st ReaderT
  (DIState
   -> [DCert] -> Either (NonEmpty DelegPredicateFailure) DIState)
  IO
  DIState
-> [DCert]
-> ReaderT
     (DIState
      -> [DCert] -> Either (NonEmpty DelegPredicateFailure) DIState)
     IO
     DIState
forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- [] ReaderT
  (DIState
   -> [DCert] -> Either (NonEmpty DelegPredicateFailure) DIState)
  IO
  DIState
-> DIState
-> ReaderT
     (DIState
      -> [DCert] -> Either (NonEmpty DelegPredicateFailure) DIState)
     IO
     DIState
forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> DIState
st {_dIStateScheduledDelegations = []}
      ]
  ]
  where
    s :: Word64 -> Slot
    s :: Word64 -> Slot
s = Word64 -> Slot
Slot

    k :: Natural -> VKey
    k :: Natural -> VKey
k = Owner -> VKey
VKey (Owner -> VKey) -> (Natural -> Owner) -> Natural -> VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Owner
Owner

    gk :: Natural -> VKeyGenesis
    gk :: Natural -> VKeyGenesis
gk = VKey -> VKeyGenesis
VKeyGenesis (VKey -> VKeyGenesis)
-> (Natural -> VKey) -> Natural -> VKeyGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> VKey
k

    e :: Word64 -> Epoch
    e :: Word64 -> Epoch
e = Word64 -> Epoch
Epoch

    bk :: Word64 -> BlockCount
    bk :: Word64 -> BlockCount
bk = Word64 -> BlockCount
BlockCount

    dc :: VKeyGenesis -> VKey -> Epoch -> DCert
    dc :: VKeyGenesis -> VKey -> Epoch -> DCert
dc VKeyGenesis
vkg VKey
vk Epoch
ep = VKeyGenesis -> VKey -> Epoch -> Sig (VKey, Epoch) -> DCert
DCert VKeyGenesis
vkg VKey
vk Epoch
ep ((VKey, Epoch) -> Owner -> Sig (VKey, Epoch)
forall a. a -> Owner -> Sig a
Sig (VKey
vk, Epoch
ep) (VKeyGenesis -> Owner
forall a. HasOwner a => a -> Owner
owner VKeyGenesis
vkg))

    genKeys :: Set VKeyGenesis
    genKeys :: Set VKeyGenesis
genKeys = [VKeyGenesis] -> Set VKeyGenesis
forall a. Ord a => [a] -> Set a
fromList ([VKeyGenesis] -> Set VKeyGenesis)
-> [VKeyGenesis] -> Set VKeyGenesis
forall a b. (a -> b) -> a -> b
$ (Natural -> VKeyGenesis) -> [Natural] -> [VKeyGenesis]
forall a b. (a -> b) -> [a] -> [b]
map (VKey -> VKeyGenesis
VKeyGenesis (VKey -> VKeyGenesis)
-> (Natural -> VKey) -> Natural -> VKeyGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Owner -> VKey
VKey (Owner -> VKey) -> (Natural -> Owner) -> Natural -> VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Owner
Owner) [Natural
Item [Natural]
0 .. Natural
Item [Natural]
6]