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

-- | Examples of the application of the update rules.
module Test.Byron.Spec.Ledger.Update.Examples where

import Byron.Spec.Ledger.Core (
  BlockCount (BlockCount),
  Owner (Owner),
  Slot (Slot),
  SlotCount (SlotCount),
  VKey (VKey),
  VKeyGenesis (VKeyGenesis),
  unBlockCount,
  unOwner,
  unSlot,
  unSlotCount,
  unVKeyGenesis,
 )
import Byron.Spec.Ledger.Update (
  ApName (ApName),
  ApVer (ApVer),
  FactorA (..),
  FactorB (..),
  Metadata (Metadata),
  PParams (PParams),
  ProtVer (ProtVer),
  UPIEND,
  UpId (UpId),
  _bkSgnCntT,
  _bkSlotsPerEpoch,
  _factorA,
  _factorB,
  _maxBkSz,
  _maxHdrSz,
  _maxPropSz,
  _maxTxSz,
  _pvAlt,
  _pvMaj,
  _pvMin,
  _scriptVersion,
  _upAdptThd,
  _upTtl,
 )
import Data.Functor.Identity (runIdentity)
import GHC.Exts (fromList)
import Test.Control.State.Transition.Trace (checkTrace, (.-), (.->))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

upiendExamples :: [TestTree]
upiendExamples :: [TestTree]
upiendExamples =
  [ TestName -> [TestTree] -> TestTree
testGroup
      TestName
"UPIEND"
      [ TestName -> Assertion -> TestTree
testCase TestName
"Example 0" forall a b. (a -> b) -> a -> b
$
          let oldPParams :: PParams
oldPParams =
                PParams
                  { _maxBkSz :: Natural
_maxBkSz = Natural
10000
                  , _maxHdrSz :: Natural
_maxHdrSz = Natural
1000
                  , _maxTxSz :: Natural
_maxTxSz = Natural
500
                  , _maxPropSz :: Natural
_maxPropSz = Natural
10
                  , _bkSgnCntT :: BkSgnCntT
_bkSgnCntT = BkSgnCntT
0.7857142857142857
                  , _bkSlotsPerEpoch :: SlotCount
_bkSlotsPerEpoch = SlotCount {unSlotCount :: Word64
unSlotCount = Word64
10}
                  , _upTtl :: SlotCount
_upTtl = SlotCount {unSlotCount :: Word64
unSlotCount = Word64
10}
                  , _scriptVersion :: Natural
_scriptVersion = Natural
0
                  , _upAdptThd :: UpAdptThd
_upAdptThd = UpAdptThd
0.6
                  , _factorA :: FactorA
_factorA = Int -> FactorA
FactorA Int
1
                  , _factorB :: FactorB
_factorB = Int -> FactorB
FactorB Int
2
                  }
              newPParams :: PParams
newPParams =
                PParams
                  { _maxBkSz :: Natural
_maxBkSz = Natural
9900
                  , _maxHdrSz :: Natural
_maxHdrSz = Natural
1000
                  , _maxTxSz :: Natural
_maxTxSz = Natural
489
                  , _maxPropSz :: Natural
_maxPropSz = Natural
10
                  , _bkSgnCntT :: BkSgnCntT
_bkSgnCntT = BkSgnCntT
0.7857142857142857
                  , _bkSlotsPerEpoch :: SlotCount
_bkSlotsPerEpoch = SlotCount {unSlotCount :: Word64
unSlotCount = Word64
10}
                  , _upTtl :: SlotCount
_upTtl = SlotCount {unSlotCount :: Word64
unSlotCount = Word64
2}
                  , _scriptVersion :: Natural
_scriptVersion = Natural
0
                  , _upAdptThd :: UpAdptThd
_upAdptThd = UpAdptThd
0.0
                  , _factorA :: FactorA
_factorA = Int -> FactorA
FactorA Int
0
                  , _factorB :: FactorB
_factorB = Int -> FactorB
FactorB Int
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 @UPIEND
                forall a. Identity a -> a
runIdentity
                ( Slot {unSlot :: Word64
unSlot = Word64
15}
                ,
                  [
                    ( VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
0}}
                    , Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
0}
                    )
                  ,
                    ( VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
1}}
                    , Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
1}
                    )
                  ,
                    ( VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
2}}
                    , Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
2}
                    )
                  ,
                    ( VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
3}}
                    , Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
3}
                    )
                  ,
                    ( VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
4}}
                    , Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
4}
                    )
                  ]
                , BlockCount {unBlockCount :: Word64
unBlockCount = Word64
2}
                , Word8
5
                )
                forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  (
                    ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
0, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                    , PParams
oldPParams
                    )
                  , []
                  , forall l. IsList l => [Item l] -> l
fromList []
                  , forall l. IsList l => [Item l] -> l
fromList
                      [
                        ( Int -> UpId
UpId Int
1
                        ,
                          ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                          , PParams
newPParams
                          )
                        )
                      ]
                  , forall l. IsList l => [Item l] -> l
fromList [(Int -> UpId
UpId Int
1, (TestName -> ApName
ApName TestName
"", Natural -> ApVer
ApVer Natural
0, Metadata
Metadata))]
                  , forall l. IsList l => [Item l] -> l
fromList [(Int -> UpId
UpId Int
1, Slot {unSlot :: Word64
unSlot = Word64
5})]
                  , forall l. IsList l => [Item l] -> l
fromList
                      [
                        ( Int -> UpId
UpId Int
1
                        , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
1}}
                        )
                      ,
                        ( Int -> UpId
UpId Int
1
                        , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
2}}
                        )
                      ,
                        ( Int -> UpId
UpId Int
1
                        , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
3}}
                        )
                      ]
                  , forall l. IsList l => [Item l] -> l
fromList
                      [
                        ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                        , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
1}}
                        )
                      ,
                        ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                        , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
3}}
                        )
                      ]
                  , forall l. IsList l => [Item l] -> l
fromList [(Int -> UpId
UpId Int
1, Slot {unSlot :: Word64
unSlot = Word64
2})]
                  )
                  forall (m :: * -> *) st sig err.
(MonadIO m, MonadReader (st -> sig -> Either err st) m, Show err,
 HasCallStack) =>
m st -> sig -> m st
.- (ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}, Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
0})
                  forall (m :: * -> *) st.
(MonadIO m, Eq st, Show st, HasCallStack) =>
m st -> st -> m st
.-> (
                        ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
0, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                        , PParams
oldPParams
                        )
                      ,
                        [
                          ( Slot {unSlot :: Word64
unSlot = Word64
15}
                          ,
                            ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                            , PParams
newPParams
                            )
                          )
                        ]
                      , forall l. IsList l => [Item l] -> l
fromList []
                      , forall l. IsList l => [Item l] -> l
fromList
                          [
                            ( Int -> UpId
UpId Int
1
                            ,
                              ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                              , PParams
newPParams
                              )
                            )
                          ]
                      , forall l. IsList l => [Item l] -> l
fromList [(Int -> UpId
UpId Int
1, (TestName -> ApName
ApName TestName
"", Natural -> ApVer
ApVer Natural
0, Metadata
Metadata))]
                      , forall l. IsList l => [Item l] -> l
fromList [(Int -> UpId
UpId Int
1, Slot {unSlot :: Word64
unSlot = Word64
5})]
                      , forall l. IsList l => [Item l] -> l
fromList
                          [
                            ( Int -> UpId
UpId Int
1
                            , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
1}}
                            )
                          ,
                            ( Int -> UpId
UpId Int
1
                            , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
2}}
                            )
                          ,
                            ( Int -> UpId
UpId Int
1
                            , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
3}}
                            )
                          ]
                      , forall l. IsList l => [Item l] -> l
fromList
                          [
                            ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                            , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
0}}
                            )
                          ,
                            ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                            , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
1}}
                            )
                          ,
                            ( ProtVer {_pvMaj :: Natural
_pvMaj = Natural
1, _pvMin :: Natural
_pvMin = Natural
0, _pvAlt :: Natural
_pvAlt = Natural
0}
                            , VKeyGenesis {unVKeyGenesis :: VKey
unVKeyGenesis = Owner -> VKey
VKey Owner {unOwner :: Natural
unOwner = Natural
3}}
                            )
                          ]
                      , forall l. IsList l => [Item l] -> l
fromList [(Int -> UpId
UpId Int
1, Slot {unSlot :: Word64
unSlot = Word64
2})]
                      )
      ]
  ]