{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Byron.Spec.Ledger.Update (
module Byron.Spec.Ledger.Update,
PredicateFailure (),
) where
import Byron.Spec.Ledger.Core (
BlockCount (..),
HasHash,
Owner (Owner),
Relation (..),
Slot,
SlotCount (..),
VKey (VKey),
VKeyGenesis (VKeyGenesis),
dom,
hash,
(*.),
(-.),
(∈),
(∉),
(⋪),
(▷),
(▷<=),
(▷>=),
(◁),
(⨃),
)
import qualified Byron.Spec.Ledger.Core as Core
import qualified Byron.Spec.Ledger.Core.Generators as CoreGen
import Byron.Spec.Ledger.Core.Omniscient (skey)
import qualified Byron.Spec.Ledger.GlobalParams as GP
import Control.Arrow (second, (&&&))
import Control.State.Transition
import Data.AbstractSize (HasTypeReps)
import Data.Bimap (Bimap, empty, lookupR)
import qualified Data.Bimap as Bimap
import Data.Char (isAscii)
import Data.Data (Data)
import Data.Foldable as F (foldl', toList)
import Data.Hashable (Hashable)
import qualified Data.Hashable as H
import Data.Ix (inRange)
import Data.List (sortOn)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Ord (Down (Down))
import Data.Set (Set, union, (\\))
import qualified Data.Set as Set
import Data.Tuple (swap)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Lens.Micro
import Lens.Micro.Extras (view)
import Lens.Micro.Internal (Field1 (..), Field2 (..), Field3 (..))
import Lens.Micro.TH (makeLenses)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural
import Test.Control.State.Transition.Generator (
HasTrace,
envGen,
sigGen,
)
import Prelude
newtype FactorA = FactorA Int
deriving stock ((forall x. FactorA -> Rep FactorA x)
-> (forall x. Rep FactorA x -> FactorA) -> Generic FactorA
forall x. Rep FactorA x -> FactorA
forall x. FactorA -> Rep FactorA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FactorA -> Rep FactorA x
from :: forall x. FactorA -> Rep FactorA x
$cto :: forall x. Rep FactorA x -> FactorA
to :: forall x. Rep FactorA x -> FactorA
Generic, Int -> FactorA -> ShowS
[FactorA] -> ShowS
FactorA -> String
(Int -> FactorA -> ShowS)
-> (FactorA -> String) -> ([FactorA] -> ShowS) -> Show FactorA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FactorA -> ShowS
showsPrec :: Int -> FactorA -> ShowS
$cshow :: FactorA -> String
show :: FactorA -> String
$cshowList :: [FactorA] -> ShowS
showList :: [FactorA] -> ShowS
Show, Typeable FactorA
Typeable FactorA =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorA -> c FactorA)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorA)
-> (FactorA -> Constr)
-> (FactorA -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorA))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorA))
-> ((forall b. Data b => b -> b) -> FactorA -> FactorA)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r)
-> (forall u. (forall d. Data d => d -> u) -> FactorA -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FactorA -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA)
-> Data FactorA
FactorA -> Constr
FactorA -> DataType
(forall b. Data b => b -> b) -> FactorA -> FactorA
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FactorA -> u
forall u. (forall d. Data d => d -> u) -> FactorA -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorA
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorA -> c FactorA
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorA)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorA)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorA -> c FactorA
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorA -> c FactorA
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorA
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorA
$ctoConstr :: FactorA -> Constr
toConstr :: FactorA -> Constr
$cdataTypeOf :: FactorA -> DataType
dataTypeOf :: FactorA -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorA)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorA)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorA)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorA)
$cgmapT :: (forall b. Data b => b -> b) -> FactorA -> FactorA
gmapT :: (forall b. Data b => b -> b) -> FactorA -> FactorA
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorA -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FactorA -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FactorA -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FactorA -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FactorA -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorA -> m FactorA
Data)
deriving newtype (FactorA -> FactorA -> Bool
(FactorA -> FactorA -> Bool)
-> (FactorA -> FactorA -> Bool) -> Eq FactorA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FactorA -> FactorA -> Bool
== :: FactorA -> FactorA -> Bool
$c/= :: FactorA -> FactorA -> Bool
/= :: FactorA -> FactorA -> Bool
Eq, Eq FactorA
Eq FactorA =>
(FactorA -> FactorA -> Ordering)
-> (FactorA -> FactorA -> Bool)
-> (FactorA -> FactorA -> Bool)
-> (FactorA -> FactorA -> Bool)
-> (FactorA -> FactorA -> Bool)
-> (FactorA -> FactorA -> FactorA)
-> (FactorA -> FactorA -> FactorA)
-> Ord FactorA
FactorA -> FactorA -> Bool
FactorA -> FactorA -> Ordering
FactorA -> FactorA -> FactorA
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FactorA -> FactorA -> Ordering
compare :: FactorA -> FactorA -> Ordering
$c< :: FactorA -> FactorA -> Bool
< :: FactorA -> FactorA -> Bool
$c<= :: FactorA -> FactorA -> Bool
<= :: FactorA -> FactorA -> Bool
$c> :: FactorA -> FactorA -> Bool
> :: FactorA -> FactorA -> Bool
$c>= :: FactorA -> FactorA -> Bool
>= :: FactorA -> FactorA -> Bool
$cmax :: FactorA -> FactorA -> FactorA
max :: FactorA -> FactorA -> FactorA
$cmin :: FactorA -> FactorA -> FactorA
min :: FactorA -> FactorA -> FactorA
Ord, Eq FactorA
Eq FactorA =>
(Int -> FactorA -> Int) -> (FactorA -> Int) -> Hashable FactorA
Int -> FactorA -> Int
FactorA -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FactorA -> Int
hashWithSalt :: Int -> FactorA -> Int
$chash :: FactorA -> Int
hash :: FactorA -> Int
Hashable, Context -> FactorA -> IO (Maybe ThunkInfo)
Proxy FactorA -> String
(Context -> FactorA -> IO (Maybe ThunkInfo))
-> (Context -> FactorA -> IO (Maybe ThunkInfo))
-> (Proxy FactorA -> String)
-> NoThunks FactorA
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> FactorA -> IO (Maybe ThunkInfo)
noThunks :: Context -> FactorA -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> FactorA -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> FactorA -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy FactorA -> String
showTypeOf :: Proxy FactorA -> String
NoThunks)
deriving anyclass (FactorA -> Seq TypeRep
(FactorA -> Seq TypeRep) -> HasTypeReps FactorA
forall a. (a -> Seq TypeRep) -> HasTypeReps a
$ctypeReps :: FactorA -> Seq TypeRep
typeReps :: FactorA -> Seq TypeRep
HasTypeReps)
newtype FactorB = FactorB Int
deriving stock ((forall x. FactorB -> Rep FactorB x)
-> (forall x. Rep FactorB x -> FactorB) -> Generic FactorB
forall x. Rep FactorB x -> FactorB
forall x. FactorB -> Rep FactorB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FactorB -> Rep FactorB x
from :: forall x. FactorB -> Rep FactorB x
$cto :: forall x. Rep FactorB x -> FactorB
to :: forall x. Rep FactorB x -> FactorB
Generic, Int -> FactorB -> ShowS
[FactorB] -> ShowS
FactorB -> String
(Int -> FactorB -> ShowS)
-> (FactorB -> String) -> ([FactorB] -> ShowS) -> Show FactorB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FactorB -> ShowS
showsPrec :: Int -> FactorB -> ShowS
$cshow :: FactorB -> String
show :: FactorB -> String
$cshowList :: [FactorB] -> ShowS
showList :: [FactorB] -> ShowS
Show, Typeable FactorB
Typeable FactorB =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorB -> c FactorB)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorB)
-> (FactorB -> Constr)
-> (FactorB -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorB))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorB))
-> ((forall b. Data b => b -> b) -> FactorB -> FactorB)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r)
-> (forall u. (forall d. Data d => d -> u) -> FactorB -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FactorB -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB)
-> Data FactorB
FactorB -> Constr
FactorB -> DataType
(forall b. Data b => b -> b) -> FactorB -> FactorB
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FactorB -> u
forall u. (forall d. Data d => d -> u) -> FactorB -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorB
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorB -> c FactorB
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorB)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorB)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorB -> c FactorB
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FactorB -> c FactorB
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorB
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FactorB
$ctoConstr :: FactorB -> Constr
toConstr :: FactorB -> Constr
$cdataTypeOf :: FactorB -> DataType
dataTypeOf :: FactorB -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorB)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FactorB)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorB)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FactorB)
$cgmapT :: (forall b. Data b => b -> b) -> FactorB -> FactorB
gmapT :: (forall b. Data b => b -> b) -> FactorB -> FactorB
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FactorB -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FactorB -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FactorB -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FactorB -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FactorB -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FactorB -> m FactorB
Data)
deriving newtype (FactorB -> FactorB -> Bool
(FactorB -> FactorB -> Bool)
-> (FactorB -> FactorB -> Bool) -> Eq FactorB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FactorB -> FactorB -> Bool
== :: FactorB -> FactorB -> Bool
$c/= :: FactorB -> FactorB -> Bool
/= :: FactorB -> FactorB -> Bool
Eq, Eq FactorB
Eq FactorB =>
(FactorB -> FactorB -> Ordering)
-> (FactorB -> FactorB -> Bool)
-> (FactorB -> FactorB -> Bool)
-> (FactorB -> FactorB -> Bool)
-> (FactorB -> FactorB -> Bool)
-> (FactorB -> FactorB -> FactorB)
-> (FactorB -> FactorB -> FactorB)
-> Ord FactorB
FactorB -> FactorB -> Bool
FactorB -> FactorB -> Ordering
FactorB -> FactorB -> FactorB
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FactorB -> FactorB -> Ordering
compare :: FactorB -> FactorB -> Ordering
$c< :: FactorB -> FactorB -> Bool
< :: FactorB -> FactorB -> Bool
$c<= :: FactorB -> FactorB -> Bool
<= :: FactorB -> FactorB -> Bool
$c> :: FactorB -> FactorB -> Bool
> :: FactorB -> FactorB -> Bool
$c>= :: FactorB -> FactorB -> Bool
>= :: FactorB -> FactorB -> Bool
$cmax :: FactorB -> FactorB -> FactorB
max :: FactorB -> FactorB -> FactorB
$cmin :: FactorB -> FactorB -> FactorB
min :: FactorB -> FactorB -> FactorB
Ord, Eq FactorB
Eq FactorB =>
(Int -> FactorB -> Int) -> (FactorB -> Int) -> Hashable FactorB
Int -> FactorB -> Int
FactorB -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FactorB -> Int
hashWithSalt :: Int -> FactorB -> Int
$chash :: FactorB -> Int
hash :: FactorB -> Int
Hashable, Context -> FactorB -> IO (Maybe ThunkInfo)
Proxy FactorB -> String
(Context -> FactorB -> IO (Maybe ThunkInfo))
-> (Context -> FactorB -> IO (Maybe ThunkInfo))
-> (Proxy FactorB -> String)
-> NoThunks FactorB
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> FactorB -> IO (Maybe ThunkInfo)
noThunks :: Context -> FactorB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> FactorB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> FactorB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy FactorB -> String
showTypeOf :: Proxy FactorB -> String
NoThunks)
deriving anyclass (FactorB -> Seq TypeRep
(FactorB -> Seq TypeRep) -> HasTypeReps FactorB
forall a. (a -> Seq TypeRep) -> HasTypeReps a
$ctypeReps :: FactorB -> Seq TypeRep
typeReps :: FactorB -> Seq TypeRep
HasTypeReps)
newtype UpAdptThd = UpAdptThd Double
deriving stock ((forall x. UpAdptThd -> Rep UpAdptThd x)
-> (forall x. Rep UpAdptThd x -> UpAdptThd) -> Generic UpAdptThd
forall x. Rep UpAdptThd x -> UpAdptThd
forall x. UpAdptThd -> Rep UpAdptThd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpAdptThd -> Rep UpAdptThd x
from :: forall x. UpAdptThd -> Rep UpAdptThd x
$cto :: forall x. Rep UpAdptThd x -> UpAdptThd
to :: forall x. Rep UpAdptThd x -> UpAdptThd
Generic, Int -> UpAdptThd -> ShowS
[UpAdptThd] -> ShowS
UpAdptThd -> String
(Int -> UpAdptThd -> ShowS)
-> (UpAdptThd -> String)
-> ([UpAdptThd] -> ShowS)
-> Show UpAdptThd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpAdptThd -> ShowS
showsPrec :: Int -> UpAdptThd -> ShowS
$cshow :: UpAdptThd -> String
show :: UpAdptThd -> String
$cshowList :: [UpAdptThd] -> ShowS
showList :: [UpAdptThd] -> ShowS
Show, Typeable UpAdptThd
Typeable UpAdptThd =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpAdptThd -> c UpAdptThd)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpAdptThd)
-> (UpAdptThd -> Constr)
-> (UpAdptThd -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpAdptThd))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpAdptThd))
-> ((forall b. Data b => b -> b) -> UpAdptThd -> UpAdptThd)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r)
-> (forall u. (forall d. Data d => d -> u) -> UpAdptThd -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpAdptThd -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd)
-> Data UpAdptThd
UpAdptThd -> Constr
UpAdptThd -> DataType
(forall b. Data b => b -> b) -> UpAdptThd -> UpAdptThd
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UpAdptThd -> u
forall u. (forall d. Data d => d -> u) -> UpAdptThd -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpAdptThd
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpAdptThd -> c UpAdptThd
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpAdptThd)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpAdptThd)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpAdptThd -> c UpAdptThd
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpAdptThd -> c UpAdptThd
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpAdptThd
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpAdptThd
$ctoConstr :: UpAdptThd -> Constr
toConstr :: UpAdptThd -> Constr
$cdataTypeOf :: UpAdptThd -> DataType
dataTypeOf :: UpAdptThd -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpAdptThd)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpAdptThd)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpAdptThd)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpAdptThd)
$cgmapT :: (forall b. Data b => b -> b) -> UpAdptThd -> UpAdptThd
gmapT :: (forall b. Data b => b -> b) -> UpAdptThd -> UpAdptThd
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpAdptThd -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UpAdptThd -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UpAdptThd -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UpAdptThd -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UpAdptThd -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpAdptThd -> m UpAdptThd
Data)
deriving newtype (UpAdptThd -> UpAdptThd -> Bool
(UpAdptThd -> UpAdptThd -> Bool)
-> (UpAdptThd -> UpAdptThd -> Bool) -> Eq UpAdptThd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpAdptThd -> UpAdptThd -> Bool
== :: UpAdptThd -> UpAdptThd -> Bool
$c/= :: UpAdptThd -> UpAdptThd -> Bool
/= :: UpAdptThd -> UpAdptThd -> Bool
Eq, Eq UpAdptThd
Eq UpAdptThd =>
(UpAdptThd -> UpAdptThd -> Ordering)
-> (UpAdptThd -> UpAdptThd -> Bool)
-> (UpAdptThd -> UpAdptThd -> Bool)
-> (UpAdptThd -> UpAdptThd -> Bool)
-> (UpAdptThd -> UpAdptThd -> Bool)
-> (UpAdptThd -> UpAdptThd -> UpAdptThd)
-> (UpAdptThd -> UpAdptThd -> UpAdptThd)
-> Ord UpAdptThd
UpAdptThd -> UpAdptThd -> Bool
UpAdptThd -> UpAdptThd -> Ordering
UpAdptThd -> UpAdptThd -> UpAdptThd
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UpAdptThd -> UpAdptThd -> Ordering
compare :: UpAdptThd -> UpAdptThd -> Ordering
$c< :: UpAdptThd -> UpAdptThd -> Bool
< :: UpAdptThd -> UpAdptThd -> Bool
$c<= :: UpAdptThd -> UpAdptThd -> Bool
<= :: UpAdptThd -> UpAdptThd -> Bool
$c> :: UpAdptThd -> UpAdptThd -> Bool
> :: UpAdptThd -> UpAdptThd -> Bool
$c>= :: UpAdptThd -> UpAdptThd -> Bool
>= :: UpAdptThd -> UpAdptThd -> Bool
$cmax :: UpAdptThd -> UpAdptThd -> UpAdptThd
max :: UpAdptThd -> UpAdptThd -> UpAdptThd
$cmin :: UpAdptThd -> UpAdptThd -> UpAdptThd
min :: UpAdptThd -> UpAdptThd -> UpAdptThd
Ord, Eq UpAdptThd
Eq UpAdptThd =>
(Int -> UpAdptThd -> Int)
-> (UpAdptThd -> Int) -> Hashable UpAdptThd
Int -> UpAdptThd -> Int
UpAdptThd -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> UpAdptThd -> Int
hashWithSalt :: Int -> UpAdptThd -> Int
$chash :: UpAdptThd -> Int
hash :: UpAdptThd -> Int
Hashable, Integer -> UpAdptThd
UpAdptThd -> UpAdptThd
UpAdptThd -> UpAdptThd -> UpAdptThd
(UpAdptThd -> UpAdptThd -> UpAdptThd)
-> (UpAdptThd -> UpAdptThd -> UpAdptThd)
-> (UpAdptThd -> UpAdptThd -> UpAdptThd)
-> (UpAdptThd -> UpAdptThd)
-> (UpAdptThd -> UpAdptThd)
-> (UpAdptThd -> UpAdptThd)
-> (Integer -> UpAdptThd)
-> Num UpAdptThd
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: UpAdptThd -> UpAdptThd -> UpAdptThd
+ :: UpAdptThd -> UpAdptThd -> UpAdptThd
$c- :: UpAdptThd -> UpAdptThd -> UpAdptThd
- :: UpAdptThd -> UpAdptThd -> UpAdptThd
$c* :: UpAdptThd -> UpAdptThd -> UpAdptThd
* :: UpAdptThd -> UpAdptThd -> UpAdptThd
$cnegate :: UpAdptThd -> UpAdptThd
negate :: UpAdptThd -> UpAdptThd
$cabs :: UpAdptThd -> UpAdptThd
abs :: UpAdptThd -> UpAdptThd
$csignum :: UpAdptThd -> UpAdptThd
signum :: UpAdptThd -> UpAdptThd
$cfromInteger :: Integer -> UpAdptThd
fromInteger :: Integer -> UpAdptThd
Num, Num UpAdptThd
Ord UpAdptThd
(Num UpAdptThd, Ord UpAdptThd) =>
(UpAdptThd -> Rational) -> Real UpAdptThd
UpAdptThd -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: UpAdptThd -> Rational
toRational :: UpAdptThd -> Rational
Real, Num UpAdptThd
Num UpAdptThd =>
(UpAdptThd -> UpAdptThd -> UpAdptThd)
-> (UpAdptThd -> UpAdptThd)
-> (Rational -> UpAdptThd)
-> Fractional UpAdptThd
Rational -> UpAdptThd
UpAdptThd -> UpAdptThd
UpAdptThd -> UpAdptThd -> UpAdptThd
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: UpAdptThd -> UpAdptThd -> UpAdptThd
/ :: UpAdptThd -> UpAdptThd -> UpAdptThd
$crecip :: UpAdptThd -> UpAdptThd
recip :: UpAdptThd -> UpAdptThd
$cfromRational :: Rational -> UpAdptThd
fromRational :: Rational -> UpAdptThd
Fractional, Fractional UpAdptThd
Real UpAdptThd
(Real UpAdptThd, Fractional UpAdptThd) =>
(forall b. Integral b => UpAdptThd -> (b, UpAdptThd))
-> (forall b. Integral b => UpAdptThd -> b)
-> (forall b. Integral b => UpAdptThd -> b)
-> (forall b. Integral b => UpAdptThd -> b)
-> (forall b. Integral b => UpAdptThd -> b)
-> RealFrac UpAdptThd
forall b. Integral b => UpAdptThd -> b
forall b. Integral b => UpAdptThd -> (b, UpAdptThd)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => UpAdptThd -> (b, UpAdptThd)
properFraction :: forall b. Integral b => UpAdptThd -> (b, UpAdptThd)
$ctruncate :: forall b. Integral b => UpAdptThd -> b
truncate :: forall b. Integral b => UpAdptThd -> b
$cround :: forall b. Integral b => UpAdptThd -> b
round :: forall b. Integral b => UpAdptThd -> b
$cceiling :: forall b. Integral b => UpAdptThd -> b
ceiling :: forall b. Integral b => UpAdptThd -> b
$cfloor :: forall b. Integral b => UpAdptThd -> b
floor :: forall b. Integral b => UpAdptThd -> b
RealFrac, Context -> UpAdptThd -> IO (Maybe ThunkInfo)
Proxy UpAdptThd -> String
(Context -> UpAdptThd -> IO (Maybe ThunkInfo))
-> (Context -> UpAdptThd -> IO (Maybe ThunkInfo))
-> (Proxy UpAdptThd -> String)
-> NoThunks UpAdptThd
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpAdptThd -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpAdptThd -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpAdptThd -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpAdptThd -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpAdptThd -> String
showTypeOf :: Proxy UpAdptThd -> String
NoThunks)
deriving anyclass (UpAdptThd -> Seq TypeRep
(UpAdptThd -> Seq TypeRep) -> HasTypeReps UpAdptThd
forall a. (a -> Seq TypeRep) -> HasTypeReps a
$ctypeReps :: UpAdptThd -> Seq TypeRep
typeReps :: UpAdptThd -> Seq TypeRep
HasTypeReps)
newtype BkSgnCntT = BkSgnCntT Double
deriving stock ((forall x. BkSgnCntT -> Rep BkSgnCntT x)
-> (forall x. Rep BkSgnCntT x -> BkSgnCntT) -> Generic BkSgnCntT
forall x. Rep BkSgnCntT x -> BkSgnCntT
forall x. BkSgnCntT -> Rep BkSgnCntT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BkSgnCntT -> Rep BkSgnCntT x
from :: forall x. BkSgnCntT -> Rep BkSgnCntT x
$cto :: forall x. Rep BkSgnCntT x -> BkSgnCntT
to :: forall x. Rep BkSgnCntT x -> BkSgnCntT
Generic, Int -> BkSgnCntT -> ShowS
[BkSgnCntT] -> ShowS
BkSgnCntT -> String
(Int -> BkSgnCntT -> ShowS)
-> (BkSgnCntT -> String)
-> ([BkSgnCntT] -> ShowS)
-> Show BkSgnCntT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BkSgnCntT -> ShowS
showsPrec :: Int -> BkSgnCntT -> ShowS
$cshow :: BkSgnCntT -> String
show :: BkSgnCntT -> String
$cshowList :: [BkSgnCntT] -> ShowS
showList :: [BkSgnCntT] -> ShowS
Show, Typeable BkSgnCntT
Typeable BkSgnCntT =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BkSgnCntT -> c BkSgnCntT)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BkSgnCntT)
-> (BkSgnCntT -> Constr)
-> (BkSgnCntT -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BkSgnCntT))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BkSgnCntT))
-> ((forall b. Data b => b -> b) -> BkSgnCntT -> BkSgnCntT)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r)
-> (forall u. (forall d. Data d => d -> u) -> BkSgnCntT -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> BkSgnCntT -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT)
-> Data BkSgnCntT
BkSgnCntT -> Constr
BkSgnCntT -> DataType
(forall b. Data b => b -> b) -> BkSgnCntT -> BkSgnCntT
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BkSgnCntT -> u
forall u. (forall d. Data d => d -> u) -> BkSgnCntT -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BkSgnCntT
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BkSgnCntT -> c BkSgnCntT
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BkSgnCntT)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BkSgnCntT)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BkSgnCntT -> c BkSgnCntT
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BkSgnCntT -> c BkSgnCntT
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BkSgnCntT
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BkSgnCntT
$ctoConstr :: BkSgnCntT -> Constr
toConstr :: BkSgnCntT -> Constr
$cdataTypeOf :: BkSgnCntT -> DataType
dataTypeOf :: BkSgnCntT -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BkSgnCntT)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BkSgnCntT)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BkSgnCntT)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BkSgnCntT)
$cgmapT :: (forall b. Data b => b -> b) -> BkSgnCntT -> BkSgnCntT
gmapT :: (forall b. Data b => b -> b) -> BkSgnCntT -> BkSgnCntT
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BkSgnCntT -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BkSgnCntT -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BkSgnCntT -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BkSgnCntT -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BkSgnCntT -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BkSgnCntT -> m BkSgnCntT
Data)
deriving newtype (BkSgnCntT -> BkSgnCntT -> Bool
(BkSgnCntT -> BkSgnCntT -> Bool)
-> (BkSgnCntT -> BkSgnCntT -> Bool) -> Eq BkSgnCntT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BkSgnCntT -> BkSgnCntT -> Bool
== :: BkSgnCntT -> BkSgnCntT -> Bool
$c/= :: BkSgnCntT -> BkSgnCntT -> Bool
/= :: BkSgnCntT -> BkSgnCntT -> Bool
Eq, Eq BkSgnCntT
Eq BkSgnCntT =>
(BkSgnCntT -> BkSgnCntT -> Ordering)
-> (BkSgnCntT -> BkSgnCntT -> Bool)
-> (BkSgnCntT -> BkSgnCntT -> Bool)
-> (BkSgnCntT -> BkSgnCntT -> Bool)
-> (BkSgnCntT -> BkSgnCntT -> Bool)
-> (BkSgnCntT -> BkSgnCntT -> BkSgnCntT)
-> (BkSgnCntT -> BkSgnCntT -> BkSgnCntT)
-> Ord BkSgnCntT
BkSgnCntT -> BkSgnCntT -> Bool
BkSgnCntT -> BkSgnCntT -> Ordering
BkSgnCntT -> BkSgnCntT -> BkSgnCntT
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BkSgnCntT -> BkSgnCntT -> Ordering
compare :: BkSgnCntT -> BkSgnCntT -> Ordering
$c< :: BkSgnCntT -> BkSgnCntT -> Bool
< :: BkSgnCntT -> BkSgnCntT -> Bool
$c<= :: BkSgnCntT -> BkSgnCntT -> Bool
<= :: BkSgnCntT -> BkSgnCntT -> Bool
$c> :: BkSgnCntT -> BkSgnCntT -> Bool
> :: BkSgnCntT -> BkSgnCntT -> Bool
$c>= :: BkSgnCntT -> BkSgnCntT -> Bool
>= :: BkSgnCntT -> BkSgnCntT -> Bool
$cmax :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
max :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
$cmin :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
min :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
Ord, Eq BkSgnCntT
Eq BkSgnCntT =>
(Int -> BkSgnCntT -> Int)
-> (BkSgnCntT -> Int) -> Hashable BkSgnCntT
Int -> BkSgnCntT -> Int
BkSgnCntT -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BkSgnCntT -> Int
hashWithSalt :: Int -> BkSgnCntT -> Int
$chash :: BkSgnCntT -> Int
hash :: BkSgnCntT -> Int
Hashable, Integer -> BkSgnCntT
BkSgnCntT -> BkSgnCntT
BkSgnCntT -> BkSgnCntT -> BkSgnCntT
(BkSgnCntT -> BkSgnCntT -> BkSgnCntT)
-> (BkSgnCntT -> BkSgnCntT -> BkSgnCntT)
-> (BkSgnCntT -> BkSgnCntT -> BkSgnCntT)
-> (BkSgnCntT -> BkSgnCntT)
-> (BkSgnCntT -> BkSgnCntT)
-> (BkSgnCntT -> BkSgnCntT)
-> (Integer -> BkSgnCntT)
-> Num BkSgnCntT
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
+ :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
$c- :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
- :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
$c* :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
* :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
$cnegate :: BkSgnCntT -> BkSgnCntT
negate :: BkSgnCntT -> BkSgnCntT
$cabs :: BkSgnCntT -> BkSgnCntT
abs :: BkSgnCntT -> BkSgnCntT
$csignum :: BkSgnCntT -> BkSgnCntT
signum :: BkSgnCntT -> BkSgnCntT
$cfromInteger :: Integer -> BkSgnCntT
fromInteger :: Integer -> BkSgnCntT
Num, Num BkSgnCntT
Num BkSgnCntT =>
(BkSgnCntT -> BkSgnCntT -> BkSgnCntT)
-> (BkSgnCntT -> BkSgnCntT)
-> (Rational -> BkSgnCntT)
-> Fractional BkSgnCntT
Rational -> BkSgnCntT
BkSgnCntT -> BkSgnCntT
BkSgnCntT -> BkSgnCntT -> BkSgnCntT
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
/ :: BkSgnCntT -> BkSgnCntT -> BkSgnCntT
$crecip :: BkSgnCntT -> BkSgnCntT
recip :: BkSgnCntT -> BkSgnCntT
$cfromRational :: Rational -> BkSgnCntT
fromRational :: Rational -> BkSgnCntT
Fractional, Context -> BkSgnCntT -> IO (Maybe ThunkInfo)
Proxy BkSgnCntT -> String
(Context -> BkSgnCntT -> IO (Maybe ThunkInfo))
-> (Context -> BkSgnCntT -> IO (Maybe ThunkInfo))
-> (Proxy BkSgnCntT -> String)
-> NoThunks BkSgnCntT
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> BkSgnCntT -> IO (Maybe ThunkInfo)
noThunks :: Context -> BkSgnCntT -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BkSgnCntT -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BkSgnCntT -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy BkSgnCntT -> String
showTypeOf :: Proxy BkSgnCntT -> String
NoThunks)
deriving anyclass (BkSgnCntT -> Seq TypeRep
(BkSgnCntT -> Seq TypeRep) -> HasTypeReps BkSgnCntT
forall a. (a -> Seq TypeRep) -> HasTypeReps a
$ctypeReps :: BkSgnCntT -> Seq TypeRep
typeReps :: BkSgnCntT -> Seq TypeRep
HasTypeReps)
data PParams = PParams
{ PParams -> Natural
_maxBkSz :: !Natural
, PParams -> Natural
_maxHdrSz :: !Natural
, PParams -> Natural
_maxTxSz :: !Natural
, PParams -> Natural
_maxPropSz :: !Natural
, PParams -> BkSgnCntT
_bkSgnCntT :: !BkSgnCntT
, PParams -> SlotCount
_bkSlotsPerEpoch :: !Core.SlotCount
, PParams -> SlotCount
_upTtl :: !Core.SlotCount
, PParams -> Natural
_scriptVersion :: !Natural
, PParams -> UpAdptThd
_upAdptThd :: !UpAdptThd
, PParams -> FactorA
_factorA :: !FactorA
, PParams -> FactorB
_factorB :: !FactorB
}
deriving (PParams -> PParams -> Bool
(PParams -> PParams -> Bool)
-> (PParams -> PParams -> Bool) -> Eq PParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PParams -> PParams -> Bool
== :: PParams -> PParams -> Bool
$c/= :: PParams -> PParams -> Bool
/= :: PParams -> PParams -> Bool
Eq, (forall x. PParams -> Rep PParams x)
-> (forall x. Rep PParams x -> PParams) -> Generic PParams
forall x. Rep PParams x -> PParams
forall x. PParams -> Rep PParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PParams -> Rep PParams x
from :: forall x. PParams -> Rep PParams x
$cto :: forall x. Rep PParams x -> PParams
to :: forall x. Rep PParams x -> PParams
Generic, Eq PParams
Eq PParams =>
(PParams -> PParams -> Ordering)
-> (PParams -> PParams -> Bool)
-> (PParams -> PParams -> Bool)
-> (PParams -> PParams -> Bool)
-> (PParams -> PParams -> Bool)
-> (PParams -> PParams -> PParams)
-> (PParams -> PParams -> PParams)
-> Ord PParams
PParams -> PParams -> Bool
PParams -> PParams -> Ordering
PParams -> PParams -> PParams
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PParams -> PParams -> Ordering
compare :: PParams -> PParams -> Ordering
$c< :: PParams -> PParams -> Bool
< :: PParams -> PParams -> Bool
$c<= :: PParams -> PParams -> Bool
<= :: PParams -> PParams -> Bool
$c> :: PParams -> PParams -> Bool
> :: PParams -> PParams -> Bool
$c>= :: PParams -> PParams -> Bool
>= :: PParams -> PParams -> Bool
$cmax :: PParams -> PParams -> PParams
max :: PParams -> PParams -> PParams
$cmin :: PParams -> PParams -> PParams
min :: PParams -> PParams -> PParams
Ord, Int -> PParams -> ShowS
[PParams] -> ShowS
PParams -> String
(Int -> PParams -> ShowS)
-> (PParams -> String) -> ([PParams] -> ShowS) -> Show PParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PParams -> ShowS
showsPrec :: Int -> PParams -> ShowS
$cshow :: PParams -> String
show :: PParams -> String
$cshowList :: [PParams] -> ShowS
showList :: [PParams] -> ShowS
Show, Eq PParams
Eq PParams =>
(Int -> PParams -> Int) -> (PParams -> Int) -> Hashable PParams
Int -> PParams -> Int
PParams -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PParams -> Int
hashWithSalt :: Int -> PParams -> Int
$chash :: PParams -> Int
hash :: PParams -> Int
Hashable, Typeable PParams
Typeable PParams =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PParams -> c PParams)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PParams)
-> (PParams -> Constr)
-> (PParams -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PParams))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PParams))
-> ((forall b. Data b => b -> b) -> PParams -> PParams)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r)
-> (forall u. (forall d. Data d => d -> u) -> PParams -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PParams -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams)
-> Data PParams
PParams -> Constr
PParams -> DataType
(forall b. Data b => b -> b) -> PParams -> PParams
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PParams -> u
forall u. (forall d. Data d => d -> u) -> PParams -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PParams
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PParams -> c PParams
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PParams)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PParams)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PParams -> c PParams
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PParams -> c PParams
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PParams
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PParams
$ctoConstr :: PParams -> Constr
toConstr :: PParams -> Constr
$cdataTypeOf :: PParams -> DataType
dataTypeOf :: PParams -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PParams)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PParams)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PParams)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PParams)
$cgmapT :: (forall b. Data b => b -> b) -> PParams -> PParams
gmapT :: (forall b. Data b => b -> b) -> PParams -> PParams
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PParams -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PParams -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PParams -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PParams -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PParams -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PParams -> m PParams
Data, Context -> PParams -> IO (Maybe ThunkInfo)
Proxy PParams -> String
(Context -> PParams -> IO (Maybe ThunkInfo))
-> (Context -> PParams -> IO (Maybe ThunkInfo))
-> (Proxy PParams -> String)
-> NoThunks PParams
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PParams -> IO (Maybe ThunkInfo)
noThunks :: Context -> PParams -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PParams -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PParams -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PParams -> String
showTypeOf :: Proxy PParams -> String
NoThunks)
makeLenses ''PParams
instance HasTypeReps PParams
newtype UpId = UpId Int
deriving stock ((forall x. UpId -> Rep UpId x)
-> (forall x. Rep UpId x -> UpId) -> Generic UpId
forall x. Rep UpId x -> UpId
forall x. UpId -> Rep UpId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpId -> Rep UpId x
from :: forall x. UpId -> Rep UpId x
$cto :: forall x. Rep UpId x -> UpId
to :: forall x. Rep UpId x -> UpId
Generic, Int -> UpId -> ShowS
[UpId] -> ShowS
UpId -> String
(Int -> UpId -> ShowS)
-> (UpId -> String) -> ([UpId] -> ShowS) -> Show UpId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpId -> ShowS
showsPrec :: Int -> UpId -> ShowS
$cshow :: UpId -> String
show :: UpId -> String
$cshowList :: [UpId] -> ShowS
showList :: [UpId] -> ShowS
Show, Typeable UpId
Typeable UpId =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpId -> c UpId)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpId)
-> (UpId -> Constr)
-> (UpId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpId))
-> ((forall b. Data b => b -> b) -> UpId -> UpId)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r)
-> (forall u. (forall d. Data d => d -> u) -> UpId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UpId -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId)
-> Data UpId
UpId -> Constr
UpId -> DataType
(forall b. Data b => b -> b) -> UpId -> UpId
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UpId -> u
forall u. (forall d. Data d => d -> u) -> UpId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpId -> c UpId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpId -> c UpId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpId -> c UpId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpId
$ctoConstr :: UpId -> Constr
toConstr :: UpId -> Constr
$cdataTypeOf :: UpId -> DataType
dataTypeOf :: UpId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpId)
$cgmapT :: (forall b. Data b => b -> b) -> UpId -> UpId
gmapT :: (forall b. Data b => b -> b) -> UpId -> UpId
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UpId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UpId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UpId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UpId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UpId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpId -> m UpId
Data)
deriving newtype (UpId -> UpId -> Bool
(UpId -> UpId -> Bool) -> (UpId -> UpId -> Bool) -> Eq UpId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpId -> UpId -> Bool
== :: UpId -> UpId -> Bool
$c/= :: UpId -> UpId -> Bool
/= :: UpId -> UpId -> Bool
Eq, Eq UpId
Eq UpId =>
(UpId -> UpId -> Ordering)
-> (UpId -> UpId -> Bool)
-> (UpId -> UpId -> Bool)
-> (UpId -> UpId -> Bool)
-> (UpId -> UpId -> Bool)
-> (UpId -> UpId -> UpId)
-> (UpId -> UpId -> UpId)
-> Ord UpId
UpId -> UpId -> Bool
UpId -> UpId -> Ordering
UpId -> UpId -> UpId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UpId -> UpId -> Ordering
compare :: UpId -> UpId -> Ordering
$c< :: UpId -> UpId -> Bool
< :: UpId -> UpId -> Bool
$c<= :: UpId -> UpId -> Bool
<= :: UpId -> UpId -> Bool
$c> :: UpId -> UpId -> Bool
> :: UpId -> UpId -> Bool
$c>= :: UpId -> UpId -> Bool
>= :: UpId -> UpId -> Bool
$cmax :: UpId -> UpId -> UpId
max :: UpId -> UpId -> UpId
$cmin :: UpId -> UpId -> UpId
min :: UpId -> UpId -> UpId
Ord, Eq UpId
Eq UpId => (Int -> UpId -> Int) -> (UpId -> Int) -> Hashable UpId
Int -> UpId -> Int
UpId -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> UpId -> Int
hashWithSalt :: Int -> UpId -> Int
$chash :: UpId -> Int
hash :: UpId -> Int
Hashable, Context -> UpId -> IO (Maybe ThunkInfo)
Proxy UpId -> String
(Context -> UpId -> IO (Maybe ThunkInfo))
-> (Context -> UpId -> IO (Maybe ThunkInfo))
-> (Proxy UpId -> String)
-> NoThunks UpId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpId -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpId -> String
showTypeOf :: Proxy UpId -> String
NoThunks)
deriving anyclass (UpId -> Seq TypeRep
(UpId -> Seq TypeRep) -> HasTypeReps UpId
forall a. (a -> Seq TypeRep) -> HasTypeReps a
$ctypeReps :: UpId -> Seq TypeRep
typeReps :: UpId -> Seq TypeRep
HasTypeReps)
data ProtVer = ProtVer
{ ProtVer -> Natural
_pvMaj :: Natural
, ProtVer -> Natural
_pvMin :: Natural
, ProtVer -> Natural
_pvAlt :: Natural
}
deriving (ProtVer -> ProtVer -> Bool
(ProtVer -> ProtVer -> Bool)
-> (ProtVer -> ProtVer -> Bool) -> Eq ProtVer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtVer -> ProtVer -> Bool
== :: ProtVer -> ProtVer -> Bool
$c/= :: ProtVer -> ProtVer -> Bool
/= :: ProtVer -> ProtVer -> Bool
Eq, (forall x. ProtVer -> Rep ProtVer x)
-> (forall x. Rep ProtVer x -> ProtVer) -> Generic ProtVer
forall x. Rep ProtVer x -> ProtVer
forall x. ProtVer -> Rep ProtVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProtVer -> Rep ProtVer x
from :: forall x. ProtVer -> Rep ProtVer x
$cto :: forall x. Rep ProtVer x -> ProtVer
to :: forall x. Rep ProtVer x -> ProtVer
Generic, Eq ProtVer
Eq ProtVer =>
(ProtVer -> ProtVer -> Ordering)
-> (ProtVer -> ProtVer -> Bool)
-> (ProtVer -> ProtVer -> Bool)
-> (ProtVer -> ProtVer -> Bool)
-> (ProtVer -> ProtVer -> Bool)
-> (ProtVer -> ProtVer -> ProtVer)
-> (ProtVer -> ProtVer -> ProtVer)
-> Ord ProtVer
ProtVer -> ProtVer -> Bool
ProtVer -> ProtVer -> Ordering
ProtVer -> ProtVer -> ProtVer
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProtVer -> ProtVer -> Ordering
compare :: ProtVer -> ProtVer -> Ordering
$c< :: ProtVer -> ProtVer -> Bool
< :: ProtVer -> ProtVer -> Bool
$c<= :: ProtVer -> ProtVer -> Bool
<= :: ProtVer -> ProtVer -> Bool
$c> :: ProtVer -> ProtVer -> Bool
> :: ProtVer -> ProtVer -> Bool
$c>= :: ProtVer -> ProtVer -> Bool
>= :: ProtVer -> ProtVer -> Bool
$cmax :: ProtVer -> ProtVer -> ProtVer
max :: ProtVer -> ProtVer -> ProtVer
$cmin :: ProtVer -> ProtVer -> ProtVer
min :: ProtVer -> ProtVer -> ProtVer
Ord, Int -> ProtVer -> ShowS
[ProtVer] -> ShowS
ProtVer -> String
(Int -> ProtVer -> ShowS)
-> (ProtVer -> String) -> ([ProtVer] -> ShowS) -> Show ProtVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtVer -> ShowS
showsPrec :: Int -> ProtVer -> ShowS
$cshow :: ProtVer -> String
show :: ProtVer -> String
$cshowList :: [ProtVer] -> ShowS
showList :: [ProtVer] -> ShowS
Show, Eq ProtVer
Eq ProtVer =>
(Int -> ProtVer -> Int) -> (ProtVer -> Int) -> Hashable ProtVer
Int -> ProtVer -> Int
ProtVer -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ProtVer -> Int
hashWithSalt :: Int -> ProtVer -> Int
$chash :: ProtVer -> Int
hash :: ProtVer -> Int
Hashable, Typeable ProtVer
Typeable ProtVer =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProtVer -> c ProtVer)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProtVer)
-> (ProtVer -> Constr)
-> (ProtVer -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProtVer))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProtVer))
-> ((forall b. Data b => b -> b) -> ProtVer -> ProtVer)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r)
-> (forall u. (forall d. Data d => d -> u) -> ProtVer -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ProtVer -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer)
-> Data ProtVer
ProtVer -> Constr
ProtVer -> DataType
(forall b. Data b => b -> b) -> ProtVer -> ProtVer
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ProtVer -> u
forall u. (forall d. Data d => d -> u) -> ProtVer -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProtVer
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProtVer -> c ProtVer
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProtVer)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProtVer)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProtVer -> c ProtVer
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProtVer -> c ProtVer
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProtVer
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProtVer
$ctoConstr :: ProtVer -> Constr
toConstr :: ProtVer -> Constr
$cdataTypeOf :: ProtVer -> DataType
dataTypeOf :: ProtVer -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProtVer)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProtVer)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProtVer)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProtVer)
$cgmapT :: (forall b. Data b => b -> b) -> ProtVer -> ProtVer
gmapT :: (forall b. Data b => b -> b) -> ProtVer -> ProtVer
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProtVer -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ProtVer -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ProtVer -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProtVer -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProtVer -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProtVer -> m ProtVer
Data, Context -> ProtVer -> IO (Maybe ThunkInfo)
Proxy ProtVer -> String
(Context -> ProtVer -> IO (Maybe ThunkInfo))
-> (Context -> ProtVer -> IO (Maybe ThunkInfo))
-> (Proxy ProtVer -> String)
-> NoThunks ProtVer
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ProtVer -> IO (Maybe ThunkInfo)
noThunks :: Context -> ProtVer -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ProtVer -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ProtVer -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ProtVer -> String
showTypeOf :: Proxy ProtVer -> String
NoThunks)
makeLenses ''ProtVer
instance HasTypeReps ProtVer
newtype ApName = ApName String
deriving stock ((forall x. ApName -> Rep ApName x)
-> (forall x. Rep ApName x -> ApName) -> Generic ApName
forall x. Rep ApName x -> ApName
forall x. ApName -> Rep ApName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ApName -> Rep ApName x
from :: forall x. ApName -> Rep ApName x
$cto :: forall x. Rep ApName x -> ApName
to :: forall x. Rep ApName x -> ApName
Generic, Int -> ApName -> ShowS
[ApName] -> ShowS
ApName -> String
(Int -> ApName -> ShowS)
-> (ApName -> String) -> ([ApName] -> ShowS) -> Show ApName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApName -> ShowS
showsPrec :: Int -> ApName -> ShowS
$cshow :: ApName -> String
show :: ApName -> String
$cshowList :: [ApName] -> ShowS
showList :: [ApName] -> ShowS
Show, Typeable ApName
Typeable ApName =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApName -> c ApName)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApName)
-> (ApName -> Constr)
-> (ApName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApName))
-> ((forall b. Data b => b -> b) -> ApName -> ApName)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ApName -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ApName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ApName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ApName -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName)
-> Data ApName
ApName -> Constr
ApName -> DataType
(forall b. Data b => b -> b) -> ApName -> ApName
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ApName -> u
forall u. (forall d. Data d => d -> u) -> ApName -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ApName -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ApName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApName -> c ApName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApName -> c ApName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApName -> c ApName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApName
$ctoConstr :: ApName -> Constr
toConstr :: ApName -> Constr
$cdataTypeOf :: ApName -> DataType
dataTypeOf :: ApName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApName)
$cgmapT :: (forall b. Data b => b -> b) -> ApName -> ApName
gmapT :: (forall b. Data b => b -> b) -> ApName -> ApName
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ApName -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ApName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ApName -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ApName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ApName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ApName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApName -> m ApName
Data)
deriving newtype (ApName -> ApName -> Bool
(ApName -> ApName -> Bool)
-> (ApName -> ApName -> Bool) -> Eq ApName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApName -> ApName -> Bool
== :: ApName -> ApName -> Bool
$c/= :: ApName -> ApName -> Bool
/= :: ApName -> ApName -> Bool
Eq, Eq ApName
Eq ApName =>
(ApName -> ApName -> Ordering)
-> (ApName -> ApName -> Bool)
-> (ApName -> ApName -> Bool)
-> (ApName -> ApName -> Bool)
-> (ApName -> ApName -> Bool)
-> (ApName -> ApName -> ApName)
-> (ApName -> ApName -> ApName)
-> Ord ApName
ApName -> ApName -> Bool
ApName -> ApName -> Ordering
ApName -> ApName -> ApName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ApName -> ApName -> Ordering
compare :: ApName -> ApName -> Ordering
$c< :: ApName -> ApName -> Bool
< :: ApName -> ApName -> Bool
$c<= :: ApName -> ApName -> Bool
<= :: ApName -> ApName -> Bool
$c> :: ApName -> ApName -> Bool
> :: ApName -> ApName -> Bool
$c>= :: ApName -> ApName -> Bool
>= :: ApName -> ApName -> Bool
$cmax :: ApName -> ApName -> ApName
max :: ApName -> ApName -> ApName
$cmin :: ApName -> ApName -> ApName
min :: ApName -> ApName -> ApName
Ord, Eq ApName
Eq ApName =>
(Int -> ApName -> Int) -> (ApName -> Int) -> Hashable ApName
Int -> ApName -> Int
ApName -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ApName -> Int
hashWithSalt :: Int -> ApName -> Int
$chash :: ApName -> Int
hash :: ApName -> Int
Hashable, Context -> ApName -> IO (Maybe ThunkInfo)
Proxy ApName -> String
(Context -> ApName -> IO (Maybe ThunkInfo))
-> (Context -> ApName -> IO (Maybe ThunkInfo))
-> (Proxy ApName -> String)
-> NoThunks ApName
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ApName -> IO (Maybe ThunkInfo)
noThunks :: Context -> ApName -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ApName -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ApName -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ApName -> String
showTypeOf :: Proxy ApName -> String
NoThunks)
instance HasTypeReps ApName
newtype ApVer = ApVer Natural
deriving stock ((forall x. ApVer -> Rep ApVer x)
-> (forall x. Rep ApVer x -> ApVer) -> Generic ApVer
forall x. Rep ApVer x -> ApVer
forall x. ApVer -> Rep ApVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ApVer -> Rep ApVer x
from :: forall x. ApVer -> Rep ApVer x
$cto :: forall x. Rep ApVer x -> ApVer
to :: forall x. Rep ApVer x -> ApVer
Generic, Int -> ApVer -> ShowS
[ApVer] -> ShowS
ApVer -> String
(Int -> ApVer -> ShowS)
-> (ApVer -> String) -> ([ApVer] -> ShowS) -> Show ApVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApVer -> ShowS
showsPrec :: Int -> ApVer -> ShowS
$cshow :: ApVer -> String
show :: ApVer -> String
$cshowList :: [ApVer] -> ShowS
showList :: [ApVer] -> ShowS
Show, Typeable ApVer
Typeable ApVer =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApVer -> c ApVer)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApVer)
-> (ApVer -> Constr)
-> (ApVer -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApVer))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApVer))
-> ((forall b. Data b => b -> b) -> ApVer -> ApVer)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r)
-> (forall u. (forall d. Data d => d -> u) -> ApVer -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ApVer -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer)
-> Data ApVer
ApVer -> Constr
ApVer -> DataType
(forall b. Data b => b -> b) -> ApVer -> ApVer
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ApVer -> u
forall u. (forall d. Data d => d -> u) -> ApVer -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApVer
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApVer -> c ApVer
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApVer)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApVer)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApVer -> c ApVer
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ApVer -> c ApVer
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApVer
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApVer
$ctoConstr :: ApVer -> Constr
toConstr :: ApVer -> Constr
$cdataTypeOf :: ApVer -> DataType
dataTypeOf :: ApVer -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApVer)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ApVer)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApVer)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ApVer)
$cgmapT :: (forall b. Data b => b -> b) -> ApVer -> ApVer
gmapT :: (forall b. Data b => b -> b) -> ApVer -> ApVer
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ApVer -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ApVer -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ApVer -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApVer -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ApVer -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ApVer -> m ApVer
Data)
deriving newtype (ApVer -> ApVer -> Bool
(ApVer -> ApVer -> Bool) -> (ApVer -> ApVer -> Bool) -> Eq ApVer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApVer -> ApVer -> Bool
== :: ApVer -> ApVer -> Bool
$c/= :: ApVer -> ApVer -> Bool
/= :: ApVer -> ApVer -> Bool
Eq, Eq ApVer
Eq ApVer =>
(ApVer -> ApVer -> Ordering)
-> (ApVer -> ApVer -> Bool)
-> (ApVer -> ApVer -> Bool)
-> (ApVer -> ApVer -> Bool)
-> (ApVer -> ApVer -> Bool)
-> (ApVer -> ApVer -> ApVer)
-> (ApVer -> ApVer -> ApVer)
-> Ord ApVer
ApVer -> ApVer -> Bool
ApVer -> ApVer -> Ordering
ApVer -> ApVer -> ApVer
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ApVer -> ApVer -> Ordering
compare :: ApVer -> ApVer -> Ordering
$c< :: ApVer -> ApVer -> Bool
< :: ApVer -> ApVer -> Bool
$c<= :: ApVer -> ApVer -> Bool
<= :: ApVer -> ApVer -> Bool
$c> :: ApVer -> ApVer -> Bool
> :: ApVer -> ApVer -> Bool
$c>= :: ApVer -> ApVer -> Bool
>= :: ApVer -> ApVer -> Bool
$cmax :: ApVer -> ApVer -> ApVer
max :: ApVer -> ApVer -> ApVer
$cmin :: ApVer -> ApVer -> ApVer
min :: ApVer -> ApVer -> ApVer
Ord, Integer -> ApVer
ApVer -> ApVer
ApVer -> ApVer -> ApVer
(ApVer -> ApVer -> ApVer)
-> (ApVer -> ApVer -> ApVer)
-> (ApVer -> ApVer -> ApVer)
-> (ApVer -> ApVer)
-> (ApVer -> ApVer)
-> (ApVer -> ApVer)
-> (Integer -> ApVer)
-> Num ApVer
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ApVer -> ApVer -> ApVer
+ :: ApVer -> ApVer -> ApVer
$c- :: ApVer -> ApVer -> ApVer
- :: ApVer -> ApVer -> ApVer
$c* :: ApVer -> ApVer -> ApVer
* :: ApVer -> ApVer -> ApVer
$cnegate :: ApVer -> ApVer
negate :: ApVer -> ApVer
$cabs :: ApVer -> ApVer
abs :: ApVer -> ApVer
$csignum :: ApVer -> ApVer
signum :: ApVer -> ApVer
$cfromInteger :: Integer -> ApVer
fromInteger :: Integer -> ApVer
Num, Eq ApVer
Eq ApVer =>
(Int -> ApVer -> Int) -> (ApVer -> Int) -> Hashable ApVer
Int -> ApVer -> Int
ApVer -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ApVer -> Int
hashWithSalt :: Int -> ApVer -> Int
$chash :: ApVer -> Int
hash :: ApVer -> Int
Hashable, Context -> ApVer -> IO (Maybe ThunkInfo)
Proxy ApVer -> String
(Context -> ApVer -> IO (Maybe ThunkInfo))
-> (Context -> ApVer -> IO (Maybe ThunkInfo))
-> (Proxy ApVer -> String)
-> NoThunks ApVer
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ApVer -> IO (Maybe ThunkInfo)
noThunks :: Context -> ApVer -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ApVer -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ApVer -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ApVer -> String
showTypeOf :: Proxy ApVer -> String
NoThunks)
instance HasTypeReps ApVer
data SwVer = SwVer
{ SwVer -> ApName
_svName :: ApName
, SwVer -> ApVer
_svVer :: ApVer
}
deriving (SwVer -> SwVer -> Bool
(SwVer -> SwVer -> Bool) -> (SwVer -> SwVer -> Bool) -> Eq SwVer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwVer -> SwVer -> Bool
== :: SwVer -> SwVer -> Bool
$c/= :: SwVer -> SwVer -> Bool
/= :: SwVer -> SwVer -> Bool
Eq, (forall x. SwVer -> Rep SwVer x)
-> (forall x. Rep SwVer x -> SwVer) -> Generic SwVer
forall x. Rep SwVer x -> SwVer
forall x. SwVer -> Rep SwVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SwVer -> Rep SwVer x
from :: forall x. SwVer -> Rep SwVer x
$cto :: forall x. Rep SwVer x -> SwVer
to :: forall x. Rep SwVer x -> SwVer
Generic, Int -> SwVer -> ShowS
[SwVer] -> ShowS
SwVer -> String
(Int -> SwVer -> ShowS)
-> (SwVer -> String) -> ([SwVer] -> ShowS) -> Show SwVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SwVer -> ShowS
showsPrec :: Int -> SwVer -> ShowS
$cshow :: SwVer -> String
show :: SwVer -> String
$cshowList :: [SwVer] -> ShowS
showList :: [SwVer] -> ShowS
Show, Eq SwVer
Eq SwVer =>
(Int -> SwVer -> Int) -> (SwVer -> Int) -> Hashable SwVer
Int -> SwVer -> Int
SwVer -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SwVer -> Int
hashWithSalt :: Int -> SwVer -> Int
$chash :: SwVer -> Int
hash :: SwVer -> Int
Hashable, Typeable SwVer
Typeable SwVer =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SwVer -> c SwVer)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SwVer)
-> (SwVer -> Constr)
-> (SwVer -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SwVer))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SwVer))
-> ((forall b. Data b => b -> b) -> SwVer -> SwVer)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r)
-> (forall u. (forall d. Data d => d -> u) -> SwVer -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SwVer -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer)
-> Data SwVer
SwVer -> Constr
SwVer -> DataType
(forall b. Data b => b -> b) -> SwVer -> SwVer
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SwVer -> u
forall u. (forall d. Data d => d -> u) -> SwVer -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SwVer
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SwVer -> c SwVer
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SwVer)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SwVer)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SwVer -> c SwVer
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SwVer -> c SwVer
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SwVer
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SwVer
$ctoConstr :: SwVer -> Constr
toConstr :: SwVer -> Constr
$cdataTypeOf :: SwVer -> DataType
dataTypeOf :: SwVer -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SwVer)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SwVer)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SwVer)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SwVer)
$cgmapT :: (forall b. Data b => b -> b) -> SwVer -> SwVer
gmapT :: (forall b. Data b => b -> b) -> SwVer -> SwVer
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SwVer -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SwVer -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SwVer -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SwVer -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SwVer -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwVer -> m SwVer
Data, Context -> SwVer -> IO (Maybe ThunkInfo)
Proxy SwVer -> String
(Context -> SwVer -> IO (Maybe ThunkInfo))
-> (Context -> SwVer -> IO (Maybe ThunkInfo))
-> (Proxy SwVer -> String)
-> NoThunks SwVer
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SwVer -> IO (Maybe ThunkInfo)
noThunks :: Context -> SwVer -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SwVer -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SwVer -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SwVer -> String
showTypeOf :: Proxy SwVer -> String
NoThunks)
makeLenses ''SwVer
instance HasTypeReps SwVer
type UpSD =
( ProtVer
, PParams
, SwVer
, Set STag
, Metadata
)
type STag = String
data Metadata = Metadata
deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: Metadata -> Metadata -> Bool
Eq, Eq Metadata
Eq Metadata =>
(Metadata -> Metadata -> Ordering)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Metadata)
-> (Metadata -> Metadata -> Metadata)
-> Ord Metadata
Metadata -> Metadata -> Bool
Metadata -> Metadata -> Ordering
Metadata -> Metadata -> Metadata
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Metadata -> Metadata -> Ordering
compare :: Metadata -> Metadata -> Ordering
$c< :: Metadata -> Metadata -> Bool
< :: Metadata -> Metadata -> Bool
$c<= :: Metadata -> Metadata -> Bool
<= :: Metadata -> Metadata -> Bool
$c> :: Metadata -> Metadata -> Bool
> :: Metadata -> Metadata -> Bool
$c>= :: Metadata -> Metadata -> Bool
>= :: Metadata -> Metadata -> Bool
$cmax :: Metadata -> Metadata -> Metadata
max :: Metadata -> Metadata -> Metadata
$cmin :: Metadata -> Metadata -> Metadata
min :: Metadata -> Metadata -> Metadata
Ord, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show, (forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metadata -> Rep Metadata x
from :: forall x. Metadata -> Rep Metadata x
$cto :: forall x. Rep Metadata x -> Metadata
to :: forall x. Rep Metadata x -> Metadata
Generic, Eq Metadata
Eq Metadata =>
(Int -> Metadata -> Int) -> (Metadata -> Int) -> Hashable Metadata
Int -> Metadata -> Int
Metadata -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Metadata -> Int
hashWithSalt :: Int -> Metadata -> Int
$chash :: Metadata -> Int
hash :: Metadata -> Int
Hashable, Typeable Metadata
Typeable Metadata =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Metadata -> c Metadata)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Metadata)
-> (Metadata -> Constr)
-> (Metadata -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Metadata))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Metadata))
-> ((forall b. Data b => b -> b) -> Metadata -> Metadata)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r)
-> (forall u. (forall d. Data d => d -> u) -> Metadata -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Metadata -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata)
-> Data Metadata
Metadata -> Constr
Metadata -> DataType
(forall b. Data b => b -> b) -> Metadata -> Metadata
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Metadata -> u
forall u. (forall d. Data d => d -> u) -> Metadata -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Metadata
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Metadata -> c Metadata
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Metadata)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Metadata)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Metadata -> c Metadata
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Metadata -> c Metadata
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Metadata
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Metadata
$ctoConstr :: Metadata -> Constr
toConstr :: Metadata -> Constr
$cdataTypeOf :: Metadata -> DataType
dataTypeOf :: Metadata -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Metadata)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Metadata)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Metadata)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Metadata)
$cgmapT :: (forall b. Data b => b -> b) -> Metadata -> Metadata
gmapT :: (forall b. Data b => b -> b) -> Metadata -> Metadata
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Metadata -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Metadata -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Metadata -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Metadata -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Metadata -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Metadata -> m Metadata
Data, Context -> Metadata -> IO (Maybe ThunkInfo)
Proxy Metadata -> String
(Context -> Metadata -> IO (Maybe ThunkInfo))
-> (Context -> Metadata -> IO (Maybe ThunkInfo))
-> (Proxy Metadata -> String)
-> NoThunks Metadata
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Metadata -> IO (Maybe ThunkInfo)
noThunks :: Context -> Metadata -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Metadata -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Metadata -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Metadata -> String
showTypeOf :: Proxy Metadata -> String
NoThunks)
data UProp = UProp
{ UProp -> UpId
_upId :: UpId
, UProp -> VKey
_upIssuer :: Core.VKey
, UProp -> PParams
_upParams :: PParams
, UProp -> ProtVer
_upPV :: ProtVer
, UProp -> SwVer
_upSwVer :: SwVer
, UProp -> Sig UpSD
_upSig :: Core.Sig UpSD
, UProp -> Set String
_upSTags :: Set STag
, UProp -> Metadata
_upMdt :: Metadata
}
deriving (UProp -> UProp -> Bool
(UProp -> UProp -> Bool) -> (UProp -> UProp -> Bool) -> Eq UProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UProp -> UProp -> Bool
== :: UProp -> UProp -> Bool
$c/= :: UProp -> UProp -> Bool
/= :: UProp -> UProp -> Bool
Eq, (forall x. UProp -> Rep UProp x)
-> (forall x. Rep UProp x -> UProp) -> Generic UProp
forall x. Rep UProp x -> UProp
forall x. UProp -> Rep UProp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UProp -> Rep UProp x
from :: forall x. UProp -> Rep UProp x
$cto :: forall x. Rep UProp x -> UProp
to :: forall x. Rep UProp x -> UProp
Generic, Int -> UProp -> ShowS
[UProp] -> ShowS
UProp -> String
(Int -> UProp -> ShowS)
-> (UProp -> String) -> ([UProp] -> ShowS) -> Show UProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UProp -> ShowS
showsPrec :: Int -> UProp -> ShowS
$cshow :: UProp -> String
show :: UProp -> String
$cshowList :: [UProp] -> ShowS
showList :: [UProp] -> ShowS
Show, Eq UProp
Eq UProp =>
(Int -> UProp -> Int) -> (UProp -> Int) -> Hashable UProp
Int -> UProp -> Int
UProp -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> UProp -> Int
hashWithSalt :: Int -> UProp -> Int
$chash :: UProp -> Int
hash :: UProp -> Int
Hashable, Typeable UProp
Typeable UProp =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UProp -> c UProp)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UProp)
-> (UProp -> Constr)
-> (UProp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UProp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UProp))
-> ((forall b. Data b => b -> b) -> UProp -> UProp)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r)
-> (forall u. (forall d. Data d => d -> u) -> UProp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UProp -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp)
-> Data UProp
UProp -> Constr
UProp -> DataType
(forall b. Data b => b -> b) -> UProp -> UProp
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UProp -> u
forall u. (forall d. Data d => d -> u) -> UProp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UProp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UProp -> c UProp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UProp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UProp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UProp -> c UProp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UProp -> c UProp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UProp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UProp
$ctoConstr :: UProp -> Constr
toConstr :: UProp -> Constr
$cdataTypeOf :: UProp -> DataType
dataTypeOf :: UProp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UProp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UProp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UProp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UProp)
$cgmapT :: (forall b. Data b => b -> b) -> UProp -> UProp
gmapT :: (forall b. Data b => b -> b) -> UProp -> UProp
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UProp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UProp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UProp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UProp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UProp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UProp -> m UProp
Data, Context -> UProp -> IO (Maybe ThunkInfo)
Proxy UProp -> String
(Context -> UProp -> IO (Maybe ThunkInfo))
-> (Context -> UProp -> IO (Maybe ThunkInfo))
-> (Proxy UProp -> String)
-> NoThunks UProp
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UProp -> IO (Maybe ThunkInfo)
noThunks :: Context -> UProp -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UProp -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UProp -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UProp -> String
showTypeOf :: Proxy UProp -> String
NoThunks)
#if MIN_VERSION_hashable(1,3,4)
#else
instance Hashable a => Hashable (Set a) where
hashWithSalt = H.hashUsing Set.toList
#endif
makeLenses ''UProp
upSigData :: Lens' UProp UpSD
upSigData :: Lens' UProp UpSD
upSigData =
(UProp -> UpSD) -> (UProp -> UpSD -> UProp) -> Lens' UProp UpSD
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(\UProp
up -> (UProp
up UProp -> Getting ProtVer UProp ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer UProp ProtVer
Lens' UProp ProtVer
upPV, UProp
up UProp -> Getting PParams UProp PParams -> PParams
forall s a. s -> Getting a s a -> a
^. Getting PParams UProp PParams
Lens' UProp PParams
upParams, UProp
up UProp -> Getting SwVer UProp SwVer -> SwVer
forall s a. s -> Getting a s a -> a
^. Getting SwVer UProp SwVer
Lens' UProp SwVer
upSwVer, UProp
up UProp -> Getting (Set String) UProp (Set String) -> Set String
forall s a. s -> Getting a s a -> a
^. Getting (Set String) UProp (Set String)
Lens' UProp (Set String)
upSTags, UProp
up UProp -> Getting Metadata UProp Metadata -> Metadata
forall s a. s -> Getting a s a -> a
^. Getting Metadata UProp Metadata
Lens' UProp Metadata
upMdt))
( \UProp
up (ProtVer
pv, PParams
pps, SwVer
sv, Set String
stags, Metadata
mdt) ->
UProp
up
UProp -> (UProp -> UProp) -> UProp
forall a b. a -> (a -> b) -> b
& (PParams -> Identity PParams) -> UProp -> Identity UProp
Lens' UProp PParams
upParams ((PParams -> Identity PParams) -> UProp -> Identity UProp)
-> PParams -> UProp -> UProp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams
pps
UProp -> (UProp -> UProp) -> UProp
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer) -> UProp -> Identity UProp
Lens' UProp ProtVer
upPV ((ProtVer -> Identity ProtVer) -> UProp -> Identity UProp)
-> ProtVer -> UProp -> UProp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
pv
UProp -> (UProp -> UProp) -> UProp
forall a b. a -> (a -> b) -> b
& (SwVer -> Identity SwVer) -> UProp -> Identity UProp
Lens' UProp SwVer
upSwVer ((SwVer -> Identity SwVer) -> UProp -> Identity UProp)
-> SwVer -> UProp -> UProp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SwVer
sv
UProp -> (UProp -> UProp) -> UProp
forall a b. a -> (a -> b) -> b
& (Set String -> Identity (Set String)) -> UProp -> Identity UProp
Lens' UProp (Set String)
upSTags ((Set String -> Identity (Set String)) -> UProp -> Identity UProp)
-> Set String -> UProp -> UProp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set String
stags
UProp -> (UProp -> UProp) -> UProp
forall a b. a -> (a -> b) -> b
& (Metadata -> Identity Metadata) -> UProp -> Identity UProp
Lens' UProp Metadata
upMdt ((Metadata -> Identity Metadata) -> UProp -> Identity UProp)
-> Metadata -> UProp -> UProp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Metadata
mdt
)
getUpSigData :: UProp -> UpSD
getUpSigData :: UProp -> UpSD
getUpSigData = Getting UpSD UProp UpSD -> UProp -> UpSD
forall a s. Getting a s a -> s -> a
view Getting UpSD UProp UpSD
Lens' UProp UpSD
upSigData
mkUProp ::
UpId ->
Core.VKey ->
ProtVer ->
PParams ->
SwVer ->
Set STag ->
Metadata ->
UProp
mkUProp :: UpId
-> VKey
-> ProtVer
-> PParams
-> SwVer
-> Set String
-> Metadata
-> UProp
mkUProp UpId
aUpId VKey
issuer ProtVer
pv PParams
pps SwVer
sv Set String
stags Metadata
mdt = UProp
uprop
where
uprop :: UProp
uprop =
UProp
{ _upId :: UpId
_upId = UpId
aUpId
, _upIssuer :: VKey
_upIssuer = VKey
issuer
, _upParams :: PParams
_upParams = PParams
pps
, _upPV :: ProtVer
_upPV = ProtVer
pv
, _upSwVer :: SwVer
_upSwVer = SwVer
sv
, _upSig :: Sig UpSD
_upSig = SKey -> UpSD -> Sig UpSD
forall a. SKey -> a -> Sig a
Core.sign (VKey -> SKey
skey VKey
issuer) (UProp
uprop UProp -> Getting UpSD UProp UpSD -> UpSD
forall s a. s -> Getting a s a -> a
^. Getting UpSD UProp UpSD
Lens' UProp UpSD
upSigData)
, _upSTags :: Set String
_upSTags = Set String
stags
, _upMdt :: Metadata
_upMdt = Metadata
mdt
}
instance HasTypeReps (ProtVer, PParams, SwVer, Set STag, Metadata)
instance HasTypeReps Metadata
instance HasTypeReps UProp
inMap :: (Ord key, Eq v) => key -> v -> Map key v -> Bool
inMap :: forall key v. (Ord key, Eq v) => key -> v -> Map key v -> Bool
inMap key
key v
v Map key v
m = case key -> Map key v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key v
m of
Just v
x | v
x v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v -> Bool
True
Maybe v
_ -> Bool
False
invertMap ::
(Ord k, Ord v) =>
Map k v ->
Map v (Set k)
invertMap :: forall k v. (Ord k, Ord v) => Map k v -> Map v (Set k)
invertMap =
(Set k -> Set k -> Set k) -> [(v, Set k)] -> Map v (Set k)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (Set k -> Set k -> Set k
forall a. Ord a => Set a -> Set a -> Set a
Set.union)
([(v, Set k)] -> Map v (Set k))
-> (Map k v -> [(v, Set k)]) -> Map k v -> Map v (Set k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (v, Set k)) -> [(k, v)] -> [(v, Set k)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((k -> Set k) -> (v, k) -> (v, Set k)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k -> Set k
forall a. a -> Set a
Set.singleton ((v, k) -> (v, Set k))
-> ((k, v) -> (v, k)) -> (k, v) -> (v, Set k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, v) -> (v, k)
forall a b. (a, b) -> (b, a)
swap)
([(k, v)] -> [(v, Set k)])
-> (Map k v -> [(k, v)]) -> Map k v -> [(v, Set k)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList
invertBijection ::
Ord v =>
Map k v ->
Map v k
invertBijection :: forall v k. Ord v => Map k v -> Map v k
invertBijection =
(k -> k -> k) -> [(v, k)] -> Map v k
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith k -> k -> k
forall a b. a -> b -> a
const
([(v, k)] -> Map v k)
-> (Map k v -> [(v, k)]) -> Map k v -> Map v k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (v, k)) -> [(k, v)] -> [(v, k)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v) -> (v, k)
forall a b. (a, b) -> (b, a)
swap
([(k, v)] -> [(v, k)])
-> (Map k v -> [(k, v)]) -> Map k v -> [(v, k)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList
(==>) :: Bool -> Bool -> Bool
Bool
a ==> :: Bool -> Bool -> Bool
==> Bool
b = Bool -> Bool
not Bool
a Bool -> Bool -> Bool
|| Bool
b
infix 1 ==>
pvCanFollow ::
ProtVer ->
ProtVer ->
Bool
pvCanFollow :: ProtVer -> ProtVer -> Bool
pvCanFollow (ProtVer Natural
mjn Natural
mn Natural
an) (ProtVer Natural
mjp Natural
mip Natural
ap) =
(Natural
mjp, Natural
mip, Natural
ap) (Natural, Natural, Natural) -> (Natural, Natural, Natural) -> Bool
forall a. Ord a => a -> a -> Bool
< (Natural
mjn, Natural
mn, Natural
an)
Bool -> Bool -> Bool
&& ((Natural, Natural) -> Natural -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Natural
0, Natural
1) (Natural
mjn Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
mjp))
Bool -> Bool -> Bool
&& ((Natural
mjp Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
mjn) Bool -> Bool -> Bool
==> (Natural
mip Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
mn))
Bool -> Bool -> Bool
&& ((Natural
mjp Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
mjn) Bool -> Bool -> Bool
==> (Natural
mn Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0))
checkUpdateConstraints ::
PParams ->
UProp ->
[UpdateConstraintViolation]
checkUpdateConstraints :: PParams -> UProp -> [UpdateConstraintViolation]
checkUpdateConstraints PParams
pps UProp
prop =
[Maybe UpdateConstraintViolation] -> [UpdateConstraintViolation]
forall a. [Maybe a] -> [a]
catMaybes
[ (UProp
prop UProp -> Getting Natural UProp Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (PParams -> Const Natural PParams) -> UProp -> Const Natural UProp
Lens' UProp PParams
upParams ((PParams -> Const Natural PParams)
-> UProp -> Const Natural UProp)
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Getting Natural UProp Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
maxBkSz Natural -> Natural -> Maybe (Natural, Threshold Natural)
forall a. Ord a => a -> a -> Maybe (a, Threshold a)
<=? Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* PParams
pps PParams
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Natural
forall s a. s -> Getting a s a -> a
^. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
maxBkSz)
Maybe (Natural, Threshold Natural)
-> (Natural -> Threshold Natural -> UpdateConstraintViolation)
-> Maybe UpdateConstraintViolation
forall a b e. Maybe (a, b) -> (a -> b -> e) -> Maybe e
`orError` Natural -> Threshold Natural -> UpdateConstraintViolation
BlockSizeTooLarge
, (UProp
prop UProp -> Getting Natural UProp Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (PParams -> Const Natural PParams) -> UProp -> Const Natural UProp
Lens' UProp PParams
upParams ((PParams -> Const Natural PParams)
-> UProp -> Const Natural UProp)
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Getting Natural UProp Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
maxTxSz Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1 Natural -> Natural -> Maybe (Natural, Threshold Natural)
forall a. Ord a => a -> a -> Maybe (a, Threshold a)
<=? UProp
prop UProp -> Getting Natural UProp Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (PParams -> Const Natural PParams) -> UProp -> Const Natural UProp
Lens' UProp PParams
upParams ((PParams -> Const Natural PParams)
-> UProp -> Const Natural UProp)
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Getting Natural UProp Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
maxBkSz)
Maybe (Natural, Threshold Natural)
-> (Natural -> Threshold Natural -> UpdateConstraintViolation)
-> Maybe UpdateConstraintViolation
forall a b e. Maybe (a, b) -> (a -> b -> e) -> Maybe e
`orError` Natural -> Threshold Natural -> UpdateConstraintViolation
TransactionSizeTooLarge
, (PParams
pps PParams
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Natural
forall s a. s -> Getting a s a -> a
^. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
scriptVersion Natural -> Natural -> Maybe (Natural, Threshold Natural)
forall a. Ord a => a -> a -> Maybe (a, Threshold a)
<=? UProp
prop UProp -> Getting Natural UProp Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (PParams -> Const Natural PParams) -> UProp -> Const Natural UProp
Lens' UProp PParams
upParams ((PParams -> Const Natural PParams)
-> UProp -> Const Natural UProp)
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Getting Natural UProp Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
scriptVersion)
Maybe (Natural, Threshold Natural)
-> (Natural -> Threshold Natural -> UpdateConstraintViolation)
-> Maybe UpdateConstraintViolation
forall a b e. Maybe (a, b) -> (a -> b -> e) -> Maybe e
`orError` Natural -> Threshold Natural -> UpdateConstraintViolation
ScriptVersionTooSmall
, (UProp
prop UProp -> Getting Natural UProp Natural -> Natural
forall s a. s -> Getting a s a -> a
^. (PParams -> Const Natural PParams) -> UProp -> Const Natural UProp
Lens' UProp PParams
upParams ((PParams -> Const Natural PParams)
-> UProp -> Const Natural UProp)
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Getting Natural UProp Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
scriptVersion Natural -> Natural -> Maybe (Natural, Threshold Natural)
forall a. Ord a => a -> a -> Maybe (a, Threshold a)
<=? PParams
pps PParams
-> ((Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams)
-> Natural
forall s a. s -> Getting a s a -> a
^. (Natural -> Const Natural Natural)
-> PParams -> Const Natural PParams
Lens' PParams Natural
scriptVersion Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1)
Maybe (Natural, Threshold Natural)
-> (Natural -> Threshold Natural -> UpdateConstraintViolation)
-> Maybe UpdateConstraintViolation
forall a b e. Maybe (a, b) -> (a -> b -> e) -> Maybe e
`orError` Natural -> Threshold Natural -> UpdateConstraintViolation
ScriptVersionTooLarge
]
(<=?) :: Ord a => a -> a -> Maybe (a, Threshold a)
a
x <=? :: forall a. Ord a => a -> a -> Maybe (a, Threshold a)
<=? a
y = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y then Maybe (a, Threshold a)
forall a. Maybe a
Nothing else (a, Threshold a) -> Maybe (a, Threshold a)
forall a. a -> Maybe a
Just (a
x, a -> Threshold a
forall a. a -> Threshold a
Threshold a
y)
infix 4 <=?
orError :: Maybe (a, b) -> (a -> b -> e) -> Maybe e
orError :: forall a b e. Maybe (a, b) -> (a -> b -> e) -> Maybe e
orError Maybe (a, b)
mab a -> b -> e
ferr = (a -> b -> e) -> (a, b) -> e
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> e
ferr ((a, b) -> e) -> Maybe (a, b) -> Maybe e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, b)
mab
canUpdate :: PParams -> UProp -> Rule UPPVV ctx ()
canUpdate :: forall (ctx :: RuleType). PParams -> UProp -> Rule UPPVV ctx ()
canUpdate PParams
pps UProp
prop = [UpdateConstraintViolation]
violations [UpdateConstraintViolation] -> [UpdateConstraintViolation] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> PredicateFailure UPPVV -> Rule UPPVV ctx ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! [UpdateConstraintViolation] -> UppvvPredicateFailure
CannotUpdatePv [UpdateConstraintViolation]
violations
where
violations :: [UpdateConstraintViolation]
violations = PParams -> UProp -> [UpdateConstraintViolation]
checkUpdateConstraints PParams
pps UProp
prop
data UpdateConstraintViolation
= BlockSizeTooLarge Natural (Threshold Natural)
| TransactionSizeTooLarge Natural (Threshold Natural)
| ScriptVersionTooLarge Natural (Threshold Natural)
| ScriptVersionTooSmall Natural (Threshold Natural)
deriving (UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
(UpdateConstraintViolation -> UpdateConstraintViolation -> Bool)
-> (UpdateConstraintViolation -> UpdateConstraintViolation -> Bool)
-> Eq UpdateConstraintViolation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
== :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
$c/= :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
/= :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
Eq, Eq UpdateConstraintViolation
Eq UpdateConstraintViolation =>
(UpdateConstraintViolation
-> UpdateConstraintViolation -> Ordering)
-> (UpdateConstraintViolation -> UpdateConstraintViolation -> Bool)
-> (UpdateConstraintViolation -> UpdateConstraintViolation -> Bool)
-> (UpdateConstraintViolation -> UpdateConstraintViolation -> Bool)
-> (UpdateConstraintViolation -> UpdateConstraintViolation -> Bool)
-> (UpdateConstraintViolation
-> UpdateConstraintViolation -> UpdateConstraintViolation)
-> (UpdateConstraintViolation
-> UpdateConstraintViolation -> UpdateConstraintViolation)
-> Ord UpdateConstraintViolation
UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
UpdateConstraintViolation -> UpdateConstraintViolation -> Ordering
UpdateConstraintViolation
-> UpdateConstraintViolation -> UpdateConstraintViolation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UpdateConstraintViolation -> UpdateConstraintViolation -> Ordering
compare :: UpdateConstraintViolation -> UpdateConstraintViolation -> Ordering
$c< :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
< :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
$c<= :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
<= :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
$c> :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
> :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
$c>= :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
>= :: UpdateConstraintViolation -> UpdateConstraintViolation -> Bool
$cmax :: UpdateConstraintViolation
-> UpdateConstraintViolation -> UpdateConstraintViolation
max :: UpdateConstraintViolation
-> UpdateConstraintViolation -> UpdateConstraintViolation
$cmin :: UpdateConstraintViolation
-> UpdateConstraintViolation -> UpdateConstraintViolation
min :: UpdateConstraintViolation
-> UpdateConstraintViolation -> UpdateConstraintViolation
Ord, Int -> UpdateConstraintViolation -> ShowS
[UpdateConstraintViolation] -> ShowS
UpdateConstraintViolation -> String
(Int -> UpdateConstraintViolation -> ShowS)
-> (UpdateConstraintViolation -> String)
-> ([UpdateConstraintViolation] -> ShowS)
-> Show UpdateConstraintViolation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateConstraintViolation -> ShowS
showsPrec :: Int -> UpdateConstraintViolation -> ShowS
$cshow :: UpdateConstraintViolation -> String
show :: UpdateConstraintViolation -> String
$cshowList :: [UpdateConstraintViolation] -> ShowS
showList :: [UpdateConstraintViolation] -> ShowS
Show, Typeable UpdateConstraintViolation
Typeable UpdateConstraintViolation =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpdateConstraintViolation
-> c UpdateConstraintViolation)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateConstraintViolation)
-> (UpdateConstraintViolation -> Constr)
-> (UpdateConstraintViolation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c UpdateConstraintViolation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpdateConstraintViolation))
-> ((forall b. Data b => b -> b)
-> UpdateConstraintViolation -> UpdateConstraintViolation)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpdateConstraintViolation -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> UpdateConstraintViolation -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation)
-> Data UpdateConstraintViolation
UpdateConstraintViolation -> Constr
UpdateConstraintViolation -> DataType
(forall b. Data b => b -> b)
-> UpdateConstraintViolation -> UpdateConstraintViolation
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> UpdateConstraintViolation -> u
forall u.
(forall d. Data d => d -> u) -> UpdateConstraintViolation -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateConstraintViolation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpdateConstraintViolation
-> c UpdateConstraintViolation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c UpdateConstraintViolation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpdateConstraintViolation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpdateConstraintViolation
-> c UpdateConstraintViolation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpdateConstraintViolation
-> c UpdateConstraintViolation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateConstraintViolation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateConstraintViolation
$ctoConstr :: UpdateConstraintViolation -> Constr
toConstr :: UpdateConstraintViolation -> Constr
$cdataTypeOf :: UpdateConstraintViolation -> DataType
dataTypeOf :: UpdateConstraintViolation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c UpdateConstraintViolation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c UpdateConstraintViolation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpdateConstraintViolation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpdateConstraintViolation)
$cgmapT :: (forall b. Data b => b -> b)
-> UpdateConstraintViolation -> UpdateConstraintViolation
gmapT :: (forall b. Data b => b -> b)
-> UpdateConstraintViolation -> UpdateConstraintViolation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpdateConstraintViolation
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpdateConstraintViolation -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpdateConstraintViolation -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> UpdateConstraintViolation -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> UpdateConstraintViolation -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateConstraintViolation -> m UpdateConstraintViolation
Data, (forall x.
UpdateConstraintViolation -> Rep UpdateConstraintViolation x)
-> (forall x.
Rep UpdateConstraintViolation x -> UpdateConstraintViolation)
-> Generic UpdateConstraintViolation
forall x.
Rep UpdateConstraintViolation x -> UpdateConstraintViolation
forall x.
UpdateConstraintViolation -> Rep UpdateConstraintViolation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
UpdateConstraintViolation -> Rep UpdateConstraintViolation x
from :: forall x.
UpdateConstraintViolation -> Rep UpdateConstraintViolation x
$cto :: forall x.
Rep UpdateConstraintViolation x -> UpdateConstraintViolation
to :: forall x.
Rep UpdateConstraintViolation x -> UpdateConstraintViolation
Generic, Context -> UpdateConstraintViolation -> IO (Maybe ThunkInfo)
Proxy UpdateConstraintViolation -> String
(Context -> UpdateConstraintViolation -> IO (Maybe ThunkInfo))
-> (Context -> UpdateConstraintViolation -> IO (Maybe ThunkInfo))
-> (Proxy UpdateConstraintViolation -> String)
-> NoThunks UpdateConstraintViolation
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpdateConstraintViolation -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpdateConstraintViolation -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpdateConstraintViolation -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpdateConstraintViolation -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpdateConstraintViolation -> String
showTypeOf :: Proxy UpdateConstraintViolation -> String
NoThunks)
svCanFollow ::
Map ApName (ApVer, Core.Slot, Metadata) ->
(ApName, ApVer) ->
Bool
svCanFollow :: Map ApName (ApVer, Slot, Metadata) -> (ApName, ApVer) -> Bool
svCanFollow Map ApName (ApVer, Slot, Metadata)
avs (ApName
an, ApVer
av) =
( case ApName
-> Map ApName (ApVer, Slot, Metadata)
-> Maybe (ApVer, Slot, Metadata)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ApName
an Map ApName (ApVer, Slot, Metadata)
avs of
Maybe (ApVer, Slot, Metadata)
Nothing -> Bool
True
Just (ApVer
x, Slot
_, Metadata
_) -> ApVer
av ApVer -> ApVer -> Bool
forall a. Eq a => a -> a -> Bool
== ApVer
x ApVer -> ApVer -> ApVer
forall a. Num a => a -> a -> a
+ ApVer
1
)
Bool -> Bool -> Bool
&& (ApName
an ApName -> Set ApName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Map ApName (ApVer, Slot, Metadata)
-> Set (Domain (Map ApName (ApVer, Slot, Metadata)))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map ApName (ApVer, Slot, Metadata)
avs Bool -> Bool -> Bool
==> (ApVer
av ApVer -> ApVer -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> ApVer
ApVer Natural
0 Bool -> Bool -> Bool
|| ApVer
av ApVer -> ApVer -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> ApVer
ApVer Natural
1))
where
data UPSVV deriving ((forall x. UPSVV -> Rep UPSVV x)
-> (forall x. Rep UPSVV x -> UPSVV) -> Generic UPSVV
forall x. Rep UPSVV x -> UPSVV
forall x. UPSVV -> Rep UPSVV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPSVV -> Rep UPSVV x
from :: forall x. UPSVV -> Rep UPSVV x
$cto :: forall x. Rep UPSVV x -> UPSVV
to :: forall x. Rep UPSVV x -> UPSVV
Generic, Typeable UPSVV
Typeable UPSVV =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPSVV -> c UPSVV)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPSVV)
-> (UPSVV -> Constr)
-> (UPSVV -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPSVV))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPSVV))
-> ((forall b. Data b => b -> b) -> UPSVV -> UPSVV)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPSVV -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPSVV -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV)
-> Data UPSVV
UPSVV -> Constr
UPSVV -> DataType
(forall b. Data b => b -> b) -> UPSVV -> UPSVV
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPSVV -> u
forall u. (forall d. Data d => d -> u) -> UPSVV -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPSVV
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPSVV -> c UPSVV
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPSVV)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPSVV)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPSVV -> c UPSVV
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPSVV -> c UPSVV
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPSVV
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPSVV
$ctoConstr :: UPSVV -> Constr
toConstr :: UPSVV -> Constr
$cdataTypeOf :: UPSVV -> DataType
dataTypeOf :: UPSVV -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPSVV)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPSVV)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPSVV)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPSVV)
$cgmapT :: (forall b. Data b => b -> b) -> UPSVV -> UPSVV
gmapT :: (forall b. Data b => b -> b) -> UPSVV -> UPSVV
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPSVV -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPSVV -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPSVV -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPSVV -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPSVV -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPSVV -> m UPSVV
Data)
data UpsvvPredicateFailure
= AlreadyProposedSv
| CannotFollowSv
| InvalidApplicationName
| InvalidSystemTags
deriving (UpsvvPredicateFailure -> UpsvvPredicateFailure -> Bool
(UpsvvPredicateFailure -> UpsvvPredicateFailure -> Bool)
-> (UpsvvPredicateFailure -> UpsvvPredicateFailure -> Bool)
-> Eq UpsvvPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpsvvPredicateFailure -> UpsvvPredicateFailure -> Bool
== :: UpsvvPredicateFailure -> UpsvvPredicateFailure -> Bool
$c/= :: UpsvvPredicateFailure -> UpsvvPredicateFailure -> Bool
/= :: UpsvvPredicateFailure -> UpsvvPredicateFailure -> Bool
Eq, Int -> UpsvvPredicateFailure -> ShowS
[UpsvvPredicateFailure] -> ShowS
UpsvvPredicateFailure -> String
(Int -> UpsvvPredicateFailure -> ShowS)
-> (UpsvvPredicateFailure -> String)
-> ([UpsvvPredicateFailure] -> ShowS)
-> Show UpsvvPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpsvvPredicateFailure -> ShowS
showsPrec :: Int -> UpsvvPredicateFailure -> ShowS
$cshow :: UpsvvPredicateFailure -> String
show :: UpsvvPredicateFailure -> String
$cshowList :: [UpsvvPredicateFailure] -> ShowS
showList :: [UpsvvPredicateFailure] -> ShowS
Show, Typeable UpsvvPredicateFailure
Typeable UpsvvPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpsvvPredicateFailure
-> c UpsvvPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpsvvPredicateFailure)
-> (UpsvvPredicateFailure -> Constr)
-> (UpsvvPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpsvvPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpsvvPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpsvvPredicateFailure -> UpsvvPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpsvvPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpsvvPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpsvvPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpsvvPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure)
-> Data UpsvvPredicateFailure
UpsvvPredicateFailure -> Constr
UpsvvPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpsvvPredicateFailure -> UpsvvPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpsvvPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpsvvPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpsvvPredicateFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpsvvPredicateFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpsvvPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpsvvPredicateFailure
-> c UpsvvPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpsvvPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpsvvPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpsvvPredicateFailure
-> c UpsvvPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpsvvPredicateFailure
-> c UpsvvPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpsvvPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpsvvPredicateFailure
$ctoConstr :: UpsvvPredicateFailure -> Constr
toConstr :: UpsvvPredicateFailure -> Constr
$cdataTypeOf :: UpsvvPredicateFailure -> DataType
dataTypeOf :: UpsvvPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpsvvPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpsvvPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpsvvPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpsvvPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpsvvPredicateFailure -> UpsvvPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpsvvPredicateFailure -> UpsvvPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpsvvPredicateFailure -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpsvvPredicateFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpsvvPredicateFailure -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpsvvPredicateFailure -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpsvvPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpsvvPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpsvvPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpsvvPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpsvvPredicateFailure -> m UpsvvPredicateFailure
Data, (forall x. UpsvvPredicateFailure -> Rep UpsvvPredicateFailure x)
-> (forall x. Rep UpsvvPredicateFailure x -> UpsvvPredicateFailure)
-> Generic UpsvvPredicateFailure
forall x. Rep UpsvvPredicateFailure x -> UpsvvPredicateFailure
forall x. UpsvvPredicateFailure -> Rep UpsvvPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpsvvPredicateFailure -> Rep UpsvvPredicateFailure x
from :: forall x. UpsvvPredicateFailure -> Rep UpsvvPredicateFailure x
$cto :: forall x. Rep UpsvvPredicateFailure x -> UpsvvPredicateFailure
to :: forall x. Rep UpsvvPredicateFailure x -> UpsvvPredicateFailure
Generic, Context -> UpsvvPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpsvvPredicateFailure -> String
(Context -> UpsvvPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpsvvPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpsvvPredicateFailure -> String)
-> NoThunks UpsvvPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpsvvPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpsvvPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpsvvPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpsvvPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpsvvPredicateFailure -> String
showTypeOf :: Proxy UpsvvPredicateFailure -> String
NoThunks)
instance STS UPSVV where
type Environment UPSVV = Map ApName (ApVer, Core.Slot, Metadata)
type State UPSVV = Map UpId (ApName, ApVer, Metadata)
type Signal UPSVV = UProp
type PredicateFailure UPSVV = UpsvvPredicateFailure
initialRules :: [InitialRule UPSVV]
initialRules = []
transitionRules :: [TransitionRule UPSVV]
transitionRules =
[ do
TRC (Environment UPSVV
avs, State UPSVV
raus, Signal UPSVV
up) <- Rule UPSVV 'Transition (RuleContext 'Transition UPSVV)
F (Clause UPSVV 'Transition) (TRC UPSVV)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let SwVer ApName
an ApVer
av = Signal UPSVV
UProp
up UProp -> Getting SwVer UProp SwVer -> SwVer
forall s a. s -> Getting a s a -> a
^. Getting SwVer UProp SwVer
Lens' UProp SwVer
upSwVer
ApName -> Bool
apNameValid ApName
an Bool -> PredicateFailure UPSVV -> Rule UPSVV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPSVV
UpsvvPredicateFailure
InvalidApplicationName
Map ApName (ApVer, Slot, Metadata) -> (ApName, ApVer) -> Bool
svCanFollow Map ApName (ApVer, Slot, Metadata)
Environment UPSVV
avs (ApName
an, ApVer
av) Bool -> PredicateFailure UPSVV -> Rule UPSVV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPSVV
UpsvvPredicateFailure
CannotFollowSv
ApName
an ApName -> [ApName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((ApName, ApVer, Metadata) -> ApName)
-> [(ApName, ApVer, Metadata)] -> [ApName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ApName, ApVer, Metadata) -> ApName
forall {a} {b} {c}. (a, b, c) -> a
fst' (Map UpId (ApName, ApVer, Metadata) -> [(ApName, ApVer, Metadata)]
forall k a. Map k a -> [a]
Map.elems Map UpId (ApName, ApVer, Metadata)
State UPSVV
raus) Bool -> PredicateFailure UPSVV -> Rule UPSVV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPSVV
UpsvvPredicateFailure
AlreadyProposedSv
(String -> Bool) -> Set String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
forall {t :: * -> *}. Foldable t => t Char -> Bool
sTagValid (Signal UPSVV
UProp
up UProp -> Getting (Set String) UProp (Set String) -> Set String
forall s a. s -> Getting a s a -> a
^. Getting (Set String) UProp (Set String)
Lens' UProp (Set String)
upSTags) Bool -> PredicateFailure UPSVV -> Rule UPSVV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPSVV
UpsvvPredicateFailure
InvalidSystemTags
Map UpId (ApName, ApVer, Metadata)
-> F (Clause UPSVV 'Transition)
(Map UpId (ApName, ApVer, Metadata))
forall a. a -> F (Clause UPSVV 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map UpId (ApName, ApVer, Metadata)
-> F (Clause UPSVV 'Transition)
(Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
-> F (Clause UPSVV 'Transition)
(Map UpId (ApName, ApVer, Metadata))
forall a b. (a -> b) -> a -> b
$! Map UpId (ApName, ApVer, Metadata)
State UPSVV
raus Map UpId (ApName, ApVer, Metadata)
-> [(Domain (Map UpId (ApName, ApVer, Metadata)),
Range (Map UpId (ApName, ApVer, Metadata)))]
-> Map UpId (ApName, ApVer, Metadata)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Ord (Range m), Foldable f) =>
m -> f (Domain m, Range m) -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId (ApName, ApVer, Metadata))),
Ord (Range (Map UpId (ApName, ApVer, Metadata))), Foldable f) =>
Map UpId (ApName, ApVer, Metadata)
-> f (Domain (Map UpId (ApName, ApVer, Metadata)),
Range (Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
⨃ [(Signal UPSVV
UProp
up UProp -> Getting UpId UProp UpId -> UpId
forall s a. s -> Getting a s a -> a
^. Getting UpId UProp UpId
Lens' UProp UpId
upId, (ApName
an, ApVer
av, Signal UPSVV
UProp
up UProp -> Getting Metadata UProp Metadata -> Metadata
forall s a. s -> Getting a s a -> a
^. Getting Metadata UProp Metadata
Lens' UProp Metadata
upMdt))]
]
where
fst' :: (a, b, c) -> a
fst' (a
x, b
_, c
_) = a
x
apNameValid :: ApName -> Bool
apNameValid (ApName String
n) = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii String
n Bool -> Bool -> Bool
&& String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
12
sTagValid :: t Char -> Bool
sTagValid t Char
tag = (Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii t Char
tag Bool -> Bool -> Bool
&& t Char -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t Char
tag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10
data UPPVV deriving ((forall x. UPPVV -> Rep UPPVV x)
-> (forall x. Rep UPPVV x -> UPPVV) -> Generic UPPVV
forall x. Rep UPPVV x -> UPPVV
forall x. UPPVV -> Rep UPPVV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPPVV -> Rep UPPVV x
from :: forall x. UPPVV -> Rep UPPVV x
$cto :: forall x. Rep UPPVV x -> UPPVV
to :: forall x. Rep UPPVV x -> UPPVV
Generic, Typeable UPPVV
Typeable UPPVV =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPPVV -> c UPPVV)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPPVV)
-> (UPPVV -> Constr)
-> (UPPVV -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPPVV))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPPVV))
-> ((forall b. Data b => b -> b) -> UPPVV -> UPPVV)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPPVV -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPPVV -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV)
-> Data UPPVV
UPPVV -> Constr
UPPVV -> DataType
(forall b. Data b => b -> b) -> UPPVV -> UPPVV
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPPVV -> u
forall u. (forall d. Data d => d -> u) -> UPPVV -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPPVV
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPPVV -> c UPPVV
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPPVV)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPPVV)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPPVV -> c UPPVV
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPPVV -> c UPPVV
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPPVV
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPPVV
$ctoConstr :: UPPVV -> Constr
toConstr :: UPPVV -> Constr
$cdataTypeOf :: UPPVV -> DataType
dataTypeOf :: UPPVV -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPPVV)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPPVV)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPPVV)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPPVV)
$cgmapT :: (forall b. Data b => b -> b) -> UPPVV -> UPPVV
gmapT :: (forall b. Data b => b -> b) -> UPPVV -> UPPVV
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPPVV -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPPVV -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPPVV -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPPVV -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPPVV -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPPVV -> m UPPVV
Data)
data UppvvPredicateFailure
= CannotFollowPv
| CannotUpdatePv [UpdateConstraintViolation]
| AlreadyProposedPv
deriving (UppvvPredicateFailure -> UppvvPredicateFailure -> Bool
(UppvvPredicateFailure -> UppvvPredicateFailure -> Bool)
-> (UppvvPredicateFailure -> UppvvPredicateFailure -> Bool)
-> Eq UppvvPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UppvvPredicateFailure -> UppvvPredicateFailure -> Bool
== :: UppvvPredicateFailure -> UppvvPredicateFailure -> Bool
$c/= :: UppvvPredicateFailure -> UppvvPredicateFailure -> Bool
/= :: UppvvPredicateFailure -> UppvvPredicateFailure -> Bool
Eq, Int -> UppvvPredicateFailure -> ShowS
[UppvvPredicateFailure] -> ShowS
UppvvPredicateFailure -> String
(Int -> UppvvPredicateFailure -> ShowS)
-> (UppvvPredicateFailure -> String)
-> ([UppvvPredicateFailure] -> ShowS)
-> Show UppvvPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UppvvPredicateFailure -> ShowS
showsPrec :: Int -> UppvvPredicateFailure -> ShowS
$cshow :: UppvvPredicateFailure -> String
show :: UppvvPredicateFailure -> String
$cshowList :: [UppvvPredicateFailure] -> ShowS
showList :: [UppvvPredicateFailure] -> ShowS
Show, Typeable UppvvPredicateFailure
Typeable UppvvPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UppvvPredicateFailure
-> c UppvvPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UppvvPredicateFailure)
-> (UppvvPredicateFailure -> Constr)
-> (UppvvPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UppvvPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UppvvPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UppvvPredicateFailure -> UppvvPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UppvvPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UppvvPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UppvvPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UppvvPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure)
-> Data UppvvPredicateFailure
UppvvPredicateFailure -> Constr
UppvvPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UppvvPredicateFailure -> UppvvPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UppvvPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UppvvPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UppvvPredicateFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UppvvPredicateFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UppvvPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UppvvPredicateFailure
-> c UppvvPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UppvvPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UppvvPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UppvvPredicateFailure
-> c UppvvPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UppvvPredicateFailure
-> c UppvvPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UppvvPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UppvvPredicateFailure
$ctoConstr :: UppvvPredicateFailure -> Constr
toConstr :: UppvvPredicateFailure -> Constr
$cdataTypeOf :: UppvvPredicateFailure -> DataType
dataTypeOf :: UppvvPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UppvvPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UppvvPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UppvvPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UppvvPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UppvvPredicateFailure -> UppvvPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UppvvPredicateFailure -> UppvvPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UppvvPredicateFailure -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UppvvPredicateFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UppvvPredicateFailure -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UppvvPredicateFailure -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UppvvPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UppvvPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UppvvPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UppvvPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UppvvPredicateFailure -> m UppvvPredicateFailure
Data, (forall x. UppvvPredicateFailure -> Rep UppvvPredicateFailure x)
-> (forall x. Rep UppvvPredicateFailure x -> UppvvPredicateFailure)
-> Generic UppvvPredicateFailure
forall x. Rep UppvvPredicateFailure x -> UppvvPredicateFailure
forall x. UppvvPredicateFailure -> Rep UppvvPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UppvvPredicateFailure -> Rep UppvvPredicateFailure x
from :: forall x. UppvvPredicateFailure -> Rep UppvvPredicateFailure x
$cto :: forall x. Rep UppvvPredicateFailure x -> UppvvPredicateFailure
to :: forall x. Rep UppvvPredicateFailure x -> UppvvPredicateFailure
Generic, Context -> UppvvPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UppvvPredicateFailure -> String
(Context -> UppvvPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UppvvPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UppvvPredicateFailure -> String)
-> NoThunks UppvvPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UppvvPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UppvvPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UppvvPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UppvvPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UppvvPredicateFailure -> String
showTypeOf :: Proxy UppvvPredicateFailure -> String
NoThunks)
instance STS UPPVV where
type
Environment UPPVV =
( ProtVer
, PParams
)
type State UPPVV = Map UpId (ProtVer, PParams)
type Signal UPPVV = UProp
type PredicateFailure UPPVV = UppvvPredicateFailure
initialRules :: [InitialRule UPPVV]
initialRules = []
transitionRules :: [TransitionRule UPPVV]
transitionRules =
[ do
TRC ((ProtVer
pv, PParams
pps), State UPPVV
rpus, Signal UPPVV
up) <- Rule UPPVV 'Transition (RuleContext 'Transition UPPVV)
F (Clause UPPVV 'Transition) (TRC UPPVV)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let pid :: UpId
pid = Signal UPPVV
UProp
up UProp -> Getting UpId UProp UpId -> UpId
forall s a. s -> Getting a s a -> a
^. Getting UpId UProp UpId
Lens' UProp UpId
upId
nv :: ProtVer
nv = Signal UPPVV
UProp
up UProp -> Getting ProtVer UProp ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer UProp ProtVer
Lens' UProp ProtVer
upPV
ppsn :: PParams
ppsn = Signal UPPVV
UProp
up UProp -> Getting PParams UProp PParams -> PParams
forall s a. s -> Getting a s a -> a
^. Getting PParams UProp PParams
Lens' UProp PParams
upParams
ProtVer -> ProtVer -> Bool
pvCanFollow ProtVer
nv ProtVer
pv Bool -> PredicateFailure UPPVV -> Rule UPPVV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPPVV
UppvvPredicateFailure
CannotFollowPv
PParams -> UProp -> Rule UPPVV 'Transition ()
forall (ctx :: RuleType). PParams -> UProp -> Rule UPPVV ctx ()
canUpdate PParams
pps Signal UPPVV
UProp
up
ProtVer
nv ProtVer -> [ProtVer] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((ProtVer, PParams) -> ProtVer
forall a b. (a, b) -> a
fst ((ProtVer, PParams) -> ProtVer)
-> [(ProtVer, PParams)] -> [ProtVer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map UpId (ProtVer, PParams) -> [(ProtVer, PParams)]
forall k a. Map k a -> [a]
Map.elems Map UpId (ProtVer, PParams)
State UPPVV
rpus) Bool -> PredicateFailure UPPVV -> Rule UPPVV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPPVV
UppvvPredicateFailure
AlreadyProposedPv
Map UpId (ProtVer, PParams)
-> F (Clause UPPVV 'Transition) (Map UpId (ProtVer, PParams))
forall a. a -> F (Clause UPPVV 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map UpId (ProtVer, PParams)
-> F (Clause UPPVV 'Transition) (Map UpId (ProtVer, PParams)))
-> Map UpId (ProtVer, PParams)
-> F (Clause UPPVV 'Transition) (Map UpId (ProtVer, PParams))
forall a b. (a -> b) -> a -> b
$! Map UpId (ProtVer, PParams)
State UPPVV
rpus Map UpId (ProtVer, PParams)
-> [(Domain (Map UpId (ProtVer, PParams)),
Range (Map UpId (ProtVer, PParams)))]
-> Map UpId (ProtVer, PParams)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Ord (Range m), Foldable f) =>
m -> f (Domain m, Range m) -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId (ProtVer, PParams))),
Ord (Range (Map UpId (ProtVer, PParams))), Foldable f) =>
Map UpId (ProtVer, PParams)
-> f (Domain (Map UpId (ProtVer, PParams)),
Range (Map UpId (ProtVer, PParams)))
-> Map UpId (ProtVer, PParams)
⨃ [(UpId
pid, (ProtVer
nv, PParams
ppsn))]
]
data UPV deriving ((forall x. UPV -> Rep UPV x)
-> (forall x. Rep UPV x -> UPV) -> Generic UPV
forall x. Rep UPV x -> UPV
forall x. UPV -> Rep UPV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPV -> Rep UPV x
from :: forall x. UPV -> Rep UPV x
$cto :: forall x. Rep UPV x -> UPV
to :: forall x. Rep UPV x -> UPV
Generic, Typeable UPV
Typeable UPV =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPV -> c UPV)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPV)
-> (UPV -> Constr)
-> (UPV -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPV))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPV))
-> ((forall b. Data b => b -> b) -> UPV -> UPV)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPV -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPV -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV)
-> Data UPV
UPV -> Constr
UPV -> DataType
(forall b. Data b => b -> b) -> UPV -> UPV
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPV -> u
forall u. (forall d. Data d => d -> u) -> UPV -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPV
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPV -> c UPV
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPV)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPV)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPV -> c UPV
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPV -> c UPV
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPV
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPV
$ctoConstr :: UPV -> Constr
toConstr :: UPV -> Constr
$cdataTypeOf :: UPV -> DataType
dataTypeOf :: UPV -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPV)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPV)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPV)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPV)
$cgmapT :: (forall b. Data b => b -> b) -> UPV -> UPV
gmapT :: (forall b. Data b => b -> b) -> UPV -> UPV
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPV -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPV -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPV -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPV -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPV -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPV -> m UPV
Data)
data UpvPredicateFailure
= UPPVVFailure (PredicateFailure UPPVV)
| UPSVVFailure (PredicateFailure UPSVV)
| AVChangedInPVUpdate ApName ApVer (Maybe (ApVer, Slot, Metadata))
| ParamsChangedInSVUpdate
| PVChangedInSVUpdate
deriving (UpvPredicateFailure -> UpvPredicateFailure -> Bool
(UpvPredicateFailure -> UpvPredicateFailure -> Bool)
-> (UpvPredicateFailure -> UpvPredicateFailure -> Bool)
-> Eq UpvPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpvPredicateFailure -> UpvPredicateFailure -> Bool
== :: UpvPredicateFailure -> UpvPredicateFailure -> Bool
$c/= :: UpvPredicateFailure -> UpvPredicateFailure -> Bool
/= :: UpvPredicateFailure -> UpvPredicateFailure -> Bool
Eq, Int -> UpvPredicateFailure -> ShowS
[UpvPredicateFailure] -> ShowS
UpvPredicateFailure -> String
(Int -> UpvPredicateFailure -> ShowS)
-> (UpvPredicateFailure -> String)
-> ([UpvPredicateFailure] -> ShowS)
-> Show UpvPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpvPredicateFailure -> ShowS
showsPrec :: Int -> UpvPredicateFailure -> ShowS
$cshow :: UpvPredicateFailure -> String
show :: UpvPredicateFailure -> String
$cshowList :: [UpvPredicateFailure] -> ShowS
showList :: [UpvPredicateFailure] -> ShowS
Show, Typeable UpvPredicateFailure
Typeable UpvPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvPredicateFailure
-> c UpvPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvPredicateFailure)
-> (UpvPredicateFailure -> Constr)
-> (UpvPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpvPredicateFailure -> UpvPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpvPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpvPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure)
-> Data UpvPredicateFailure
UpvPredicateFailure -> Constr
UpvPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpvPredicateFailure -> UpvPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpvPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpvPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvPredicateFailure
-> c UpvPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvPredicateFailure
-> c UpvPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvPredicateFailure
-> c UpvPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvPredicateFailure
$ctoConstr :: UpvPredicateFailure -> Constr
toConstr :: UpvPredicateFailure -> Constr
$cdataTypeOf :: UpvPredicateFailure -> DataType
dataTypeOf :: UpvPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpvPredicateFailure -> UpvPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpvPredicateFailure -> UpvPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpvPredicateFailure -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpvPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpvPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpvPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpvPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvPredicateFailure -> m UpvPredicateFailure
Data, (forall x. UpvPredicateFailure -> Rep UpvPredicateFailure x)
-> (forall x. Rep UpvPredicateFailure x -> UpvPredicateFailure)
-> Generic UpvPredicateFailure
forall x. Rep UpvPredicateFailure x -> UpvPredicateFailure
forall x. UpvPredicateFailure -> Rep UpvPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpvPredicateFailure -> Rep UpvPredicateFailure x
from :: forall x. UpvPredicateFailure -> Rep UpvPredicateFailure x
$cto :: forall x. Rep UpvPredicateFailure x -> UpvPredicateFailure
to :: forall x. Rep UpvPredicateFailure x -> UpvPredicateFailure
Generic, Context -> UpvPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpvPredicateFailure -> String
(Context -> UpvPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpvPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpvPredicateFailure -> String)
-> NoThunks UpvPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpvPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpvPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpvPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpvPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpvPredicateFailure -> String
showTypeOf :: Proxy UpvPredicateFailure -> String
NoThunks)
instance STS UPV where
type
Environment UPV =
( ProtVer
, PParams
, Map ApName (ApVer, Core.Slot, Metadata)
)
type
State UPV =
( Map UpId (ProtVer, PParams)
, Map UpId (ApName, ApVer, Metadata)
)
type Signal UPV = UProp
type PredicateFailure UPV = UpvPredicateFailure
initialRules :: [InitialRule UPV]
initialRules = []
transitionRules :: [TransitionRule UPV]
transitionRules =
[ do
TRC
( (ProtVer
pv, PParams
pps, Map ApName (ApVer, Slot, Metadata)
avs)
, (Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus)
, Signal UPV
up
) <-
Rule UPV 'Transition (RuleContext 'Transition UPV)
F (Clause UPV 'Transition) (TRC UPV)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
Map UpId (ProtVer, PParams)
rpus' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPPVV (RuleContext 'Transition UPPVV
-> Rule UPV 'Transition (State UPPVV))
-> RuleContext 'Transition UPPVV
-> Rule UPV 'Transition (State UPPVV)
forall a b. (a -> b) -> a -> b
$ (Environment UPPVV, State UPPVV, Signal UPPVV) -> TRC UPPVV
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((ProtVer
pv, PParams
pps), Map UpId (ProtVer, PParams)
State UPPVV
rpus, Signal UPV
Signal UPPVV
up)
let SwVer ApName
an ApVer
av = Signal UPV
UProp
up UProp -> Getting SwVer UProp SwVer -> SwVer
forall s a. s -> Getting a s a -> a
^. Getting SwVer UProp SwVer
Lens' UProp SwVer
upSwVer
ApName -> ApVer -> Map ApName ApVer -> Bool
forall key v. (Ord key, Eq v) => key -> v -> Map key v -> Bool
inMap ApName
an ApVer
av ((ApVer, Slot, Metadata) -> ApVer
forall {a} {b} {c}. (a, b, c) -> a
swVer ((ApVer, Slot, Metadata) -> ApVer)
-> Map ApName (ApVer, Slot, Metadata) -> Map ApName ApVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ApName (ApVer, Slot, Metadata)
avs) Bool -> PredicateFailure UPV -> Rule UPV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! ApName
-> ApVer -> Maybe (ApVer, Slot, Metadata) -> UpvPredicateFailure
AVChangedInPVUpdate ApName
an ApVer
av (ApName
-> Map ApName (ApVer, Slot, Metadata)
-> Maybe (ApVer, Slot, Metadata)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ApName
an Map ApName (ApVer, Slot, Metadata)
avs)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a. a -> F (Clause UPV 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata)))
-> (Map UpId (ProtVer, PParams),
Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a b. (a -> b) -> a -> b
$! (Map UpId (ProtVer, PParams)
rpus', Map UpId (ApName, ApVer, Metadata)
raus)
, do
TRC
( (ProtVer
pv, PParams
pps, Map ApName (ApVer, Slot, Metadata)
avs)
, (Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus)
, Signal UPV
up
) <-
Rule UPV 'Transition (RuleContext 'Transition UPV)
F (Clause UPV 'Transition) (TRC UPV)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
ProtVer
pv ProtVer -> ProtVer -> Bool
forall a. Eq a => a -> a -> Bool
== Signal UPV
UProp
up UProp -> Getting ProtVer UProp ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer UProp ProtVer
Lens' UProp ProtVer
upPV Bool -> PredicateFailure UPV -> Rule UPV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPV
UpvPredicateFailure
PVChangedInSVUpdate
Signal UPV
UProp
up UProp -> Getting PParams UProp PParams -> PParams
forall s a. s -> Getting a s a -> a
^. Getting PParams UProp PParams
Lens' UProp PParams
upParams PParams -> PParams -> Bool
forall a. Eq a => a -> a -> Bool
== PParams
pps Bool -> PredicateFailure UPV -> Rule UPV 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPV
UpvPredicateFailure
ParamsChangedInSVUpdate
Map UpId (ApName, ApVer, Metadata)
raus' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPSVV (RuleContext 'Transition UPSVV
-> Rule UPV 'Transition (State UPSVV))
-> RuleContext 'Transition UPSVV
-> Rule UPV 'Transition (State UPSVV)
forall a b. (a -> b) -> a -> b
$ (Environment UPSVV, State UPSVV, Signal UPSVV) -> TRC UPSVV
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Map ApName (ApVer, Slot, Metadata)
Environment UPSVV
avs, Map UpId (ApName, ApVer, Metadata)
State UPSVV
raus, Signal UPV
Signal UPSVV
up)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a. a -> F (Clause UPV 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata)))
-> (Map UpId (ProtVer, PParams),
Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a b. (a -> b) -> a -> b
$! (Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus')
, do
TRC
( (ProtVer
pv, PParams
pps, Map ApName (ApVer, Slot, Metadata)
avs)
, (Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus)
, Signal UPV
up
) <-
Rule UPV 'Transition (RuleContext 'Transition UPV)
F (Clause UPV 'Transition) (TRC UPV)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
Map UpId (ProtVer, PParams)
rpus' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPPVV (RuleContext 'Transition UPPVV
-> Rule UPV 'Transition (State UPPVV))
-> RuleContext 'Transition UPPVV
-> Rule UPV 'Transition (State UPPVV)
forall a b. (a -> b) -> a -> b
$ (Environment UPPVV, State UPPVV, Signal UPPVV) -> TRC UPPVV
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((ProtVer
pv, PParams
pps), Map UpId (ProtVer, PParams)
State UPPVV
rpus, Signal UPV
Signal UPPVV
up)
Map UpId (ApName, ApVer, Metadata)
raus' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPSVV (RuleContext 'Transition UPSVV
-> Rule UPV 'Transition (State UPSVV))
-> RuleContext 'Transition UPSVV
-> Rule UPV 'Transition (State UPSVV)
forall a b. (a -> b) -> a -> b
$ (Environment UPSVV, State UPSVV, Signal UPSVV) -> TRC UPSVV
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Map ApName (ApVer, Slot, Metadata)
Environment UPSVV
avs, Map UpId (ApName, ApVer, Metadata)
State UPSVV
raus, Signal UPV
Signal UPSVV
up)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a. a -> F (Clause UPV 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata)))
-> (Map UpId (ProtVer, PParams),
Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPV 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a b. (a -> b) -> a -> b
$! (Map UpId (ProtVer, PParams)
rpus', Map UpId (ApName, ApVer, Metadata)
raus')
]
where
swVer :: (a, b, c) -> a
swVer (a
x, b
_, c
_) = a
x
instance Embed UPPVV UPV where
wrapFailed :: PredicateFailure UPPVV -> PredicateFailure UPV
wrapFailed = PredicateFailure UPPVV -> PredicateFailure UPV
PredicateFailure UPPVV -> UpvPredicateFailure
UPPVVFailure
instance Embed UPSVV UPV where
wrapFailed :: PredicateFailure UPSVV -> PredicateFailure UPV
wrapFailed = PredicateFailure UPSVV -> PredicateFailure UPV
PredicateFailure UPSVV -> UpvPredicateFailure
UPSVVFailure
data UPREG deriving ((forall x. UPREG -> Rep UPREG x)
-> (forall x. Rep UPREG x -> UPREG) -> Generic UPREG
forall x. Rep UPREG x -> UPREG
forall x. UPREG -> Rep UPREG x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPREG -> Rep UPREG x
from :: forall x. UPREG -> Rep UPREG x
$cto :: forall x. Rep UPREG x -> UPREG
to :: forall x. Rep UPREG x -> UPREG
Generic, Typeable UPREG
Typeable UPREG =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPREG -> c UPREG)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPREG)
-> (UPREG -> Constr)
-> (UPREG -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPREG))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPREG))
-> ((forall b. Data b => b -> b) -> UPREG -> UPREG)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPREG -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPREG -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG)
-> Data UPREG
UPREG -> Constr
UPREG -> DataType
(forall b. Data b => b -> b) -> UPREG -> UPREG
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPREG -> u
forall u. (forall d. Data d => d -> u) -> UPREG -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPREG
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPREG -> c UPREG
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPREG)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPREG)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPREG -> c UPREG
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPREG -> c UPREG
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPREG
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPREG
$ctoConstr :: UPREG -> Constr
toConstr :: UPREG -> Constr
$cdataTypeOf :: UPREG -> DataType
dataTypeOf :: UPREG -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPREG)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPREG)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPREG)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPREG)
$cgmapT :: (forall b. Data b => b -> b) -> UPREG -> UPREG
gmapT :: (forall b. Data b => b -> b) -> UPREG -> UPREG
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPREG -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPREG -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPREG -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPREG -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPREG -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPREG -> m UPREG
Data)
data UpregPredicateFailure
= UPVFailure (PredicateFailure UPV)
| NotGenesisDelegate
| DoesNotVerify
deriving (UpregPredicateFailure -> UpregPredicateFailure -> Bool
(UpregPredicateFailure -> UpregPredicateFailure -> Bool)
-> (UpregPredicateFailure -> UpregPredicateFailure -> Bool)
-> Eq UpregPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpregPredicateFailure -> UpregPredicateFailure -> Bool
== :: UpregPredicateFailure -> UpregPredicateFailure -> Bool
$c/= :: UpregPredicateFailure -> UpregPredicateFailure -> Bool
/= :: UpregPredicateFailure -> UpregPredicateFailure -> Bool
Eq, Int -> UpregPredicateFailure -> ShowS
[UpregPredicateFailure] -> ShowS
UpregPredicateFailure -> String
(Int -> UpregPredicateFailure -> ShowS)
-> (UpregPredicateFailure -> String)
-> ([UpregPredicateFailure] -> ShowS)
-> Show UpregPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpregPredicateFailure -> ShowS
showsPrec :: Int -> UpregPredicateFailure -> ShowS
$cshow :: UpregPredicateFailure -> String
show :: UpregPredicateFailure -> String
$cshowList :: [UpregPredicateFailure] -> ShowS
showList :: [UpregPredicateFailure] -> ShowS
Show, Typeable UpregPredicateFailure
Typeable UpregPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpregPredicateFailure
-> c UpregPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpregPredicateFailure)
-> (UpregPredicateFailure -> Constr)
-> (UpregPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpregPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpregPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpregPredicateFailure -> UpregPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpregPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpregPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpregPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpregPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure)
-> Data UpregPredicateFailure
UpregPredicateFailure -> Constr
UpregPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpregPredicateFailure -> UpregPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpregPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpregPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpregPredicateFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpregPredicateFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpregPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpregPredicateFailure
-> c UpregPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpregPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpregPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpregPredicateFailure
-> c UpregPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpregPredicateFailure
-> c UpregPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpregPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpregPredicateFailure
$ctoConstr :: UpregPredicateFailure -> Constr
toConstr :: UpregPredicateFailure -> Constr
$cdataTypeOf :: UpregPredicateFailure -> DataType
dataTypeOf :: UpregPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpregPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpregPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpregPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpregPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpregPredicateFailure -> UpregPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpregPredicateFailure -> UpregPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpregPredicateFailure -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpregPredicateFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpregPredicateFailure -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpregPredicateFailure -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpregPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpregPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpregPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpregPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpregPredicateFailure -> m UpregPredicateFailure
Data, (forall x. UpregPredicateFailure -> Rep UpregPredicateFailure x)
-> (forall x. Rep UpregPredicateFailure x -> UpregPredicateFailure)
-> Generic UpregPredicateFailure
forall x. Rep UpregPredicateFailure x -> UpregPredicateFailure
forall x. UpregPredicateFailure -> Rep UpregPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpregPredicateFailure -> Rep UpregPredicateFailure x
from :: forall x. UpregPredicateFailure -> Rep UpregPredicateFailure x
$cto :: forall x. Rep UpregPredicateFailure x -> UpregPredicateFailure
to :: forall x. Rep UpregPredicateFailure x -> UpregPredicateFailure
Generic, Context -> UpregPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpregPredicateFailure -> String
(Context -> UpregPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpregPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpregPredicateFailure -> String)
-> NoThunks UpregPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpregPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpregPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpregPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpregPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpregPredicateFailure -> String
showTypeOf :: Proxy UpregPredicateFailure -> String
NoThunks)
instance STS UPREG where
type
Environment UPREG =
( ProtVer
, PParams
, Map ApName (ApVer, Core.Slot, Metadata)
, Bimap Core.VKeyGenesis Core.VKey
)
type
State UPREG =
( Map UpId (ProtVer, PParams)
, Map UpId (ApName, ApVer, Metadata)
)
type Signal UPREG = UProp
type PredicateFailure UPREG = UpregPredicateFailure
initialRules :: [InitialRule UPREG]
initialRules = []
transitionRules :: [TransitionRule UPREG]
transitionRules =
[ do
TRC
( (ProtVer
pv, PParams
pps, Map ApName (ApVer, Slot, Metadata)
avs, Bimap VKeyGenesis VKey
dms)
, (Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus)
, Signal UPREG
up
) <-
Rule UPREG 'Transition (RuleContext 'Transition UPREG)
F (Clause UPREG 'Transition) (TRC UPREG)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
(Map UpId (ProtVer, PParams)
rpus', Map UpId (ApName, ApVer, Metadata)
raus') <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPV (RuleContext 'Transition UPV -> Rule UPREG 'Transition (State UPV))
-> RuleContext 'Transition UPV
-> Rule UPREG 'Transition (State UPV)
forall a b. (a -> b) -> a -> b
$ (Environment UPV, State UPV, Signal UPV) -> TRC UPV
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((ProtVer
pv, PParams
pps, Map ApName (ApVer, Slot, Metadata)
avs), (Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus), Signal UPREG
Signal UPV
up)
let vk :: VKey
vk = Signal UPREG
UProp
up UProp -> Getting VKey UProp VKey -> VKey
forall s a. s -> Getting a s a -> a
^. Getting VKey UProp VKey
Lens' UProp VKey
upIssuer
Bimap VKeyGenesis VKey
dms Bimap VKeyGenesis VKey
-> Set (Range (Bimap VKeyGenesis VKey)) -> Bimap VKeyGenesis VKey
forall m. (Relation m, Ord (Range m)) => m -> Set (Range m) -> m
▷ VKey -> Set VKey
forall a. a -> Set a
Set.singleton VKey
vk Bimap VKeyGenesis VKey -> Bimap VKeyGenesis VKey -> Bool
forall a. Eq a => a -> a -> Bool
/= Bimap VKeyGenesis VKey
forall a b. Bimap a b
empty Bool -> PredicateFailure UPREG -> Rule UPREG 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPREG
UpregPredicateFailure
NotGenesisDelegate
VKey -> UpSD -> Sig UpSD -> Bool
forall a. Eq a => VKey -> a -> Sig a -> Bool
Core.verify VKey
vk (Signal UPREG
UProp
up UProp -> Getting UpSD UProp UpSD -> UpSD
forall s a. s -> Getting a s a -> a
^. Getting UpSD UProp UpSD
Lens' UProp UpSD
upSigData) (Signal UPREG
UProp
up UProp -> Getting (Sig UpSD) UProp (Sig UpSD) -> Sig UpSD
forall s a. s -> Getting a s a -> a
^. Getting (Sig UpSD) UProp (Sig UpSD)
Lens' UProp (Sig UpSD)
upSig) Bool -> PredicateFailure UPREG -> Rule UPREG 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPREG
UpregPredicateFailure
DoesNotVerify
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPREG 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a. a -> F (Clause UPREG 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPREG 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata)))
-> (Map UpId (ProtVer, PParams),
Map UpId (ApName, ApVer, Metadata))
-> F (Clause UPREG 'Transition)
(Map UpId (ProtVer, PParams), Map UpId (ApName, ApVer, Metadata))
forall a b. (a -> b) -> a -> b
$! (Map UpId (ProtVer, PParams)
rpus', Map UpId (ApName, ApVer, Metadata)
raus')
]
instance Embed UPV UPREG where
wrapFailed :: PredicateFailure UPV -> PredicateFailure UPREG
wrapFailed = PredicateFailure UPV -> PredicateFailure UPREG
PredicateFailure UPV -> UpregPredicateFailure
UPVFailure
data Vote = Vote
{ Vote -> VKey
_vCaster :: Core.VKey
, Vote -> UpId
_vPropId :: UpId
, Vote -> Sig UpId
_vSig :: Core.Sig UpId
}
deriving (Vote -> Vote -> Bool
(Vote -> Vote -> Bool) -> (Vote -> Vote -> Bool) -> Eq Vote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Vote -> Vote -> Bool
== :: Vote -> Vote -> Bool
$c/= :: Vote -> Vote -> Bool
/= :: Vote -> Vote -> Bool
Eq, (forall x. Vote -> Rep Vote x)
-> (forall x. Rep Vote x -> Vote) -> Generic Vote
forall x. Rep Vote x -> Vote
forall x. Vote -> Rep Vote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Vote -> Rep Vote x
from :: forall x. Vote -> Rep Vote x
$cto :: forall x. Rep Vote x -> Vote
to :: forall x. Rep Vote x -> Vote
Generic, Int -> Vote -> ShowS
[Vote] -> ShowS
Vote -> String
(Int -> Vote -> ShowS)
-> (Vote -> String) -> ([Vote] -> ShowS) -> Show Vote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Vote -> ShowS
showsPrec :: Int -> Vote -> ShowS
$cshow :: Vote -> String
show :: Vote -> String
$cshowList :: [Vote] -> ShowS
showList :: [Vote] -> ShowS
Show, Eq Vote
Eq Vote => (Int -> Vote -> Int) -> (Vote -> Int) -> Hashable Vote
Int -> Vote -> Int
Vote -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Vote -> Int
hashWithSalt :: Int -> Vote -> Int
$chash :: Vote -> Int
hash :: Vote -> Int
Hashable, Typeable Vote
Typeable Vote =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vote -> c Vote)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vote)
-> (Vote -> Constr)
-> (Vote -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Vote))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vote))
-> ((forall b. Data b => b -> b) -> Vote -> Vote)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r)
-> (forall u. (forall d. Data d => d -> u) -> Vote -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Vote -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote)
-> Data Vote
Vote -> Constr
Vote -> DataType
(forall b. Data b => b -> b) -> Vote -> Vote
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Vote -> u
forall u. (forall d. Data d => d -> u) -> Vote -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vote
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vote -> c Vote
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Vote)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vote)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vote -> c Vote
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vote -> c Vote
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vote
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vote
$ctoConstr :: Vote -> Constr
toConstr :: Vote -> Constr
$cdataTypeOf :: Vote -> DataType
dataTypeOf :: Vote -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Vote)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Vote)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vote)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vote)
$cgmapT :: (forall b. Data b => b -> b) -> Vote -> Vote
gmapT :: (forall b. Data b => b -> b) -> Vote -> Vote
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vote -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Vote -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Vote -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Vote -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Vote -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vote -> m Vote
Data, Context -> Vote -> IO (Maybe ThunkInfo)
Proxy Vote -> String
(Context -> Vote -> IO (Maybe ThunkInfo))
-> (Context -> Vote -> IO (Maybe ThunkInfo))
-> (Proxy Vote -> String)
-> NoThunks Vote
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Vote -> IO (Maybe ThunkInfo)
noThunks :: Context -> Vote -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Vote -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Vote -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Vote -> String
showTypeOf :: Proxy Vote -> String
NoThunks)
makeLenses ''Vote
instance HasTypeReps Vote
mkVote :: Core.VKey -> UpId -> Vote
mkVote :: VKey -> UpId -> Vote
mkVote VKey
caster UpId
proposalId =
Vote
{ _vCaster :: VKey
_vCaster = VKey
caster
, _vPropId :: UpId
_vPropId = UpId
proposalId
, _vSig :: Sig UpId
_vSig = SKey -> UpId -> Sig UpId
forall a. SKey -> a -> Sig a
Core.sign (VKey -> SKey
skey VKey
caster) UpId
proposalId
}
instance HasHash (Maybe Byron.Spec.Ledger.Update.UProp, [Byron.Spec.Ledger.Update.Vote]) where
hash :: (Maybe UProp, [Vote]) -> Hash
hash = Maybe Int -> Hash
Core.Hash (Maybe Int -> Hash)
-> ((Maybe UProp, [Vote]) -> Maybe Int)
-> (Maybe UProp, [Vote])
-> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ((Maybe UProp, [Vote]) -> Int)
-> (Maybe UProp, [Vote])
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe UProp, [Vote]) -> Int
forall a. Hashable a => a -> Int
H.hash
data ADDVOTE deriving ((forall x. ADDVOTE -> Rep ADDVOTE x)
-> (forall x. Rep ADDVOTE x -> ADDVOTE) -> Generic ADDVOTE
forall x. Rep ADDVOTE x -> ADDVOTE
forall x. ADDVOTE -> Rep ADDVOTE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ADDVOTE -> Rep ADDVOTE x
from :: forall x. ADDVOTE -> Rep ADDVOTE x
$cto :: forall x. Rep ADDVOTE x -> ADDVOTE
to :: forall x. Rep ADDVOTE x -> ADDVOTE
Generic, Typeable ADDVOTE
Typeable ADDVOTE =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ADDVOTE -> c ADDVOTE)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ADDVOTE)
-> (ADDVOTE -> Constr)
-> (ADDVOTE -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ADDVOTE))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ADDVOTE))
-> ((forall b. Data b => b -> b) -> ADDVOTE -> ADDVOTE)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r)
-> (forall u. (forall d. Data d => d -> u) -> ADDVOTE -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ADDVOTE -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE)
-> Data ADDVOTE
ADDVOTE -> Constr
ADDVOTE -> DataType
(forall b. Data b => b -> b) -> ADDVOTE -> ADDVOTE
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ADDVOTE -> u
forall u. (forall d. Data d => d -> u) -> ADDVOTE -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ADDVOTE
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ADDVOTE -> c ADDVOTE
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ADDVOTE)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ADDVOTE)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ADDVOTE -> c ADDVOTE
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ADDVOTE -> c ADDVOTE
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ADDVOTE
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ADDVOTE
$ctoConstr :: ADDVOTE -> Constr
toConstr :: ADDVOTE -> Constr
$cdataTypeOf :: ADDVOTE -> DataType
dataTypeOf :: ADDVOTE -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ADDVOTE)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ADDVOTE)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ADDVOTE)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ADDVOTE)
$cgmapT :: (forall b. Data b => b -> b) -> ADDVOTE -> ADDVOTE
gmapT :: (forall b. Data b => b -> b) -> ADDVOTE -> ADDVOTE
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ADDVOTE -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ADDVOTE -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ADDVOTE -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ADDVOTE -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ADDVOTE -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ADDVOTE -> m ADDVOTE
Data)
data AddvotePredicateFailure
= AVSigDoesNotVerify
| NoUpdateProposal UpId
| VoteByNonGenesisDelegate VKey
| RepeatVoteByGenesisDelegate VKey
deriving (AddvotePredicateFailure -> AddvotePredicateFailure -> Bool
(AddvotePredicateFailure -> AddvotePredicateFailure -> Bool)
-> (AddvotePredicateFailure -> AddvotePredicateFailure -> Bool)
-> Eq AddvotePredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddvotePredicateFailure -> AddvotePredicateFailure -> Bool
== :: AddvotePredicateFailure -> AddvotePredicateFailure -> Bool
$c/= :: AddvotePredicateFailure -> AddvotePredicateFailure -> Bool
/= :: AddvotePredicateFailure -> AddvotePredicateFailure -> Bool
Eq, Int -> AddvotePredicateFailure -> ShowS
[AddvotePredicateFailure] -> ShowS
AddvotePredicateFailure -> String
(Int -> AddvotePredicateFailure -> ShowS)
-> (AddvotePredicateFailure -> String)
-> ([AddvotePredicateFailure] -> ShowS)
-> Show AddvotePredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddvotePredicateFailure -> ShowS
showsPrec :: Int -> AddvotePredicateFailure -> ShowS
$cshow :: AddvotePredicateFailure -> String
show :: AddvotePredicateFailure -> String
$cshowList :: [AddvotePredicateFailure] -> ShowS
showList :: [AddvotePredicateFailure] -> ShowS
Show, Typeable AddvotePredicateFailure
Typeable AddvotePredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AddvotePredicateFailure
-> c AddvotePredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AddvotePredicateFailure)
-> (AddvotePredicateFailure -> Constr)
-> (AddvotePredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AddvotePredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AddvotePredicateFailure))
-> ((forall b. Data b => b -> b)
-> AddvotePredicateFailure -> AddvotePredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> AddvotePredicateFailure -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> AddvotePredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure)
-> Data AddvotePredicateFailure
AddvotePredicateFailure -> Constr
AddvotePredicateFailure -> DataType
(forall b. Data b => b -> b)
-> AddvotePredicateFailure -> AddvotePredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AddvotePredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> AddvotePredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AddvotePredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AddvotePredicateFailure
-> c AddvotePredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AddvotePredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AddvotePredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AddvotePredicateFailure
-> c AddvotePredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AddvotePredicateFailure
-> c AddvotePredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AddvotePredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AddvotePredicateFailure
$ctoConstr :: AddvotePredicateFailure -> Constr
toConstr :: AddvotePredicateFailure -> Constr
$cdataTypeOf :: AddvotePredicateFailure -> DataType
dataTypeOf :: AddvotePredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AddvotePredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AddvotePredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AddvotePredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AddvotePredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> AddvotePredicateFailure -> AddvotePredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> AddvotePredicateFailure -> AddvotePredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AddvotePredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AddvotePredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AddvotePredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AddvotePredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AddvotePredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AddvotePredicateFailure -> m AddvotePredicateFailure
Data, (forall x.
AddvotePredicateFailure -> Rep AddvotePredicateFailure x)
-> (forall x.
Rep AddvotePredicateFailure x -> AddvotePredicateFailure)
-> Generic AddvotePredicateFailure
forall x. Rep AddvotePredicateFailure x -> AddvotePredicateFailure
forall x. AddvotePredicateFailure -> Rep AddvotePredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddvotePredicateFailure -> Rep AddvotePredicateFailure x
from :: forall x. AddvotePredicateFailure -> Rep AddvotePredicateFailure x
$cto :: forall x. Rep AddvotePredicateFailure x -> AddvotePredicateFailure
to :: forall x. Rep AddvotePredicateFailure x -> AddvotePredicateFailure
Generic, Context -> AddvotePredicateFailure -> IO (Maybe ThunkInfo)
Proxy AddvotePredicateFailure -> String
(Context -> AddvotePredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> AddvotePredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy AddvotePredicateFailure -> String)
-> NoThunks AddvotePredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> AddvotePredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> AddvotePredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AddvotePredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> AddvotePredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy AddvotePredicateFailure -> String
showTypeOf :: Proxy AddvotePredicateFailure -> String
NoThunks)
instance STS ADDVOTE where
type
Environment ADDVOTE =
( Set UpId
, Bimap Core.VKeyGenesis Core.VKey
)
type State ADDVOTE = Set (UpId, Core.VKeyGenesis)
type Signal ADDVOTE = Vote
type PredicateFailure ADDVOTE = AddvotePredicateFailure
initialRules :: [InitialRule ADDVOTE]
initialRules = []
transitionRules :: [TransitionRule ADDVOTE]
transitionRules =
[ do
TRC
( (Set UpId
rups, Bimap VKeyGenesis VKey
dms)
, State ADDVOTE
vts
, Signal ADDVOTE
vote
) <-
Rule ADDVOTE 'Transition (RuleContext 'Transition ADDVOTE)
F (Clause ADDVOTE 'Transition) (TRC ADDVOTE)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let pid :: UpId
pid = Signal ADDVOTE
Vote
vote Vote -> Getting UpId Vote UpId -> UpId
forall s a. s -> Getting a s a -> a
^. Getting UpId Vote UpId
Lens' Vote UpId
vPropId
vk :: VKey
vk = Signal ADDVOTE
Vote
vote Vote -> Getting VKey Vote VKey -> VKey
forall s a. s -> Getting a s a -> a
^. Getting VKey Vote VKey
Lens' Vote VKey
vCaster
vtsPid :: Set (UpId, VKeyGenesis)
vtsPid =
case VKey -> Bimap VKeyGenesis VKey -> Maybe VKeyGenesis
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
lookupR VKey
vk Bimap VKeyGenesis VKey
dms of
Just VKeyGenesis
vks -> (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
forall a. a -> Set a
Set.singleton (UpId
pid, VKeyGenesis
vks)
Maybe VKeyGenesis
Nothing -> Set (UpId, VKeyGenesis)
forall a. Set a
Set.empty
Set (UpId, VKeyGenesis)
vtsPid Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis) -> Bool
forall a. Eq a => a -> a -> Bool
/= Set (UpId, VKeyGenesis)
forall a. Set a
Set.empty Bool -> PredicateFailure ADDVOTE -> Rule ADDVOTE 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! VKey -> AddvotePredicateFailure
VoteByNonGenesisDelegate VKey
vk
Bool -> Bool
not (Set (UpId, VKeyGenesis)
vtsPid Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis) -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set (UpId, VKeyGenesis)
State ADDVOTE
vts) Bool -> PredicateFailure ADDVOTE -> Rule ADDVOTE 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! VKey -> AddvotePredicateFailure
RepeatVoteByGenesisDelegate VKey
vk
UpId -> Set UpId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member UpId
pid Set UpId
rups Bool -> PredicateFailure ADDVOTE -> Rule ADDVOTE 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! UpId -> AddvotePredicateFailure
NoUpdateProposal UpId
pid
VKey -> UpId -> Sig UpId -> Bool
forall a. Eq a => VKey -> a -> Sig a -> Bool
Core.verify VKey
vk UpId
pid (Signal ADDVOTE
Vote
vote Vote -> Getting (Sig UpId) Vote (Sig UpId) -> Sig UpId
forall s a. s -> Getting a s a -> a
^. Getting (Sig UpId) Vote (Sig UpId)
Lens' Vote (Sig UpId)
vSig) Bool -> PredicateFailure ADDVOTE -> Rule ADDVOTE 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure ADDVOTE
AddvotePredicateFailure
AVSigDoesNotVerify
Set (UpId, VKeyGenesis)
-> F (Clause ADDVOTE 'Transition) (Set (UpId, VKeyGenesis))
forall a. a -> F (Clause ADDVOTE 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set (UpId, VKeyGenesis)
-> F (Clause ADDVOTE 'Transition) (Set (UpId, VKeyGenesis)))
-> Set (UpId, VKeyGenesis)
-> F (Clause ADDVOTE 'Transition) (Set (UpId, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! Set (UpId, VKeyGenesis)
State ADDVOTE
vts Set (UpId, VKeyGenesis)
-> Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
forall a. Semigroup a => a -> a -> a
<> Set (UpId, VKeyGenesis)
vtsPid
]
data UPVOTE deriving ((forall x. UPVOTE -> Rep UPVOTE x)
-> (forall x. Rep UPVOTE x -> UPVOTE) -> Generic UPVOTE
forall x. Rep UPVOTE x -> UPVOTE
forall x. UPVOTE -> Rep UPVOTE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPVOTE -> Rep UPVOTE x
from :: forall x. UPVOTE -> Rep UPVOTE x
$cto :: forall x. Rep UPVOTE x -> UPVOTE
to :: forall x. Rep UPVOTE x -> UPVOTE
Generic, Typeable UPVOTE
Typeable UPVOTE =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPVOTE -> c UPVOTE)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPVOTE)
-> (UPVOTE -> Constr)
-> (UPVOTE -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPVOTE))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPVOTE))
-> ((forall b. Data b => b -> b) -> UPVOTE -> UPVOTE)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPVOTE -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPVOTE -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPVOTE -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPVOTE -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE)
-> Data UPVOTE
UPVOTE -> Constr
UPVOTE -> DataType
(forall b. Data b => b -> b) -> UPVOTE -> UPVOTE
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPVOTE -> u
forall u. (forall d. Data d => d -> u) -> UPVOTE -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPVOTE -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPVOTE -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPVOTE
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPVOTE -> c UPVOTE
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPVOTE)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPVOTE)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPVOTE -> c UPVOTE
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPVOTE -> c UPVOTE
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPVOTE
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPVOTE
$ctoConstr :: UPVOTE -> Constr
toConstr :: UPVOTE -> Constr
$cdataTypeOf :: UPVOTE -> DataType
dataTypeOf :: UPVOTE -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPVOTE)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPVOTE)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPVOTE)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPVOTE)
$cgmapT :: (forall b. Data b => b -> b) -> UPVOTE -> UPVOTE
gmapT :: (forall b. Data b => b -> b) -> UPVOTE -> UPVOTE
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPVOTE -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPVOTE -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPVOTE -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPVOTE -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPVOTE -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPVOTE -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPVOTE -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPVOTE -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPVOTE -> m UPVOTE
Data)
data UpvotePredicateFailure
= ADDVOTEFailure (PredicateFailure ADDVOTE)
| S_HigherThanThdAndNotAlreadyConfirmed
| S_CfmThdNotReached
| S_AlreadyConfirmed
deriving (UpvotePredicateFailure -> UpvotePredicateFailure -> Bool
(UpvotePredicateFailure -> UpvotePredicateFailure -> Bool)
-> (UpvotePredicateFailure -> UpvotePredicateFailure -> Bool)
-> Eq UpvotePredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpvotePredicateFailure -> UpvotePredicateFailure -> Bool
== :: UpvotePredicateFailure -> UpvotePredicateFailure -> Bool
$c/= :: UpvotePredicateFailure -> UpvotePredicateFailure -> Bool
/= :: UpvotePredicateFailure -> UpvotePredicateFailure -> Bool
Eq, Int -> UpvotePredicateFailure -> ShowS
[UpvotePredicateFailure] -> ShowS
UpvotePredicateFailure -> String
(Int -> UpvotePredicateFailure -> ShowS)
-> (UpvotePredicateFailure -> String)
-> ([UpvotePredicateFailure] -> ShowS)
-> Show UpvotePredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpvotePredicateFailure -> ShowS
showsPrec :: Int -> UpvotePredicateFailure -> ShowS
$cshow :: UpvotePredicateFailure -> String
show :: UpvotePredicateFailure -> String
$cshowList :: [UpvotePredicateFailure] -> ShowS
showList :: [UpvotePredicateFailure] -> ShowS
Show, Typeable UpvotePredicateFailure
Typeable UpvotePredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvotePredicateFailure
-> c UpvotePredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvotePredicateFailure)
-> (UpvotePredicateFailure -> Constr)
-> (UpvotePredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvotePredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvotePredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpvotePredicateFailure -> UpvotePredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpvotePredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpvotePredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure)
-> Data UpvotePredicateFailure
UpvotePredicateFailure -> Constr
UpvotePredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpvotePredicateFailure -> UpvotePredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpvotePredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpvotePredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvotePredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvotePredicateFailure
-> c UpvotePredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvotePredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvotePredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvotePredicateFailure
-> c UpvotePredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpvotePredicateFailure
-> c UpvotePredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvotePredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpvotePredicateFailure
$ctoConstr :: UpvotePredicateFailure -> Constr
toConstr :: UpvotePredicateFailure -> Constr
$cdataTypeOf :: UpvotePredicateFailure -> DataType
dataTypeOf :: UpvotePredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvotePredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpvotePredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvotePredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpvotePredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpvotePredicateFailure -> UpvotePredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpvotePredicateFailure -> UpvotePredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpvotePredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpvotePredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpvotePredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpvotePredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpvotePredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpvotePredicateFailure -> m UpvotePredicateFailure
Data, (forall x. UpvotePredicateFailure -> Rep UpvotePredicateFailure x)
-> (forall x.
Rep UpvotePredicateFailure x -> UpvotePredicateFailure)
-> Generic UpvotePredicateFailure
forall x. Rep UpvotePredicateFailure x -> UpvotePredicateFailure
forall x. UpvotePredicateFailure -> Rep UpvotePredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpvotePredicateFailure -> Rep UpvotePredicateFailure x
from :: forall x. UpvotePredicateFailure -> Rep UpvotePredicateFailure x
$cto :: forall x. Rep UpvotePredicateFailure x -> UpvotePredicateFailure
to :: forall x. Rep UpvotePredicateFailure x -> UpvotePredicateFailure
Generic, Context -> UpvotePredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpvotePredicateFailure -> String
(Context -> UpvotePredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpvotePredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpvotePredicateFailure -> String)
-> NoThunks UpvotePredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpvotePredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpvotePredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpvotePredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpvotePredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpvotePredicateFailure -> String
showTypeOf :: Proxy UpvotePredicateFailure -> String
NoThunks)
instance STS UPVOTE where
type
Environment UPVOTE =
( Core.Slot
, Word8
, Set UpId
, Bimap Core.VKeyGenesis Core.VKey
)
type
State UPVOTE =
( Map UpId Core.Slot
, Set (UpId, Core.VKeyGenesis)
)
type Signal UPVOTE = Vote
type PredicateFailure UPVOTE = UpvotePredicateFailure
initialRules :: [InitialRule UPVOTE]
initialRules = []
transitionRules :: [TransitionRule UPVOTE]
transitionRules =
[ do
TRC
( (Slot
_, Word8
t, Set UpId
rups, Bimap VKeyGenesis VKey
dms)
, (Map UpId Slot
cps, Set (UpId, VKeyGenesis)
vts)
, Signal UPVOTE
vote
) <-
Rule UPVOTE 'Transition (RuleContext 'Transition UPVOTE)
F (Clause UPVOTE 'Transition) (TRC UPVOTE)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
Set (UpId, VKeyGenesis)
vts' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @ADDVOTE (RuleContext 'Transition ADDVOTE
-> Rule UPVOTE 'Transition (State ADDVOTE))
-> RuleContext 'Transition ADDVOTE
-> Rule UPVOTE 'Transition (State ADDVOTE)
forall a b. (a -> b) -> a -> b
$ (Environment ADDVOTE, State ADDVOTE, Signal ADDVOTE) -> TRC ADDVOTE
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((Set UpId
rups, Bimap VKeyGenesis VKey
dms), Set (UpId, VKeyGenesis)
State ADDVOTE
vts, Signal UPVOTE
Signal ADDVOTE
vote)
let pid :: UpId
pid = Signal UPVOTE
Vote
vote Vote -> Getting UpId Vote UpId -> UpId
forall s a. s -> Getting a s a -> a
^. Getting UpId Vote UpId
Lens' Vote UpId
vPropId
Set (UpId, VKeyGenesis) -> Word8
forall n. Integral n => Set (UpId, VKeyGenesis) -> n
forall m n. (Relation m, Integral n) => m -> n
size ([UpId
pid] [Domain (Set (UpId, VKeyGenesis))]
-> Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Set (UpId, VKeyGenesis))), Foldable f) =>
f (Domain (Set (UpId, VKeyGenesis)))
-> Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
◁ Set (UpId, VKeyGenesis)
vts') Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
t Bool -> Bool -> Bool
|| UpId
pid UpId -> Set UpId -> Bool
forall a (f :: * -> *). (Eq a, Foldable f) => a -> f a -> Bool
∈ Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId Slot
cps Bool -> PredicateFailure UPVOTE -> Rule UPVOTE 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPVOTE
UpvotePredicateFailure
S_HigherThanThdAndNotAlreadyConfirmed
(Map UpId Slot, Set (UpId, VKeyGenesis))
-> F (Clause UPVOTE 'Transition)
(Map UpId Slot, Set (UpId, VKeyGenesis))
forall a. a -> F (Clause UPVOTE 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map UpId Slot, Set (UpId, VKeyGenesis))
-> F (Clause UPVOTE 'Transition)
(Map UpId Slot, Set (UpId, VKeyGenesis)))
-> (Map UpId Slot, Set (UpId, VKeyGenesis))
-> F (Clause UPVOTE 'Transition)
(Map UpId Slot, Set (UpId, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$!
( Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts'
)
, do
TRC
( (Slot
sn, Word8
t, Set UpId
rups, Bimap VKeyGenesis VKey
dms)
, (Map UpId Slot
cps, Set (UpId, VKeyGenesis)
vts)
, Signal UPVOTE
vote
) <-
Rule UPVOTE 'Transition (RuleContext 'Transition UPVOTE)
F (Clause UPVOTE 'Transition) (TRC UPVOTE)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
Set (UpId, VKeyGenesis)
vts' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @ADDVOTE (RuleContext 'Transition ADDVOTE
-> Rule UPVOTE 'Transition (State ADDVOTE))
-> RuleContext 'Transition ADDVOTE
-> Rule UPVOTE 'Transition (State ADDVOTE)
forall a b. (a -> b) -> a -> b
$ (Environment ADDVOTE, State ADDVOTE, Signal ADDVOTE) -> TRC ADDVOTE
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((Set UpId
rups, Bimap VKeyGenesis VKey
dms), Set (UpId, VKeyGenesis)
State ADDVOTE
vts, Signal UPVOTE
Signal ADDVOTE
vote)
let pid :: UpId
pid = Signal UPVOTE
Vote
vote Vote -> Getting UpId Vote UpId -> UpId
forall s a. s -> Getting a s a -> a
^. Getting UpId Vote UpId
Lens' Vote UpId
vPropId
Word8
t Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Set (UpId, VKeyGenesis) -> Word8
forall n. Integral n => Set (UpId, VKeyGenesis) -> n
forall m n. (Relation m, Integral n) => m -> n
size ([UpId
pid] [Domain (Set (UpId, VKeyGenesis))]
-> Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Set (UpId, VKeyGenesis))), Foldable f) =>
f (Domain (Set (UpId, VKeyGenesis)))
-> Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
◁ Set (UpId, VKeyGenesis)
vts') Bool -> PredicateFailure UPVOTE -> Rule UPVOTE 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPVOTE
UpvotePredicateFailure
S_CfmThdNotReached
UpId
pid UpId -> Set UpId -> Bool
forall a (f :: * -> *). (Eq a, Foldable f) => a -> f a -> Bool
∉ Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId Slot
cps Bool -> PredicateFailure UPVOTE -> Rule UPVOTE 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPVOTE
UpvotePredicateFailure
S_AlreadyConfirmed
(Map UpId Slot, Set (UpId, VKeyGenesis))
-> F (Clause UPVOTE 'Transition)
(Map UpId Slot, Set (UpId, VKeyGenesis))
forall a. a -> F (Clause UPVOTE 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map UpId Slot, Set (UpId, VKeyGenesis))
-> F (Clause UPVOTE 'Transition)
(Map UpId Slot, Set (UpId, VKeyGenesis)))
-> (Map UpId Slot, Set (UpId, VKeyGenesis))
-> F (Clause UPVOTE 'Transition)
(Map UpId Slot, Set (UpId, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$!
( Map UpId Slot
cps Map UpId Slot
-> [(Domain (Map UpId Slot), Range (Map UpId Slot))]
-> Map UpId Slot
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Ord (Range m), Foldable f) =>
m -> f (Domain m, Range m) -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId Slot)), Ord (Range (Map UpId Slot)),
Foldable f) =>
Map UpId Slot
-> f (Domain (Map UpId Slot), Range (Map UpId Slot))
-> Map UpId Slot
⨃ [(UpId
pid, Slot
sn)]
, Set (UpId, VKeyGenesis)
vts'
)
]
instance Embed ADDVOTE UPVOTE where
wrapFailed :: PredicateFailure ADDVOTE -> PredicateFailure UPVOTE
wrapFailed = PredicateFailure ADDVOTE -> PredicateFailure UPVOTE
PredicateFailure ADDVOTE -> UpvotePredicateFailure
ADDVOTEFailure
data FADS deriving ((forall x. FADS -> Rep FADS x)
-> (forall x. Rep FADS x -> FADS) -> Generic FADS
forall x. Rep FADS x -> FADS
forall x. FADS -> Rep FADS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FADS -> Rep FADS x
from :: forall x. FADS -> Rep FADS x
$cto :: forall x. Rep FADS x -> FADS
to :: forall x. Rep FADS x -> FADS
Generic, Typeable FADS
Typeable FADS =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FADS -> c FADS)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FADS)
-> (FADS -> Constr)
-> (FADS -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FADS))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FADS))
-> ((forall b. Data b => b -> b) -> FADS -> FADS)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r)
-> (forall u. (forall d. Data d => d -> u) -> FADS -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FADS -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS)
-> Data FADS
FADS -> Constr
FADS -> DataType
(forall b. Data b => b -> b) -> FADS -> FADS
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FADS -> u
forall u. (forall d. Data d => d -> u) -> FADS -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FADS
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FADS -> c FADS
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FADS)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FADS)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FADS -> c FADS
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FADS -> c FADS
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FADS
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FADS
$ctoConstr :: FADS -> Constr
toConstr :: FADS -> Constr
$cdataTypeOf :: FADS -> DataType
dataTypeOf :: FADS -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FADS)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FADS)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FADS)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FADS)
$cgmapT :: (forall b. Data b => b -> b) -> FADS -> FADS
gmapT :: (forall b. Data b => b -> b) -> FADS -> FADS
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FADS -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FADS -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FADS -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FADS -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FADS -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FADS -> m FADS
Data)
data FadsPredicateFailure
deriving (FadsPredicateFailure -> FadsPredicateFailure -> Bool
(FadsPredicateFailure -> FadsPredicateFailure -> Bool)
-> (FadsPredicateFailure -> FadsPredicateFailure -> Bool)
-> Eq FadsPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FadsPredicateFailure -> FadsPredicateFailure -> Bool
== :: FadsPredicateFailure -> FadsPredicateFailure -> Bool
$c/= :: FadsPredicateFailure -> FadsPredicateFailure -> Bool
/= :: FadsPredicateFailure -> FadsPredicateFailure -> Bool
Eq, Int -> FadsPredicateFailure -> ShowS
[FadsPredicateFailure] -> ShowS
FadsPredicateFailure -> String
(Int -> FadsPredicateFailure -> ShowS)
-> (FadsPredicateFailure -> String)
-> ([FadsPredicateFailure] -> ShowS)
-> Show FadsPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FadsPredicateFailure -> ShowS
showsPrec :: Int -> FadsPredicateFailure -> ShowS
$cshow :: FadsPredicateFailure -> String
show :: FadsPredicateFailure -> String
$cshowList :: [FadsPredicateFailure] -> ShowS
showList :: [FadsPredicateFailure] -> ShowS
Show, Typeable FadsPredicateFailure
Typeable FadsPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FadsPredicateFailure
-> c FadsPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FadsPredicateFailure)
-> (FadsPredicateFailure -> Constr)
-> (FadsPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FadsPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FadsPredicateFailure))
-> ((forall b. Data b => b -> b)
-> FadsPredicateFailure -> FadsPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r)
-> (forall u.
(forall d. Data d => d -> u) -> FadsPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> FadsPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure)
-> Data FadsPredicateFailure
FadsPredicateFailure -> Constr
FadsPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> FadsPredicateFailure -> FadsPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FadsPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> FadsPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FadsPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FadsPredicateFailure
-> c FadsPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FadsPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FadsPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FadsPredicateFailure
-> c FadsPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FadsPredicateFailure
-> c FadsPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FadsPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FadsPredicateFailure
$ctoConstr :: FadsPredicateFailure -> Constr
toConstr :: FadsPredicateFailure -> Constr
$cdataTypeOf :: FadsPredicateFailure -> DataType
dataTypeOf :: FadsPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FadsPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FadsPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FadsPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FadsPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> FadsPredicateFailure -> FadsPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> FadsPredicateFailure -> FadsPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FadsPredicateFailure -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FadsPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FadsPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FadsPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FadsPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FadsPredicateFailure -> m FadsPredicateFailure
Data, (forall x. FadsPredicateFailure -> Rep FadsPredicateFailure x)
-> (forall x. Rep FadsPredicateFailure x -> FadsPredicateFailure)
-> Generic FadsPredicateFailure
forall x. Rep FadsPredicateFailure x -> FadsPredicateFailure
forall x. FadsPredicateFailure -> Rep FadsPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FadsPredicateFailure -> Rep FadsPredicateFailure x
from :: forall x. FadsPredicateFailure -> Rep FadsPredicateFailure x
$cto :: forall x. Rep FadsPredicateFailure x -> FadsPredicateFailure
to :: forall x. Rep FadsPredicateFailure x -> FadsPredicateFailure
Generic)
instance STS FADS where
type Environment FADS = ()
type State FADS = [(Core.Slot, (ProtVer, PParams))]
type Signal FADS = (Core.Slot, (ProtVer, PParams))
type PredicateFailure FADS = FadsPredicateFailure
initialRules :: [InitialRule FADS]
initialRules = []
transitionRules :: [TransitionRule FADS]
transitionRules =
[ do
TRC
( ()
, State FADS
fads
, (Slot
sn, (ProtVer
bv, PParams
ppsc))
) <-
Rule FADS 'Transition (RuleContext 'Transition FADS)
F (Clause FADS 'Transition) (TRC FADS)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
[(Slot, (ProtVer, PParams))]
-> F (Clause FADS 'Transition) [(Slot, (ProtVer, PParams))]
forall a. a -> F (Clause FADS 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Slot, (ProtVer, PParams))]
-> F (Clause FADS 'Transition) [(Slot, (ProtVer, PParams))])
-> [(Slot, (ProtVer, PParams))]
-> F (Clause FADS 'Transition) [(Slot, (ProtVer, PParams))]
forall a b. (a -> b) -> a -> b
$ case State FADS
fads of
((Slot
_, (ProtVer
pvc, PParams
_)) : [(Slot, (ProtVer, PParams))]
_) ->
if ProtVer
pvc ProtVer -> ProtVer -> Bool
forall a. Ord a => a -> a -> Bool
< ProtVer
bv
then (Slot
sn, (ProtVer
bv, PParams
ppsc)) (Slot, (ProtVer, PParams))
-> [(Slot, (ProtVer, PParams))] -> [(Slot, (ProtVer, PParams))]
forall a. a -> [a] -> [a]
: [(Slot, (ProtVer, PParams))]
State FADS
fads
else [(Slot, (ProtVer, PParams))]
State FADS
fads
State FADS
_ -> (Slot
sn, (ProtVer
bv, PParams
ppsc)) (Slot, (ProtVer, PParams))
-> [(Slot, (ProtVer, PParams))] -> [(Slot, (ProtVer, PParams))]
forall a. a -> [a] -> [a]
: [(Slot, (ProtVer, PParams))]
State FADS
fads
]
data UPEND deriving ((forall x. UPEND -> Rep UPEND x)
-> (forall x. Rep UPEND x -> UPEND) -> Generic UPEND
forall x. Rep UPEND x -> UPEND
forall x. UPEND -> Rep UPEND x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPEND -> Rep UPEND x
from :: forall x. UPEND -> Rep UPEND x
$cto :: forall x. Rep UPEND x -> UPEND
to :: forall x. Rep UPEND x -> UPEND
Generic, Typeable UPEND
Typeable UPEND =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPEND -> c UPEND)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPEND)
-> (UPEND -> Constr)
-> (UPEND -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPEND))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPEND))
-> ((forall b. Data b => b -> b) -> UPEND -> UPEND)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPEND -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPEND -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND)
-> Data UPEND
UPEND -> Constr
UPEND -> DataType
(forall b. Data b => b -> b) -> UPEND -> UPEND
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPEND -> u
forall u. (forall d. Data d => d -> u) -> UPEND -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPEND
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPEND -> c UPEND
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPEND)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPEND)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPEND -> c UPEND
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPEND -> c UPEND
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPEND
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPEND
$ctoConstr :: UPEND -> Constr
toConstr :: UPEND -> Constr
$cdataTypeOf :: UPEND -> DataType
dataTypeOf :: UPEND -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPEND)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPEND)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPEND)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPEND)
$cgmapT :: (forall b. Data b => b -> b) -> UPEND -> UPEND
gmapT :: (forall b. Data b => b -> b) -> UPEND -> UPEND
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPEND -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPEND -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPEND -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPEND -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPEND -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPEND -> m UPEND
Data)
findKey :: (v -> Bool) -> Map k v -> Maybe (k, v)
findKey :: forall v k. (v -> Bool) -> Map k v -> Maybe (k, v)
findKey v -> Bool
p Map k v
m =
case Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList ((v -> Bool) -> Map k v -> Map k v
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter v -> Bool
p Map k v
m) of
[(k
k, v
v)] -> (k, v) -> Maybe (k, v)
forall a. a -> Maybe a
Just (k
k, v
v)
[(k, v)]
_ -> Maybe (k, v)
forall a. Maybe a
Nothing
data UpendPredicateFailure
= ProtVerUnknown ProtVer
| S_TryNextRule
| CanAdopt ProtVer
| CannotAdopt ProtVer
| NotADelegate VKey
| UnconfirmedProposal UpId
deriving (UpendPredicateFailure -> UpendPredicateFailure -> Bool
(UpendPredicateFailure -> UpendPredicateFailure -> Bool)
-> (UpendPredicateFailure -> UpendPredicateFailure -> Bool)
-> Eq UpendPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpendPredicateFailure -> UpendPredicateFailure -> Bool
== :: UpendPredicateFailure -> UpendPredicateFailure -> Bool
$c/= :: UpendPredicateFailure -> UpendPredicateFailure -> Bool
/= :: UpendPredicateFailure -> UpendPredicateFailure -> Bool
Eq, Int -> UpendPredicateFailure -> ShowS
[UpendPredicateFailure] -> ShowS
UpendPredicateFailure -> String
(Int -> UpendPredicateFailure -> ShowS)
-> (UpendPredicateFailure -> String)
-> ([UpendPredicateFailure] -> ShowS)
-> Show UpendPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpendPredicateFailure -> ShowS
showsPrec :: Int -> UpendPredicateFailure -> ShowS
$cshow :: UpendPredicateFailure -> String
show :: UpendPredicateFailure -> String
$cshowList :: [UpendPredicateFailure] -> ShowS
showList :: [UpendPredicateFailure] -> ShowS
Show, Typeable UpendPredicateFailure
Typeable UpendPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpendPredicateFailure
-> c UpendPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpendPredicateFailure)
-> (UpendPredicateFailure -> Constr)
-> (UpendPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpendPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpendPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpendPredicateFailure -> UpendPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpendPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpendPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpendPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpendPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure)
-> Data UpendPredicateFailure
UpendPredicateFailure -> Constr
UpendPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpendPredicateFailure -> UpendPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpendPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpendPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpendPredicateFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpendPredicateFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpendPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpendPredicateFailure
-> c UpendPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpendPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpendPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpendPredicateFailure
-> c UpendPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpendPredicateFailure
-> c UpendPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpendPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpendPredicateFailure
$ctoConstr :: UpendPredicateFailure -> Constr
toConstr :: UpendPredicateFailure -> Constr
$cdataTypeOf :: UpendPredicateFailure -> DataType
dataTypeOf :: UpendPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpendPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpendPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpendPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpendPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpendPredicateFailure -> UpendPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpendPredicateFailure -> UpendPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpendPredicateFailure -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpendPredicateFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpendPredicateFailure -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpendPredicateFailure -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpendPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpendPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpendPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpendPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpendPredicateFailure -> m UpendPredicateFailure
Data, (forall x. UpendPredicateFailure -> Rep UpendPredicateFailure x)
-> (forall x. Rep UpendPredicateFailure x -> UpendPredicateFailure)
-> Generic UpendPredicateFailure
forall x. Rep UpendPredicateFailure x -> UpendPredicateFailure
forall x. UpendPredicateFailure -> Rep UpendPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpendPredicateFailure -> Rep UpendPredicateFailure x
from :: forall x. UpendPredicateFailure -> Rep UpendPredicateFailure x
$cto :: forall x. Rep UpendPredicateFailure x -> UpendPredicateFailure
to :: forall x. Rep UpendPredicateFailure x -> UpendPredicateFailure
Generic, Context -> UpendPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpendPredicateFailure -> String
(Context -> UpendPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpendPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpendPredicateFailure -> String)
-> NoThunks UpendPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpendPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpendPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpendPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpendPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpendPredicateFailure -> String
showTypeOf :: Proxy UpendPredicateFailure -> String
NoThunks)
instance STS UPEND where
type
Environment UPEND =
( Core.Slot
, Natural
, Bimap VKeyGenesis VKey
, Map UpId Core.Slot
, Map UpId (ProtVer, PParams)
, BlockCount
)
type
State UPEND =
( [(Core.Slot, (ProtVer, PParams))]
, Set (ProtVer, Core.VKeyGenesis)
)
type Signal UPEND = (ProtVer, Core.VKey)
type PredicateFailure UPEND = UpendPredicateFailure
initialRules :: [InitialRule UPEND]
initialRules = []
transitionRules :: [TransitionRule UPEND]
transitionRules =
[ do
TRC
( (Slot
sn, Natural
_t, Bimap VKeyGenesis VKey
_dms, Map UpId Slot
cps, Map UpId (ProtVer, PParams)
rpus, BlockCount
k)
, ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs)
, (ProtVer
bv, VKey
_vk)
) <-
Rule UPEND 'Transition (RuleContext 'Transition UPEND)
F (Clause UPEND 'Transition) (TRC UPEND)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
case ((ProtVer, PParams) -> Bool)
-> Map UpId (ProtVer, PParams) -> Maybe (UpId, (ProtVer, PParams))
forall v k. (v -> Bool) -> Map k v -> Maybe (k, v)
findKey ((ProtVer -> ProtVer -> Bool
forall a. Eq a => a -> a -> Bool
== ProtVer
bv) (ProtVer -> Bool)
-> ((ProtVer, PParams) -> ProtVer) -> (ProtVer, PParams) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer, PParams) -> ProtVer
forall a b. (a, b) -> a
fst) Map UpId (ProtVer, PParams)
rpus of
Just (UpId
pid, (ProtVer, PParams)
_) -> do
UpId
pid UpId -> Set UpId -> Bool
forall a (f :: * -> *). (Eq a, Foldable f) => a -> f a -> Bool
∉ Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (Map UpId Slot
cps Map UpId Slot -> Range (Map UpId Slot) -> Map UpId Slot
forall m. (Relation m, Ord (Range m)) => m -> Range m -> m
▷<= Slot
sn Slot -> SlotCount -> Slot
-. Word64
2 Word64 -> BlockCount -> SlotCount
*. BlockCount
k) Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPEND
UpendPredicateFailure
S_TryNextRule
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs)
Maybe (UpId, (ProtVer, PParams))
Nothing ->
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs)
, do
TRC
( (Slot
sn, Natural
t, Bimap VKeyGenesis VKey
dms, Map UpId Slot
cps, Map UpId (ProtVer, PParams)
rpus, BlockCount
k)
, ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs)
, (ProtVer
bv, VKey
vk)
) <-
Rule UPEND 'Transition (RuleContext 'Transition UPEND)
F (Clause UPEND 'Transition) (TRC UPEND)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
case VKey -> Bimap VKeyGenesis VKey -> Maybe VKeyGenesis
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
lookupR VKey
vk Bimap VKeyGenesis VKey
dms of
Maybe VKeyGenesis
Nothing -> do
Bool
False Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPEND
UpendPredicateFailure
S_TryNextRule
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs)
Just VKeyGenesis
vks -> do
let bvs' :: Set (ProtVer, VKeyGenesis)
bvs' = Set (ProtVer, VKeyGenesis)
bvs Set (ProtVer, VKeyGenesis)
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
forall m.
(Relation m, Ord (Domain m), Ord (Range m)) =>
m -> m -> m
∪ Domain (Set (ProtVer, VKeyGenesis))
-> Range (Set (ProtVer, VKeyGenesis)) -> Set (ProtVer, VKeyGenesis)
forall m. Relation m => Domain m -> Range m -> m
singleton Domain (Set (ProtVer, VKeyGenesis))
ProtVer
bv Range (Set (ProtVer, VKeyGenesis))
VKeyGenesis
vks
Set (ProtVer, VKeyGenesis) -> Natural
forall n. Integral n => Set (ProtVer, VKeyGenesis) -> n
forall m n. (Relation m, Integral n) => m -> n
size ([ProtVer
bv] [Domain (Set (ProtVer, VKeyGenesis))]
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Set (ProtVer, VKeyGenesis))), Foldable f) =>
f (Domain (Set (ProtVer, VKeyGenesis)))
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
◁ Set (ProtVer, VKeyGenesis)
bvs') Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
t Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! ProtVer -> UpendPredicateFailure
CanAdopt ProtVer
bv
case ((ProtVer, PParams) -> Bool)
-> Map UpId (ProtVer, PParams) -> Maybe (UpId, (ProtVer, PParams))
forall v k. (v -> Bool) -> Map k v -> Maybe (k, v)
findKey ((ProtVer -> ProtVer -> Bool
forall a. Eq a => a -> a -> Bool
== ProtVer
bv) (ProtVer -> Bool)
-> ((ProtVer, PParams) -> ProtVer) -> (ProtVer, PParams) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer, PParams) -> ProtVer
forall a b. (a, b) -> a
fst) Map UpId (ProtVer, PParams)
rpus of
Just (UpId
pid, (ProtVer, PParams)
_) -> do
UpId
pid UpId -> Set UpId -> Bool
forall a (f :: * -> *). (Eq a, Foldable f) => a -> f a -> Bool
∈ Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (Map UpId Slot
cps Map UpId Slot -> Range (Map UpId Slot) -> Map UpId Slot
forall m. (Relation m, Ord (Range m)) => m -> Range m -> m
▷<= Slot
sn Slot -> SlotCount -> Slot
-. Word64
2 Word64 -> BlockCount -> SlotCount
*. BlockCount
k) Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPEND
UpendPredicateFailure
S_TryNextRule
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs')
Maybe (UpId, (ProtVer, PParams))
Nothing -> do
Bool
False Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure UPEND
UpendPredicateFailure
S_TryNextRule
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs')
, do
TRC
( (Slot
sn, Natural
t, Bimap VKeyGenesis VKey
dms, Map UpId Slot
cps, Map UpId (ProtVer, PParams)
rpus, BlockCount
k)
, ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs)
, (ProtVer
bv, VKey
vk)
) <-
Rule UPEND 'Transition (RuleContext 'Transition UPEND)
F (Clause UPEND 'Transition) (TRC UPEND)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
case VKey -> Bimap VKeyGenesis VKey -> Maybe VKeyGenesis
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
lookupR VKey
vk Bimap VKeyGenesis VKey
dms of
Maybe VKeyGenesis
Nothing -> do
Bool
False Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! VKey -> UpendPredicateFailure
NotADelegate VKey
vk
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs)
Just VKeyGenesis
vks -> do
let bvs' :: Set (ProtVer, VKeyGenesis)
bvs' = Set (ProtVer, VKeyGenesis)
bvs Set (ProtVer, VKeyGenesis)
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
forall m.
(Relation m, Ord (Domain m), Ord (Range m)) =>
m -> m -> m
∪ Domain (Set (ProtVer, VKeyGenesis))
-> Range (Set (ProtVer, VKeyGenesis)) -> Set (ProtVer, VKeyGenesis)
forall m. Relation m => Domain m -> Range m -> m
singleton Domain (Set (ProtVer, VKeyGenesis))
ProtVer
bv Range (Set (ProtVer, VKeyGenesis))
VKeyGenesis
vks
Natural
t Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Set (ProtVer, VKeyGenesis) -> Natural
forall n. Integral n => Set (ProtVer, VKeyGenesis) -> n
forall m n. (Relation m, Integral n) => m -> n
size ([ProtVer
bv] [Domain (Set (ProtVer, VKeyGenesis))]
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Set (ProtVer, VKeyGenesis))), Foldable f) =>
f (Domain (Set (ProtVer, VKeyGenesis)))
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
◁ Set (ProtVer, VKeyGenesis)
bvs') Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! ProtVer -> UpendPredicateFailure
CannotAdopt ProtVer
bv
case ((ProtVer, PParams) -> Bool)
-> Map UpId (ProtVer, PParams) -> Maybe (UpId, (ProtVer, PParams))
forall v k. (v -> Bool) -> Map k v -> Maybe (k, v)
findKey ((ProtVer -> ProtVer -> Bool
forall a. Eq a => a -> a -> Bool
== ProtVer
bv) (ProtVer -> Bool)
-> ((ProtVer, PParams) -> ProtVer) -> (ProtVer, PParams) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer, PParams) -> ProtVer
forall a b. (a, b) -> a
fst) Map UpId (ProtVer, PParams)
rpus of
Just (UpId
pid, (ProtVer
_, PParams
ppsc)) -> do
UpId
pid UpId -> Set UpId -> Bool
forall a (f :: * -> *). (Eq a, Foldable f) => a -> f a -> Bool
∈ Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (Map UpId Slot
cps Map UpId Slot -> Range (Map UpId Slot) -> Map UpId Slot
forall m. (Relation m, Ord (Range m)) => m -> Range m -> m
▷<= Slot
sn Slot -> SlotCount -> Slot
-. Word64
2 Word64 -> BlockCount -> SlotCount
*. BlockCount
k) Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! UpId -> UpendPredicateFailure
UnconfirmedProposal UpId
pid
[(Slot, (ProtVer, PParams))]
fads' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @FADS (RuleContext 'Transition FADS
-> Rule UPEND 'Transition (State FADS))
-> RuleContext 'Transition FADS
-> Rule UPEND 'Transition (State FADS)
forall a b. (a -> b) -> a -> b
$ (Environment FADS, State FADS, Signal FADS) -> TRC FADS
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), [(Slot, (ProtVer, PParams))]
State FADS
fads, (Slot
sn, (ProtVer
bv, PParams
ppsc)))
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads', Set (ProtVer, VKeyGenesis)
bvs')
Maybe (UpId, (ProtVer, PParams))
Nothing -> do
Bool
False Bool -> PredicateFailure UPEND -> Rule UPEND 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! ProtVer -> UpendPredicateFailure
ProtVerUnknown ProtVer
bv
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a. a -> F (Clause UPEND 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis)))
-> ([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
-> F (Clause UPEND 'Transition)
([(Slot, (ProtVer, PParams))], Set (ProtVer, VKeyGenesis))
forall a b. (a -> b) -> a -> b
$! ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs')
]
instance Embed FADS UPEND where
wrapFailed :: PredicateFailure FADS -> PredicateFailure UPEND
wrapFailed = String -> FadsPredicateFailure -> UpendPredicateFailure
forall a. HasCallStack => String -> a
error String
"No possible failures in FADS"
type UPIEnv =
( Core.Slot
, Bimap Core.VKeyGenesis Core.VKey
, BlockCount
, Word8
)
delegationMap :: UPIEnv -> Bimap Core.VKeyGenesis Core.VKey
delegationMap :: UPIEnv -> Bimap VKeyGenesis VKey
delegationMap (Slot
_, Bimap VKeyGenesis VKey
dms, BlockCount
_, Word8
_) = Bimap VKeyGenesis VKey
dms
type UPIState =
( (ProtVer, PParams)
, [(Core.Slot, (ProtVer, PParams))]
, Map ApName (ApVer, Core.Slot, Metadata)
, Map UpId (ProtVer, PParams)
, Map UpId (ApName, ApVer, Metadata)
, Map UpId Core.Slot
, Set (UpId, Core.VKeyGenesis)
, Set (ProtVer, Core.VKeyGenesis)
, Map UpId Core.Slot
)
fstUPIState :: UPIState -> (ProtVer, PParams)
fstUPIState :: UPIState -> (ProtVer, PParams)
fstUPIState ((ProtVer, PParams)
f, [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = (ProtVer, PParams)
f
sndUPIState :: UPIState -> [(Core.Slot, (ProtVer, PParams))]
sndUPIState :: UPIState -> [(Slot, (ProtVer, PParams))]
sndUPIState ((ProtVer, PParams)
_, [(Slot, (ProtVer, PParams))]
s, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = [(Slot, (ProtVer, PParams))]
s
trdUPIState :: UPIState -> Map ApName (ApVer, Core.Slot, Metadata)
trdUPIState :: UPIState -> Map ApName (ApVer, Slot, Metadata)
trdUPIState ((ProtVer, PParams)
_, [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
t, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = Map ApName (ApVer, Slot, Metadata)
t
emptyUPIState :: UPIState
emptyUPIState :: UPIState
emptyUPIState =
(
( Natural -> Natural -> Natural -> ProtVer
ProtVer Natural
0 Natural
0 Natural
0
, PParams
initialPParams
)
, []
, Map ApName (ApVer, Slot, Metadata)
forall k a. Map k a
Map.empty
, Map UpId (ProtVer, PParams)
forall k a. Map k a
Map.empty
, Map UpId (ApName, ApVer, Metadata)
forall k a. Map k a
Map.empty
, Map UpId Slot
forall k a. Map k a
Map.empty
, Set (UpId, VKeyGenesis)
forall a. Set a
Set.empty
, Set (ProtVer, VKeyGenesis)
forall a. Set a
Set.empty
, Map UpId Slot
forall k a. Map k a
Map.empty
)
initialPParams :: PParams
initialPParams :: PParams
initialPParams =
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.22
, _bkSlotsPerEpoch :: SlotCount
_bkSlotsPerEpoch = SlotCount
10
, _upTtl :: SlotCount
_upTtl = SlotCount
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
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
GP.c)
}
protocolVersion :: UPIState -> ProtVer
protocolVersion :: UPIState -> ProtVer
protocolVersion ((ProtVer
pv, PParams
_), [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = ProtVer
pv
protocolParameters :: UPIState -> PParams
protocolParameters :: UPIState -> PParams
protocolParameters ((ProtVer
_, PParams
pps), [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = PParams
pps
applicationVersions :: UPIState -> Map ApName (ApVer, Core.Slot, Metadata)
applicationVersions :: UPIState -> Map ApName (ApVer, Slot, Metadata)
applicationVersions ((ProtVer
_, PParams
_), [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
avs, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = Map ApName (ApVer, Slot, Metadata)
avs
confirmedProposals :: UPIState -> Map UpId Core.Slot
confirmedProposals :: UPIState -> Map UpId Slot
confirmedProposals ((ProtVer
_, PParams
_), [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
cps, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = Map UpId Slot
cps
futureAdoptions :: UPIState -> [(Core.Slot, (ProtVer, PParams))]
futureAdoptions :: UPIState -> [(Slot, (ProtVer, PParams))]
futureAdoptions ((ProtVer
_, PParams
_), [(Slot, (ProtVer, PParams))]
fads, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = [(Slot, (ProtVer, PParams))]
fads
endorsements :: UPIState -> Set (ProtVer, Core.VKeyGenesis)
endorsements :: UPIState -> Set (ProtVer, VKeyGenesis)
endorsements ((ProtVer
_, PParams
_), [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
_, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
bvs, Map UpId Slot
_) = Set (ProtVer, VKeyGenesis)
bvs
registeredProtocolUpdateProposals :: UPIState -> Map UpId (ProtVer, PParams)
registeredProtocolUpdateProposals :: UPIState -> Map UpId (ProtVer, PParams)
registeredProtocolUpdateProposals ((ProtVer
_, PParams
_), [(Slot, (ProtVer, PParams))]
_, Map ApName (ApVer, Slot, Metadata)
_, Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
_, Map UpId Slot
_, Set (UpId, VKeyGenesis)
_, Set (ProtVer, VKeyGenesis)
_, Map UpId Slot
_) = Map UpId (ProtVer, PParams)
rpus
data UPIREG deriving ((forall x. UPIREG -> Rep UPIREG x)
-> (forall x. Rep UPIREG x -> UPIREG) -> Generic UPIREG
forall x. Rep UPIREG x -> UPIREG
forall x. UPIREG -> Rep UPIREG x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPIREG -> Rep UPIREG x
from :: forall x. UPIREG -> Rep UPIREG x
$cto :: forall x. Rep UPIREG x -> UPIREG
to :: forall x. Rep UPIREG x -> UPIREG
Generic, Typeable UPIREG
Typeable UPIREG =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIREG -> c UPIREG)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIREG)
-> (UPIREG -> Constr)
-> (UPIREG -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIREG))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIREG))
-> ((forall b. Data b => b -> b) -> UPIREG -> UPIREG)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIREG -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIREG -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPIREG -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPIREG -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG)
-> Data UPIREG
UPIREG -> Constr
UPIREG -> DataType
(forall b. Data b => b -> b) -> UPIREG -> UPIREG
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPIREG -> u
forall u. (forall d. Data d => d -> u) -> UPIREG -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIREG -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIREG -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIREG
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIREG -> c UPIREG
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIREG)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIREG)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIREG -> c UPIREG
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIREG -> c UPIREG
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIREG
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIREG
$ctoConstr :: UPIREG -> Constr
toConstr :: UPIREG -> Constr
$cdataTypeOf :: UPIREG -> DataType
dataTypeOf :: UPIREG -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIREG)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIREG)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIREG)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIREG)
$cgmapT :: (forall b. Data b => b -> b) -> UPIREG -> UPIREG
gmapT :: (forall b. Data b => b -> b) -> UPIREG -> UPIREG
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIREG -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIREG -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIREG -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIREG -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPIREG -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPIREG -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIREG -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIREG -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIREG -> m UPIREG
Data)
data UpiregPredicateFailure
= UPREGFailure (PredicateFailure UPREG)
deriving (UpiregPredicateFailure -> UpiregPredicateFailure -> Bool
(UpiregPredicateFailure -> UpiregPredicateFailure -> Bool)
-> (UpiregPredicateFailure -> UpiregPredicateFailure -> Bool)
-> Eq UpiregPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpiregPredicateFailure -> UpiregPredicateFailure -> Bool
== :: UpiregPredicateFailure -> UpiregPredicateFailure -> Bool
$c/= :: UpiregPredicateFailure -> UpiregPredicateFailure -> Bool
/= :: UpiregPredicateFailure -> UpiregPredicateFailure -> Bool
Eq, Int -> UpiregPredicateFailure -> ShowS
[UpiregPredicateFailure] -> ShowS
UpiregPredicateFailure -> String
(Int -> UpiregPredicateFailure -> ShowS)
-> (UpiregPredicateFailure -> String)
-> ([UpiregPredicateFailure] -> ShowS)
-> Show UpiregPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpiregPredicateFailure -> ShowS
showsPrec :: Int -> UpiregPredicateFailure -> ShowS
$cshow :: UpiregPredicateFailure -> String
show :: UpiregPredicateFailure -> String
$cshowList :: [UpiregPredicateFailure] -> ShowS
showList :: [UpiregPredicateFailure] -> ShowS
Show, Typeable UpiregPredicateFailure
Typeable UpiregPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiregPredicateFailure
-> c UpiregPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiregPredicateFailure)
-> (UpiregPredicateFailure -> Constr)
-> (UpiregPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiregPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiregPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpiregPredicateFailure -> UpiregPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpiregPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpiregPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure)
-> Data UpiregPredicateFailure
UpiregPredicateFailure -> Constr
UpiregPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpiregPredicateFailure -> UpiregPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpiregPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpiregPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiregPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiregPredicateFailure
-> c UpiregPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiregPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiregPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiregPredicateFailure
-> c UpiregPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiregPredicateFailure
-> c UpiregPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiregPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiregPredicateFailure
$ctoConstr :: UpiregPredicateFailure -> Constr
toConstr :: UpiregPredicateFailure -> Constr
$cdataTypeOf :: UpiregPredicateFailure -> DataType
dataTypeOf :: UpiregPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiregPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiregPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiregPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiregPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpiregPredicateFailure -> UpiregPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpiregPredicateFailure -> UpiregPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiregPredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpiregPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpiregPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpiregPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpiregPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiregPredicateFailure -> m UpiregPredicateFailure
Data, (forall x. UpiregPredicateFailure -> Rep UpiregPredicateFailure x)
-> (forall x.
Rep UpiregPredicateFailure x -> UpiregPredicateFailure)
-> Generic UpiregPredicateFailure
forall x. Rep UpiregPredicateFailure x -> UpiregPredicateFailure
forall x. UpiregPredicateFailure -> Rep UpiregPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpiregPredicateFailure -> Rep UpiregPredicateFailure x
from :: forall x. UpiregPredicateFailure -> Rep UpiregPredicateFailure x
$cto :: forall x. Rep UpiregPredicateFailure x -> UpiregPredicateFailure
to :: forall x. Rep UpiregPredicateFailure x -> UpiregPredicateFailure
Generic, Context -> UpiregPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpiregPredicateFailure -> String
(Context -> UpiregPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpiregPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpiregPredicateFailure -> String)
-> NoThunks UpiregPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpiregPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpiregPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpiregPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpiregPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpiregPredicateFailure -> String
showTypeOf :: Proxy UpiregPredicateFailure -> String
NoThunks)
instance STS UPIREG where
type Environment UPIREG = UPIEnv
type State UPIREG = UPIState
type Signal UPIREG = UProp
type PredicateFailure UPIREG = UpiregPredicateFailure
initialRules :: [InitialRule UPIREG]
initialRules = [UPIState -> F (Clause UPIREG 'Initial) UPIState
forall a. a -> F (Clause UPIREG 'Initial) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UPIState -> F (Clause UPIREG 'Initial) UPIState)
-> UPIState -> F (Clause UPIREG 'Initial) UPIState
forall a b. (a -> b) -> a -> b
$! UPIState
emptyUPIState]
transitionRules :: [TransitionRule UPIREG]
transitionRules =
[ do
TRC
( (Slot
sn, Bimap VKeyGenesis VKey
dms, BlockCount
_k, Word8
_ngk)
, ( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads
, Map ApName (ApVer, Slot, Metadata)
avs
, Map UpId (ProtVer, PParams)
rpus
, Map UpId (ApName, ApVer, Metadata)
raus
, Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts
, Set (ProtVer, VKeyGenesis)
bvs
, Map UpId Slot
pws
)
, Signal UPIREG
up
) <-
Rule UPIREG 'Transition (RuleContext 'Transition UPIREG)
F (Clause UPIREG 'Transition) (TRC UPIREG)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
(Map UpId (ProtVer, PParams)
rpus', Map UpId (ApName, ApVer, Metadata)
raus') <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPREG (RuleContext 'Transition UPREG
-> Rule UPIREG 'Transition (State UPREG))
-> RuleContext 'Transition UPREG
-> Rule UPIREG 'Transition (State UPREG)
forall a b. (a -> b) -> a -> b
$ (Environment UPREG, State UPREG, Signal UPREG) -> TRC UPREG
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((ProtVer
pv, PParams
pps, Map ApName (ApVer, Slot, Metadata)
avs, Bimap VKeyGenesis VKey
dms), (Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus), Signal UPREG
Signal UPIREG
up)
let pws' :: Map UpId Slot
pws' = Map UpId Slot
pws Map UpId Slot
-> [(Domain (Map UpId Slot), Range (Map UpId Slot))]
-> Map UpId Slot
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Ord (Range m), Foldable f) =>
m -> f (Domain m, Range m) -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId Slot)), Ord (Range (Map UpId Slot)),
Foldable f) =>
Map UpId Slot
-> f (Domain (Map UpId Slot), Range (Map UpId Slot))
-> Map UpId Slot
⨃ [(Signal UPIREG
UProp
up UProp -> Getting UpId UProp UpId -> UpId
forall s a. s -> Getting a s a -> a
^. Getting UpId UProp UpId
Lens' UProp UpId
upId, Slot
sn)]
UPIState -> F (Clause UPIREG 'Transition) UPIState
forall a. a -> F (Clause UPIREG 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UPIState -> F (Clause UPIREG 'Transition) UPIState)
-> UPIState -> F (Clause UPIREG 'Transition) UPIState
forall a b. (a -> b) -> a -> b
$!
( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads
, Map ApName (ApVer, Slot, Metadata)
avs
, Map UpId (ProtVer, PParams)
rpus'
, Map UpId (ApName, ApVer, Metadata)
raus'
, Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts
, Set (ProtVer, VKeyGenesis)
bvs
, Map UpId Slot
pws'
)
]
instance Embed UPREG UPIREG where
wrapFailed :: PredicateFailure UPREG -> PredicateFailure UPIREG
wrapFailed = PredicateFailure UPREG -> PredicateFailure UPIREG
PredicateFailure UPREG -> UpiregPredicateFailure
UPREGFailure
instance HasTrace UPIREG where
envGen :: Word64 -> Gen (Environment UPIREG)
envGen Word64
_ = Gen UPIEnv
Gen (Environment UPIREG)
upiEnvGen
sigGen :: SignalGenerator UPIREG
sigGen (Slot
_slot, Bimap VKeyGenesis VKey
dms, BlockCount
_k, Word8
_ngk) ((ProtVer
pv, PParams
pps), [(Slot, (ProtVer, PParams))]
_fads, Map ApName (ApVer, Slot, Metadata)
avs, Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
raus, Map UpId Slot
_cps, Set (UpId, VKeyGenesis)
_vts, Set (ProtVer, VKeyGenesis)
_bvs, Map UpId Slot
pws) =
do
(VKey
vk, ProtVer
pv', PParams
pps', SwVer
sv') <-
(,,,)
(VKey
-> ProtVer -> PParams -> SwVer -> (VKey, ProtVer, PParams, SwVer))
-> GenT Identity VKey
-> GenT
Identity
(ProtVer -> PParams -> SwVer -> (VKey, ProtVer, PParams, SwVer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VKey
issuerGen
GenT
Identity
(ProtVer -> PParams -> SwVer -> (VKey, ProtVer, PParams, SwVer))
-> GenT Identity ProtVer
-> GenT
Identity (PParams -> SwVer -> (VKey, ProtVer, PParams, SwVer))
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ProtVer
pvGen
GenT Identity (PParams -> SwVer -> (VKey, ProtVer, PParams, SwVer))
-> GenT Identity PParams
-> GenT Identity (SwVer -> (VKey, ProtVer, PParams, SwVer))
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity PParams
pparamsGen
GenT Identity (SwVer -> (VKey, ProtVer, PParams, SwVer))
-> GenT Identity SwVer
-> GenT Identity (VKey, ProtVer, PParams, SwVer)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SwVer
swVerGen
[(Int, GenT Identity UProp)] -> GenT Identity UProp
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
Gen.frequency
[
(Int
10, VKey -> PParams -> ProtVer -> SwVer -> GenT Identity UProp
generateUpdateProposalWith VKey
vk PParams
pps ProtVer
pv SwVer
sv')
,
( Int
45
, do
let makeSoftwareVersion :: (ApName, (ApVer, b, c)) -> SwVer
makeSoftwareVersion (ApName
apName, (ApVer
apVersion, b
_, c
_)) = ApName -> ApVer -> SwVer
SwVer ApName
apName ApVer
apVersion
avsList :: [(ApName, (ApVer, Slot, Metadata))]
avsList = Map ApName (ApVer, Slot, Metadata)
-> [(ApName, (ApVer, Slot, Metadata))]
forall k a. Map k a -> [(k, a)]
Map.toList Map ApName (ApVer, Slot, Metadata)
avs
SwVer
currentSoftwareVersion <-
if [(ApName, (ApVer, Slot, Metadata))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ApName, (ApVer, Slot, Metadata))]
avsList
then SwVer -> GenT Identity SwVer
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwVer -> GenT Identity SwVer) -> SwVer -> GenT Identity SwVer
forall a b. (a -> b) -> a -> b
$! SwVer
sv'
else (ApName, (ApVer, Slot, Metadata)) -> SwVer
forall {b} {c}. (ApName, (ApVer, b, c)) -> SwVer
makeSoftwareVersion ((ApName, (ApVer, Slot, Metadata)) -> SwVer)
-> GenT Identity (ApName, (ApVer, Slot, Metadata))
-> GenT Identity SwVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ApName, (ApVer, Slot, Metadata))]
-> GenT Identity (ApName, (ApVer, Slot, Metadata))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [(ApName, (ApVer, Slot, Metadata))]
avsList
VKey -> PParams -> ProtVer -> SwVer -> GenT Identity UProp
generateUpdateProposalWith VKey
vk PParams
pps' ProtVer
pv' SwVer
currentSoftwareVersion
)
,
(Int
45, VKey -> PParams -> ProtVer -> SwVer -> GenT Identity UProp
generateUpdateProposalWith VKey
vk PParams
pps' ProtVer
pv' SwVer
sv')
]
where
idGen :: Gen UpId
idGen :: Gen UpId
idGen = do
Int
inc <- Range Int -> GenT Identity Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
1 Int
10)
case Set UpId -> [UpId]
forall a. Set a -> [a]
Set.toDescList (Set UpId -> [UpId]) -> Set UpId -> [UpId]
forall a b. (a -> b) -> a -> b
$ Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId Slot
pws of
[] -> Int -> UpId
UpId (Int -> UpId) -> GenT Identity Int -> Gen UpId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> GenT Identity Int
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [Int
0 .. Int
inc]
(UpId Int
maxId : [UpId]
_) -> UpId -> Gen UpId
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpId -> Gen UpId) -> UpId -> Gen UpId
forall a b. (a -> b) -> a -> b
$ Int -> UpId
UpId (Int
maxId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inc)
issuerGen :: Gen Core.VKey
issuerGen :: GenT Identity VKey
issuerGen =
if [VKey] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VKey]
delegates
then String -> GenT Identity VKey
forall a. HasCallStack => String -> a
error String
"There are no delegates to issue an update proposal."
else [VKey] -> GenT Identity VKey
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [VKey]
delegates
where
delegates :: [VKey]
delegates = Set VKey -> [VKey]
forall a. Set a -> [a]
Set.toList (Bimap VKeyGenesis VKey -> Set (Range (Bimap VKeyGenesis VKey))
forall m. (Relation m, Ord (Range m)) => m -> Set (Range m)
range Bimap VKeyGenesis VKey
dms)
pparamsGen :: Gen PParams
pparamsGen :: GenT Identity PParams
pparamsGen = PParams -> GenT Identity PParams
ppsUpdateFrom PParams
pps
pvGen :: Gen ProtVer
pvGen :: GenT Identity ProtVer
pvGen =
(Natural, Natural) -> ProtVer
nextAltVersion
((Natural, Natural) -> ProtVer)
-> GenT Identity (Natural, Natural) -> GenT Identity ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Natural, Natural)] -> GenT Identity (Natural, Natural)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element
[ (ProtVer -> Natural
_pvMaj ProtVer
pv Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1, Natural
0)
, (ProtVer -> Natural
_pvMaj ProtVer
pv, ProtVer -> Natural
_pvMin ProtVer
pv Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1)
]
where
nextAltVersion :: (Natural, Natural) -> ProtVer
nextAltVersion :: (Natural, Natural) -> ProtVer
nextAltVersion (Natural
maj, Natural
mn) =
Set (ProtVer, PParams) -> Set (Domain (Set (ProtVer, PParams)))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (Map UpId (ProtVer, PParams)
-> Set (Range (Map UpId (ProtVer, PParams)))
forall m. (Relation m, Ord (Range m)) => m -> Set (Range m)
range Map UpId (ProtVer, PParams)
rpus)
Set ProtVer -> (Set ProtVer -> Set ProtVer) -> Set ProtVer
forall a b. a -> (a -> b) -> b
& (ProtVer -> Bool) -> Set ProtVer -> Set ProtVer
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ProtVer -> Bool
protocolVersionEqualsMajMin
Set ProtVer -> (Set ProtVer -> Set Natural) -> Set Natural
forall a b. a -> (a -> b) -> b
& (ProtVer -> Natural) -> Set ProtVer -> Set Natural
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ProtVer -> Natural
_pvAlt
Set Natural -> (Set Natural -> [Natural]) -> [Natural]
forall a b. a -> (a -> b) -> b
& Set Natural -> [Natural]
forall a. Set a -> [a]
Set.toDescList
[Natural] -> ([Natural] -> ProtVer) -> ProtVer
forall a b. a -> (a -> b) -> b
& [Natural] -> ProtVer
nextVersion
where
protocolVersionEqualsMajMin :: ProtVer -> Bool
protocolVersionEqualsMajMin :: ProtVer -> Bool
protocolVersionEqualsMajMin ProtVer
pv' =
ProtVer -> Natural
_pvMaj ProtVer
pv' Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
maj Bool -> Bool -> Bool
&& ProtVer -> Natural
_pvMin ProtVer
pv' Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
mn
nextVersion :: [Natural] -> ProtVer
nextVersion :: [Natural] -> ProtVer
nextVersion [] = Natural -> Natural -> Natural -> ProtVer
ProtVer Natural
maj Natural
mn Natural
0
nextVersion (Natural
x : [Natural]
_) = Natural -> Natural -> Natural -> ProtVer
ProtVer Natural
maj Natural
mn (Natural
1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
x)
swVerGen :: Gen SwVer
swVerGen :: GenT Identity SwVer
swVerGen =
if [(ApName, ApVer)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ApName, ApVer)]
possibleNextVersions
then GenT Identity SwVer
genNewApp
else [GenT Identity SwVer] -> GenT Identity SwVer
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [GenT Identity SwVer
genANextVersion, GenT Identity SwVer
genNewApp]
where
possibleNextVersions :: [(ApName, ApVer)]
possibleNextVersions :: [(ApName, ApVer)]
possibleNextVersions = Set (ApName, ApVer) -> [(ApName, ApVer)]
forall a. Set a -> [a]
Set.toList (Set (ApName, ApVer) -> [(ApName, ApVer)])
-> Set (ApName, ApVer) -> [(ApName, ApVer)]
forall a b. (a -> b) -> a -> b
$ Set (ApName, ApVer)
nextVersions Set (ApName, ApVer) -> Set (ApName, ApVer) -> Set (ApName, ApVer)
forall a. Ord a => Set a -> Set a -> Set a
\\ Set (ApName, ApVer)
registeredNextVersions
where
nextVersions :: Set (ApName, ApVer)
nextVersions :: Set (ApName, ApVer)
nextVersions = [(ApName, ApVer)] -> Set (ApName, ApVer)
forall a. Ord a => [a] -> Set a
Set.fromList ([(ApName, ApVer)] -> Set (ApName, ApVer))
-> [(ApName, ApVer)] -> Set (ApName, ApVer)
forall a b. (a -> b) -> a -> b
$ [ApName] -> [ApVer] -> [(ApName, ApVer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ApName]
currentAppNames [ApVer]
nextAppVersions
where
([ApName]
currentAppNames, [(ApVer, Slot, Metadata)]
currentAppVersions) = [(ApName, (ApVer, Slot, Metadata))]
-> ([ApName], [(ApVer, Slot, Metadata)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ApName, (ApVer, Slot, Metadata))]
-> ([ApName], [(ApVer, Slot, Metadata)]))
-> [(ApName, (ApVer, Slot, Metadata))]
-> ([ApName], [(ApVer, Slot, Metadata)])
forall a b. (a -> b) -> a -> b
$ Map ApName (ApVer, Slot, Metadata)
-> [(ApName, (ApVer, Slot, Metadata))]
forall k a. Map k a -> [(k, a)]
Map.toList Map ApName (ApVer, Slot, Metadata)
avs
nextAppVersions :: [ApVer]
nextAppVersions :: [ApVer]
nextAppVersions = (ApVer -> ApVer -> ApVer
forall a. Num a => a -> a -> a
+ ApVer
1) (ApVer -> ApVer)
-> ((ApVer, Slot, Metadata) -> ApVer)
-> (ApVer, Slot, Metadata)
-> ApVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApVer, Slot, Metadata) -> ApVer
forall {a} {b} {c}. (a, b, c) -> a
fst3 ((ApVer, Slot, Metadata) -> ApVer)
-> [(ApVer, Slot, Metadata)] -> [ApVer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ApVer, Slot, Metadata)]
currentAppVersions
registeredNextVersions :: Set (ApName, ApVer)
registeredNextVersions :: Set (ApName, ApVer)
registeredNextVersions = ((ApName, ApVer, Metadata) -> (ApName, ApVer))
-> Set (ApName, ApVer, Metadata) -> Set (ApName, ApVer)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((ApName, ApVer, Metadata) -> ApName
forall {a} {b} {c}. (a, b, c) -> a
fst3 ((ApName, ApVer, Metadata) -> ApName)
-> ((ApName, ApVer, Metadata) -> ApVer)
-> (ApName, ApVer, Metadata)
-> (ApName, ApVer)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (ApName, ApVer, Metadata) -> ApVer
forall {a} {b} {c}. (a, b, c) -> b
snd3) (Map UpId (ApName, ApVer, Metadata)
-> Set (Range (Map UpId (ApName, ApVer, Metadata)))
forall m. (Relation m, Ord (Range m)) => m -> Set (Range m)
range Map UpId (ApName, ApVer, Metadata)
raus)
genANextVersion :: Gen SwVer
genANextVersion :: GenT Identity SwVer
genANextVersion = (ApName -> ApVer -> SwVer) -> (ApName, ApVer) -> SwVer
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ApName -> ApVer -> SwVer
SwVer ((ApName, ApVer) -> SwVer)
-> GenT Identity (ApName, ApVer) -> GenT Identity SwVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ApName, ApVer)] -> GenT Identity (ApName, ApVer)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [(ApName, ApVer)]
possibleNextVersions
fst3 :: (a, b, c) -> a
fst3 (a
x, b
_, c
_) = a
x
snd3 :: (a, b, c) -> b
snd3 (a
_, b
y, c
_) = b
y
genNewApp :: Gen SwVer
genNewApp :: GenT Identity SwVer
genNewApp =
(ApName -> ApVer -> SwVer
`SwVer` ApVer
1) (ApName -> SwVer) -> (String -> ApName) -> String -> SwVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ApName
ApName
(String -> SwVer) -> GenT Identity String -> GenT Identity SwVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> GenT Identity String -> GenT Identity String
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter
((ApName -> Set ApName -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set ApName
usedNames) (ApName -> Bool) -> (String -> ApName) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ApName
ApName)
(Range Int -> GenT Identity Char -> GenT Identity String
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
12) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.ascii)
where
usedNames :: Set ApName
usedNames =
((ApName, ApVer, Metadata) -> ApName)
-> Set (ApName, ApVer, Metadata) -> Set ApName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (ApName, ApVer, Metadata) -> ApName
forall {a} {b} {c}. (a, b, c) -> a
fst3 (Map UpId (ApName, ApVer, Metadata)
-> Set (Range (Map UpId (ApName, ApVer, Metadata)))
forall m. (Relation m, Ord (Range m)) => m -> Set (Range m)
range Map UpId (ApName, ApVer, Metadata)
raus)
Set ApName -> Set ApName -> Set ApName
forall a. Ord a => Set a -> Set a -> Set a
`union` Map ApName (ApVer, Slot, Metadata)
-> Set (Domain (Map ApName (ApVer, Slot, Metadata)))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map ApName (ApVer, Slot, Metadata)
avs
generateUpdateProposalWith ::
VKey ->
PParams ->
ProtVer ->
SwVer ->
Gen UProp
generateUpdateProposalWith :: VKey -> PParams -> ProtVer -> SwVer -> GenT Identity UProp
generateUpdateProposalWith VKey
vk PParams
pps' ProtVer
pv' SwVer
sv' =
UpId
-> VKey
-> ProtVer
-> PParams
-> SwVer
-> Set String
-> Metadata
-> UProp
mkUProp
(UpId
-> VKey
-> ProtVer
-> PParams
-> SwVer
-> Set String
-> Metadata
-> UProp)
-> Gen UpId
-> GenT
Identity
(VKey
-> ProtVer -> PParams -> SwVer -> Set String -> Metadata -> UProp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UpId
idGen
GenT
Identity
(VKey
-> ProtVer -> PParams -> SwVer -> Set String -> Metadata -> UProp)
-> GenT Identity VKey
-> GenT
Identity
(ProtVer -> PParams -> SwVer -> Set String -> Metadata -> UProp)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VKey -> GenT Identity VKey
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VKey
vk
GenT
Identity
(ProtVer -> PParams -> SwVer -> Set String -> Metadata -> UProp)
-> GenT Identity ProtVer
-> GenT
Identity (PParams -> SwVer -> Set String -> Metadata -> UProp)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtVer -> GenT Identity ProtVer
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProtVer
pv'
GenT Identity (PParams -> SwVer -> Set String -> Metadata -> UProp)
-> GenT Identity PParams
-> GenT Identity (SwVer -> Set String -> Metadata -> UProp)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PParams -> GenT Identity PParams
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams
pps'
GenT Identity (SwVer -> Set String -> Metadata -> UProp)
-> GenT Identity SwVer
-> GenT Identity (Set String -> Metadata -> UProp)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SwVer -> GenT Identity SwVer
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SwVer
sv'
GenT Identity (Set String -> Metadata -> UProp)
-> GenT Identity (Set String) -> GenT Identity (Metadata -> UProp)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity (Set String)
stTagsGen
GenT Identity (Metadata -> UProp)
-> GenT Identity Metadata -> GenT Identity UProp
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Metadata
mdtGen
stTagsGen :: Gen (Set STag)
stTagsGen :: GenT Identity (Set String)
stTagsGen =
Context -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList
(Context -> Set String)
-> GenT Identity Context -> GenT Identity (Set String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity String -> GenT Identity Context
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
5) (Range Int -> GenT Identity Char -> GenT Identity String
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
10) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.ascii)
mdtGen :: Gen Metadata
mdtGen :: GenT Identity Metadata
mdtGen = Metadata -> GenT Identity Metadata
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Metadata
Metadata
upiEnvGen :: Gen UPIEnv
upiEnvGen :: Gen UPIEnv
upiEnvGen = do
Word8
ngk <- Range Word8 -> GenT Identity Word8
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Word8 -> Word8 -> Range Word8
forall a. Integral a => a -> a -> Range a
Range.linear Word8
1 Word8
14)
(,,,)
(Slot -> Bimap VKeyGenesis VKey -> BlockCount -> Word8 -> UPIEnv)
-> GenT Identity Slot
-> GenT
Identity (Bimap VKeyGenesis VKey -> BlockCount -> Word8 -> UPIEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Word64 -> GenT Identity Slot
CoreGen.slotGen Word64
0 Word64
10
GenT
Identity (Bimap VKeyGenesis VKey -> BlockCount -> Word8 -> UPIEnv)
-> GenT Identity (Bimap VKeyGenesis VKey)
-> GenT Identity (BlockCount -> Word8 -> UPIEnv)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> GenT Identity (Bimap VKeyGenesis VKey)
dmapGen Word8
ngk
GenT Identity (BlockCount -> Word8 -> UPIEnv)
-> GenT Identity BlockCount -> GenT Identity (Word8 -> UPIEnv)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> BlockCount
BlockCount (Word64 -> BlockCount)
-> GenT Identity Word64 -> GenT Identity BlockCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. a -> a -> Range a
Range.constant Word64
0 Word64
100))
GenT Identity (Word8 -> UPIEnv)
-> GenT Identity Word8 -> Gen UPIEnv
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word8 -> GenT Identity Word8
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
ngk
dmapGen :: Word8 -> Gen (Bimap Core.VKeyGenesis Core.VKey)
dmapGen :: Word8 -> GenT Identity (Bimap VKeyGenesis VKey)
dmapGen Word8
ngk = [(VKeyGenesis, VKey)] -> Bimap VKeyGenesis VKey
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList ([(VKeyGenesis, VKey)] -> Bimap VKeyGenesis VKey)
-> (([VKeyGenesis], [VKey]) -> [(VKeyGenesis, VKey)])
-> ([VKeyGenesis], [VKey])
-> Bimap VKeyGenesis VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VKeyGenesis] -> [VKey] -> [(VKeyGenesis, VKey)])
-> ([VKeyGenesis], [VKey]) -> [(VKeyGenesis, VKey)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [VKeyGenesis] -> [VKey] -> [(VKeyGenesis, VKey)]
forall a b. [a] -> [b] -> [(a, b)]
zip (([VKeyGenesis], [VKey]) -> Bimap VKeyGenesis VKey)
-> GenT Identity ([VKeyGenesis], [VKey])
-> GenT Identity (Bimap VKeyGenesis VKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ([VKeyGenesis], [VKey])
vkgVkPairsGen
where
vkgVkPairsGen :: Gen ([Core.VKeyGenesis], [Core.VKey])
vkgVkPairsGen :: GenT Identity ([VKeyGenesis], [VKey])
vkgVkPairsGen = ([VKeyGenesis]
vkgs,) ([VKey] -> ([VKeyGenesis], [VKey]))
-> GenT Identity [VKey] -> GenT Identity ([VKeyGenesis], [VKey])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VKey] -> Bool) -> GenT Identity [VKey] -> GenT Identity [VKey]
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (Bool -> Bool
not (Bool -> Bool) -> ([VKey] -> Bool) -> [VKey] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VKey] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([VKey] -> GenT Identity [VKey]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence [VKey]
vks)
where
vkgs :: [VKeyGenesis]
vkgs = VKey -> VKeyGenesis
VKeyGenesis (VKey -> VKeyGenesis) -> (Word8 -> VKey) -> Word8 -> VKeyGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Owner -> VKey
VKey (Owner -> VKey) -> (Word8 -> Owner) -> Word8 -> VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Owner
Owner (Natural -> Owner) -> (Word8 -> Natural) -> Word8 -> Owner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> VKeyGenesis) -> [Word8] -> [VKeyGenesis]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
0 .. Word8
ngk Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1]
vks :: [VKey]
vks = Owner -> VKey
VKey (Owner -> VKey) -> (Word8 -> Owner) -> Word8 -> VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Owner
Owner (Natural -> Owner) -> (Word8 -> Natural) -> Word8 -> Owner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> VKey) -> [Word8] -> [VKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
0 .. Word8
2 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* (Word8
ngk Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1)]
ppsUpdateFrom :: PParams -> Gen PParams
ppsUpdateFrom :: PParams -> GenT Identity PParams
ppsUpdateFrom PParams
pps = do
Natural
newMaxBkSize <-
Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral
( Natural -> Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom
Natural
_maxBkSz
(Natural
_maxBkSz Natural -> Natural -> Natural
-? Natural
100)
(Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
_maxBkSz)
)
GenT Identity Natural
-> (Natural, Natural) -> GenT Identity Natural
forall a. Gen a -> (a, a) -> Gen a
`increasingProbabilityAt` (Natural
_maxBkSz Natural -> Natural -> Natural
-? Natural
100, Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
_maxBkSz)
let minTxSzBound :: Natural
minTxSzBound = Natural
_maxTxSz Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
`min` Natural
newMaxBkSize Natural -> Natural -> Natural
-? Natural
1
Natural
newMaxTxSize <-
Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral
( Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.exponential
(Natural
minTxSzBound Natural -> Natural -> Natural
-? Natural
10)
(Natural
newMaxBkSize Natural -> Natural -> Natural
-? Natural
1)
)
Natural
-> Natural
-> Natural
-> Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams
PParams
(Natural
-> Natural
-> Natural
-> Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
-> GenT Identity Natural
-> GenT
Identity
(Natural
-> Natural
-> Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> GenT Identity Natural
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
newMaxBkSize
GenT
Identity
(Natural
-> Natural
-> Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
-> GenT Identity Natural
-> GenT
Identity
(Natural
-> Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
nextMaxHdrSzGen
GenT
Identity
(Natural
-> Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
-> GenT Identity Natural
-> GenT
Identity
(Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> GenT Identity Natural
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
newMaxTxSize
GenT
Identity
(Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
-> GenT Identity Natural
-> GenT
Identity
(BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
nextMaxPropSz
GenT
Identity
(BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
-> GenT Identity BkSgnCntT
-> GenT
Identity
(SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity BkSgnCntT
nextBkSgnCntT
GenT
Identity
(SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams)
-> GenT Identity SlotCount
-> GenT
Identity
(SlotCount
-> Natural -> UpAdptThd -> FactorA -> FactorB -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SlotCount -> GenT Identity SlotCount
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SlotCount
_bkSlotsPerEpoch
GenT
Identity
(SlotCount
-> Natural -> UpAdptThd -> FactorA -> FactorB -> PParams)
-> GenT Identity SlotCount
-> GenT
Identity (Natural -> UpAdptThd -> FactorA -> FactorB -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SlotCount
nextUpTtl
GenT
Identity (Natural -> UpAdptThd -> FactorA -> FactorB -> PParams)
-> GenT Identity Natural
-> GenT Identity (UpAdptThd -> FactorA -> FactorB -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Natural
nextScriptVersion
GenT Identity (UpAdptThd -> FactorA -> FactorB -> PParams)
-> GenT Identity UpAdptThd
-> GenT Identity (FactorA -> FactorB -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity UpAdptThd
nextUpAdptThd
GenT Identity (FactorA -> FactorB -> PParams)
-> GenT Identity FactorA -> GenT Identity (FactorB -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity FactorA
nextFactorA
GenT Identity (FactorB -> PParams)
-> GenT Identity FactorB -> GenT Identity PParams
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity FactorB
nextFactorB
where
PParams
{ Natural
_maxBkSz :: PParams -> Natural
_maxBkSz :: Natural
_maxBkSz
, Natural
_maxHdrSz :: PParams -> Natural
_maxHdrSz :: Natural
_maxHdrSz
, Natural
_maxTxSz :: PParams -> Natural
_maxTxSz :: Natural
_maxTxSz
, Natural
_maxPropSz :: PParams -> Natural
_maxPropSz :: Natural
_maxPropSz
, BkSgnCntT
_bkSgnCntT :: PParams -> BkSgnCntT
_bkSgnCntT :: BkSgnCntT
_bkSgnCntT
, SlotCount
_bkSlotsPerEpoch :: PParams -> SlotCount
_bkSlotsPerEpoch :: SlotCount
_bkSlotsPerEpoch
, SlotCount
_upTtl :: PParams -> SlotCount
_upTtl :: SlotCount
_upTtl
, Natural
_scriptVersion :: PParams -> Natural
_scriptVersion :: Natural
_scriptVersion
, UpAdptThd
_upAdptThd :: PParams -> UpAdptThd
_upAdptThd :: UpAdptThd
_upAdptThd
, FactorA
_factorA :: PParams -> FactorA
_factorA :: FactorA
_factorA
, FactorB
_factorB :: PParams -> FactorB
_factorB :: FactorB
_factorB
} = PParams
pps
FactorA Int
fA = FactorA
_factorA
FactorB Int
fB = FactorB
_factorB
BkSgnCntT Double
bsct = BkSgnCntT
_bkSgnCntT
UpAdptThd Double
uat = UpAdptThd
_upAdptThd
nextMaxHdrSzGen :: Gen Natural
nextMaxHdrSzGen :: GenT Identity Natural
nextMaxHdrSzGen =
Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral
( Natural -> Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> a -> Range a
Range.exponentialFrom
Natural
_maxHdrSz
(Natural
_maxHdrSz Natural -> Natural -> Natural
-? Natural
10)
(Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
_maxHdrSz)
)
nextMaxPropSz :: Gen Natural
nextMaxPropSz :: GenT Identity Natural
nextMaxPropSz =
Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral
( Natural -> Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> a -> Range a
Range.exponentialFrom
Natural
_maxPropSz
(Natural
_maxPropSz Natural -> Natural -> Natural
-? Natural
1)
(Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
_maxPropSz)
)
nextBkSgnCntT :: Gen BkSgnCntT
nextBkSgnCntT :: GenT Identity BkSgnCntT
nextBkSgnCntT =
Double -> BkSgnCntT
BkSgnCntT
(Double -> BkSgnCntT)
-> GenT Identity Double -> GenT Identity BkSgnCntT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Double -> GenT Identity Double
forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double
( Double -> Double -> Double -> Range Double
forall a. (Floating a, Ord a) => a -> a -> a -> Range a
Range.exponentialFloatFrom
Double
bsct
(Double
bsct Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.01)
(Double
bsct Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.01)
)
nextUpTtl :: Gen SlotCount
nextUpTtl :: GenT Identity SlotCount
nextUpTtl =
Word64 -> SlotCount
SlotCount
(Word64 -> SlotCount)
-> GenT Identity Word64 -> GenT Identity SlotCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Range Word64 -> GenT Identity Word64
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Word64 -> Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> a -> Range a
Range.exponentialFrom Word64
currUpTtl Word64
minTtl (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
currUpTtl))
GenT Identity Word64 -> (Word64, Word64) -> GenT Identity Word64
forall a. Gen a -> (a, a) -> Gen a
`increasingProbabilityAt` (Word64
minTtl, Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
currUpTtl)
where
SlotCount Word64
currUpTtl = SlotCount
_upTtl
minTtl :: Word64
minTtl = Word64
2
nextScriptVersion :: Gen Natural
nextScriptVersion :: GenT Identity Natural
nextScriptVersion = [Natural] -> GenT Identity Natural
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [Natural
_scriptVersion, Natural
_scriptVersion Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1]
nextUpAdptThd :: Gen UpAdptThd
nextUpAdptThd :: GenT Identity UpAdptThd
nextUpAdptThd =
Double -> UpAdptThd
UpAdptThd
(Double -> UpAdptThd)
-> GenT Identity Double -> GenT Identity UpAdptThd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Double -> GenT Identity Double
forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (Double -> Double -> Double -> Range Double
forall a. (Floating a, Ord a) => a -> a -> a -> Range a
Range.exponentialFloatFrom Double
uat Double
0 Double
1)
GenT Identity Double -> (Double, Double) -> GenT Identity Double
forall a. Gen a -> (a, a) -> Gen a
`increasingProbabilityAt` (Double
0, Double
1)
nextFactorA :: Gen FactorA
nextFactorA :: GenT Identity FactorA
nextFactorA =
Int -> FactorA
FactorA
(Int -> FactorA) -> GenT Identity Int -> GenT Identity FactorA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Range Int -> GenT Identity Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Int -> Range Int
forall a. Integral a => a -> a -> a -> Range a
Range.exponentialFrom Int
fA Int
0 Int
10)
GenT Identity Int -> (Int, Int) -> GenT Identity Int
forall a. Gen a -> (a, a) -> Gen a
`increasingProbabilityAt` (Int
0, Int
10)
nextFactorB :: Gen FactorB
nextFactorB :: GenT Identity FactorB
nextFactorB =
Int -> FactorB
FactorB
(Int -> FactorB) -> GenT Identity Int -> GenT Identity FactorB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Int -> Range Int
forall a. Integral a => a -> a -> a -> Range a
Range.exponentialFrom Int
fB Int
minFactorB Int
maxFactorB)
GenT Identity Int -> (Int, Int) -> GenT Identity Int
forall a. Gen a -> (a, a) -> Gen a
`increasingProbabilityAt` (Int
minFactorB, Int
maxFactorB)
where
minFactorB :: Int
minFactorB = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
GP.c
maxFactorB :: Int
maxFactorB = Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
GP.c
(-?) :: Natural -> Natural -> Natural
Natural
n -? :: Natural -> Natural -> Natural
-? Natural
m = if Natural
n Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
m then Natural
0 else Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
m
increasingProbabilityAt ::
Gen a ->
(a, a) ->
Gen a
increasingProbabilityAt :: forall a. Gen a -> (a, a) -> Gen a
increasingProbabilityAt Gen a
gen (a
lower, a
upper) =
[(Int, Gen a)] -> Gen a
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
Gen.frequency
[ (Int
5, a -> Gen a
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
lower)
, (Int
90, Gen a
gen)
, (Int
5, a -> Gen a
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
upper)
]
randomUpId :: Gen UpId
randomUpId :: Gen UpId
randomUpId = Int -> UpId
UpId (Int -> UpId) -> GenT Identity Int -> Gen UpId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Int
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
10000 Int
10100)
reSign :: UProp -> UProp
reSign :: UProp -> UProp
reSign UProp
uprop =
UProp
uprop
UProp -> (UProp -> UProp) -> UProp
forall a b. a -> (a -> b) -> b
& (Sig UpSD -> Identity (Sig UpSD)) -> UProp -> Identity UProp
Lens' UProp (Sig UpSD)
upSig ((Sig UpSD -> Identity (Sig UpSD)) -> UProp -> Identity UProp)
-> Sig UpSD -> UProp -> UProp
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SKey -> UpSD -> Sig UpSD
forall a. SKey -> a -> Sig a
Core.sign (VKey -> SKey
skey (UProp
uprop UProp -> Getting VKey UProp VKey -> VKey
forall s a. s -> Getting a s a -> a
^. Getting VKey UProp VKey
Lens' UProp VKey
upIssuer)) (UProp
uprop UProp -> Getting UpSD UProp UpSD -> UpSD
forall s a. s -> Getting a s a -> a
^. Getting UpSD UProp UpSD
Lens' UProp UpSD
upSigData)
data UPIVOTE deriving ((forall x. UPIVOTE -> Rep UPIVOTE x)
-> (forall x. Rep UPIVOTE x -> UPIVOTE) -> Generic UPIVOTE
forall x. Rep UPIVOTE x -> UPIVOTE
forall x. UPIVOTE -> Rep UPIVOTE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPIVOTE -> Rep UPIVOTE x
from :: forall x. UPIVOTE -> Rep UPIVOTE x
$cto :: forall x. Rep UPIVOTE x -> UPIVOTE
to :: forall x. Rep UPIVOTE x -> UPIVOTE
Generic, Typeable UPIVOTE
Typeable UPIVOTE =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTE -> c UPIVOTE)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTE)
-> (UPIVOTE -> Constr)
-> (UPIVOTE -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTE))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTE))
-> ((forall b. Data b => b -> b) -> UPIVOTE -> UPIVOTE)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPIVOTE -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTE -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE)
-> Data UPIVOTE
UPIVOTE -> Constr
UPIVOTE -> DataType
(forall b. Data b => b -> b) -> UPIVOTE -> UPIVOTE
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTE -> u
forall u. (forall d. Data d => d -> u) -> UPIVOTE -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTE
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTE -> c UPIVOTE
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTE)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTE)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTE -> c UPIVOTE
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTE -> c UPIVOTE
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTE
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTE
$ctoConstr :: UPIVOTE -> Constr
toConstr :: UPIVOTE -> Constr
$cdataTypeOf :: UPIVOTE -> DataType
dataTypeOf :: UPIVOTE -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTE)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTE)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTE)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTE)
$cgmapT :: (forall b. Data b => b -> b) -> UPIVOTE -> UPIVOTE
gmapT :: (forall b. Data b => b -> b) -> UPIVOTE -> UPIVOTE
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTE -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPIVOTE -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPIVOTE -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTE -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTE -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTE -> m UPIVOTE
Data)
data UpivotePredicateFailure
= UPVOTEFailure (PredicateFailure UPVOTE)
deriving (UpivotePredicateFailure -> UpivotePredicateFailure -> Bool
(UpivotePredicateFailure -> UpivotePredicateFailure -> Bool)
-> (UpivotePredicateFailure -> UpivotePredicateFailure -> Bool)
-> Eq UpivotePredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpivotePredicateFailure -> UpivotePredicateFailure -> Bool
== :: UpivotePredicateFailure -> UpivotePredicateFailure -> Bool
$c/= :: UpivotePredicateFailure -> UpivotePredicateFailure -> Bool
/= :: UpivotePredicateFailure -> UpivotePredicateFailure -> Bool
Eq, Int -> UpivotePredicateFailure -> ShowS
[UpivotePredicateFailure] -> ShowS
UpivotePredicateFailure -> String
(Int -> UpivotePredicateFailure -> ShowS)
-> (UpivotePredicateFailure -> String)
-> ([UpivotePredicateFailure] -> ShowS)
-> Show UpivotePredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpivotePredicateFailure -> ShowS
showsPrec :: Int -> UpivotePredicateFailure -> ShowS
$cshow :: UpivotePredicateFailure -> String
show :: UpivotePredicateFailure -> String
$cshowList :: [UpivotePredicateFailure] -> ShowS
showList :: [UpivotePredicateFailure] -> ShowS
Show, Typeable UpivotePredicateFailure
Typeable UpivotePredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotePredicateFailure
-> c UpivotePredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotePredicateFailure)
-> (UpivotePredicateFailure -> Constr)
-> (UpivotePredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpivotePredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotePredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpivotePredicateFailure -> UpivotePredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpivotePredicateFailure -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> UpivotePredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure)
-> Data UpivotePredicateFailure
UpivotePredicateFailure -> Constr
UpivotePredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpivotePredicateFailure -> UpivotePredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpivotePredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpivotePredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotePredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotePredicateFailure
-> c UpivotePredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpivotePredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotePredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotePredicateFailure
-> c UpivotePredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotePredicateFailure
-> c UpivotePredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotePredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotePredicateFailure
$ctoConstr :: UpivotePredicateFailure -> Constr
toConstr :: UpivotePredicateFailure -> Constr
$cdataTypeOf :: UpivotePredicateFailure -> DataType
dataTypeOf :: UpivotePredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpivotePredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpivotePredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotePredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotePredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpivotePredicateFailure -> UpivotePredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpivotePredicateFailure -> UpivotePredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotePredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpivotePredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpivotePredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpivotePredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpivotePredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotePredicateFailure -> m UpivotePredicateFailure
Data, (forall x.
UpivotePredicateFailure -> Rep UpivotePredicateFailure x)
-> (forall x.
Rep UpivotePredicateFailure x -> UpivotePredicateFailure)
-> Generic UpivotePredicateFailure
forall x. Rep UpivotePredicateFailure x -> UpivotePredicateFailure
forall x. UpivotePredicateFailure -> Rep UpivotePredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpivotePredicateFailure -> Rep UpivotePredicateFailure x
from :: forall x. UpivotePredicateFailure -> Rep UpivotePredicateFailure x
$cto :: forall x. Rep UpivotePredicateFailure x -> UpivotePredicateFailure
to :: forall x. Rep UpivotePredicateFailure x -> UpivotePredicateFailure
Generic, Context -> UpivotePredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpivotePredicateFailure -> String
(Context -> UpivotePredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpivotePredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpivotePredicateFailure -> String)
-> NoThunks UpivotePredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpivotePredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpivotePredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpivotePredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpivotePredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpivotePredicateFailure -> String
showTypeOf :: Proxy UpivotePredicateFailure -> String
NoThunks)
instance STS UPIVOTE where
type Environment UPIVOTE = UPIEnv
type State UPIVOTE = UPIState
type Signal UPIVOTE = Vote
type PredicateFailure UPIVOTE = UpivotePredicateFailure
initialRules :: [InitialRule UPIVOTE]
initialRules = []
transitionRules :: [TransitionRule UPIVOTE]
transitionRules =
[ do
TRC
( (Slot
sn, Bimap VKeyGenesis VKey
dms, BlockCount
_k, Word8
ngk)
, ( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads
, Map ApName (ApVer, Slot, Metadata)
avs
, Map UpId (ProtVer, PParams)
rpus
, Map UpId (ApName, ApVer, Metadata)
raus
, Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts
, Set (ProtVer, VKeyGenesis)
bvs
, Map UpId Slot
pws
)
, Signal UPIVOTE
v
) <-
Rule UPIVOTE 'Transition (RuleContext 'Transition UPIVOTE)
F (Clause UPIVOTE 'Transition) (TRC UPIVOTE)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let q :: UpAdptThd
q = PParams
pps PParams -> Getting UpAdptThd PParams UpAdptThd -> UpAdptThd
forall s a. s -> Getting a s a -> a
^. Getting UpAdptThd PParams UpAdptThd
Lens' PParams UpAdptThd
upAdptThd
(Map UpId Slot
cps', Set (UpId, VKeyGenesis)
vts') <-
forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPVOTE (RuleContext 'Transition UPVOTE
-> Rule UPIVOTE 'Transition (State UPVOTE))
-> RuleContext 'Transition UPVOTE
-> Rule UPIVOTE 'Transition (State UPVOTE)
forall a b. (a -> b) -> a -> b
$
(Environment UPVOTE, State UPVOTE, Signal UPVOTE) -> TRC UPVOTE
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
(
( Slot
sn
, UpAdptThd -> Word8
forall b. Integral b => UpAdptThd -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (UpAdptThd -> Word8) -> UpAdptThd -> Word8
forall a b. (a -> b) -> a -> b
$ UpAdptThd
q UpAdptThd -> UpAdptThd -> UpAdptThd
forall a. Num a => a -> a -> a
* Word8 -> UpAdptThd
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ngk
, Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId Slot
pws
, Bimap VKeyGenesis VKey
dms
)
,
( Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts
)
, Signal UPIVOTE
Signal UPVOTE
v
)
UPIState -> F (Clause UPIVOTE 'Transition) UPIState
forall a. a -> F (Clause UPIVOTE 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UPIState -> F (Clause UPIVOTE 'Transition) UPIState)
-> UPIState -> F (Clause UPIVOTE 'Transition) UPIState
forall a b. (a -> b) -> a -> b
$!
( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads
, Map ApName (ApVer, Slot, Metadata)
avs
, Map UpId (ProtVer, PParams)
rpus
, Map UpId (ApName, ApVer, Metadata)
raus
, Map UpId Slot
cps'
, Set (UpId, VKeyGenesis)
vts'
, Set (ProtVer, VKeyGenesis)
bvs
, Map UpId Slot
pws
)
]
instance Embed UPVOTE UPIVOTE where
wrapFailed :: PredicateFailure UPVOTE -> PredicateFailure UPIVOTE
wrapFailed = PredicateFailure UPVOTE -> PredicateFailure UPIVOTE
PredicateFailure UPVOTE -> UpivotePredicateFailure
UPVOTEFailure
data APPLYVOTES deriving ((forall x. APPLYVOTES -> Rep APPLYVOTES x)
-> (forall x. Rep APPLYVOTES x -> APPLYVOTES) -> Generic APPLYVOTES
forall x. Rep APPLYVOTES x -> APPLYVOTES
forall x. APPLYVOTES -> Rep APPLYVOTES x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. APPLYVOTES -> Rep APPLYVOTES x
from :: forall x. APPLYVOTES -> Rep APPLYVOTES x
$cto :: forall x. Rep APPLYVOTES x -> APPLYVOTES
to :: forall x. Rep APPLYVOTES x -> APPLYVOTES
Generic, Typeable APPLYVOTES
Typeable APPLYVOTES =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> APPLYVOTES -> c APPLYVOTES)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c APPLYVOTES)
-> (APPLYVOTES -> Constr)
-> (APPLYVOTES -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c APPLYVOTES))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c APPLYVOTES))
-> ((forall b. Data b => b -> b) -> APPLYVOTES -> APPLYVOTES)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r)
-> (forall u. (forall d. Data d => d -> u) -> APPLYVOTES -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> APPLYVOTES -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES)
-> Data APPLYVOTES
APPLYVOTES -> Constr
APPLYVOTES -> DataType
(forall b. Data b => b -> b) -> APPLYVOTES -> APPLYVOTES
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> APPLYVOTES -> u
forall u. (forall d. Data d => d -> u) -> APPLYVOTES -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c APPLYVOTES
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> APPLYVOTES -> c APPLYVOTES
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c APPLYVOTES)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c APPLYVOTES)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> APPLYVOTES -> c APPLYVOTES
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> APPLYVOTES -> c APPLYVOTES
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c APPLYVOTES
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c APPLYVOTES
$ctoConstr :: APPLYVOTES -> Constr
toConstr :: APPLYVOTES -> Constr
$cdataTypeOf :: APPLYVOTES -> DataType
dataTypeOf :: APPLYVOTES -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c APPLYVOTES)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c APPLYVOTES)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c APPLYVOTES)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c APPLYVOTES)
$cgmapT :: (forall b. Data b => b -> b) -> APPLYVOTES -> APPLYVOTES
gmapT :: (forall b. Data b => b -> b) -> APPLYVOTES -> APPLYVOTES
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> APPLYVOTES -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> APPLYVOTES -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> APPLYVOTES -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> APPLYVOTES -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> APPLYVOTES -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> APPLYVOTES -> m APPLYVOTES
Data)
data ApplyVotesPredicateFailure
= UpivoteFailure (PredicateFailure UPIVOTE)
deriving (ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure -> Bool
(ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure -> Bool)
-> (ApplyVotesPredicateFailure
-> ApplyVotesPredicateFailure -> Bool)
-> Eq ApplyVotesPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure -> Bool
== :: ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure -> Bool
$c/= :: ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure -> Bool
/= :: ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure -> Bool
Eq, Int -> ApplyVotesPredicateFailure -> ShowS
[ApplyVotesPredicateFailure] -> ShowS
ApplyVotesPredicateFailure -> String
(Int -> ApplyVotesPredicateFailure -> ShowS)
-> (ApplyVotesPredicateFailure -> String)
-> ([ApplyVotesPredicateFailure] -> ShowS)
-> Show ApplyVotesPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplyVotesPredicateFailure -> ShowS
showsPrec :: Int -> ApplyVotesPredicateFailure -> ShowS
$cshow :: ApplyVotesPredicateFailure -> String
show :: ApplyVotesPredicateFailure -> String
$cshowList :: [ApplyVotesPredicateFailure] -> ShowS
showList :: [ApplyVotesPredicateFailure] -> ShowS
Show, Typeable ApplyVotesPredicateFailure
Typeable ApplyVotesPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplyVotesPredicateFailure
-> c ApplyVotesPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplyVotesPredicateFailure)
-> (ApplyVotesPredicateFailure -> Constr)
-> (ApplyVotesPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplyVotesPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplyVotesPredicateFailure))
-> ((forall b. Data b => b -> b)
-> ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure)
-> Data ApplyVotesPredicateFailure
ApplyVotesPredicateFailure -> Constr
ApplyVotesPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplyVotesPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplyVotesPredicateFailure
-> c ApplyVotesPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplyVotesPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplyVotesPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplyVotesPredicateFailure
-> c ApplyVotesPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ApplyVotesPredicateFailure
-> c ApplyVotesPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplyVotesPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ApplyVotesPredicateFailure
$ctoConstr :: ApplyVotesPredicateFailure -> Constr
toConstr :: ApplyVotesPredicateFailure -> Constr
$cdataTypeOf :: ApplyVotesPredicateFailure -> DataType
dataTypeOf :: ApplyVotesPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplyVotesPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ApplyVotesPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplyVotesPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ApplyVotesPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> ApplyVotesPredicateFailure -> ApplyVotesPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ApplyVotesPredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ApplyVotesPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ApplyVotesPredicateFailure -> m ApplyVotesPredicateFailure
Data, (forall x.
ApplyVotesPredicateFailure -> Rep ApplyVotesPredicateFailure x)
-> (forall x.
Rep ApplyVotesPredicateFailure x -> ApplyVotesPredicateFailure)
-> Generic ApplyVotesPredicateFailure
forall x.
Rep ApplyVotesPredicateFailure x -> ApplyVotesPredicateFailure
forall x.
ApplyVotesPredicateFailure -> Rep ApplyVotesPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ApplyVotesPredicateFailure -> Rep ApplyVotesPredicateFailure x
from :: forall x.
ApplyVotesPredicateFailure -> Rep ApplyVotesPredicateFailure x
$cto :: forall x.
Rep ApplyVotesPredicateFailure x -> ApplyVotesPredicateFailure
to :: forall x.
Rep ApplyVotesPredicateFailure x -> ApplyVotesPredicateFailure
Generic, Context -> ApplyVotesPredicateFailure -> IO (Maybe ThunkInfo)
Proxy ApplyVotesPredicateFailure -> String
(Context -> ApplyVotesPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> ApplyVotesPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy ApplyVotesPredicateFailure -> String)
-> NoThunks ApplyVotesPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ApplyVotesPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> ApplyVotesPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ApplyVotesPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ApplyVotesPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ApplyVotesPredicateFailure -> String
showTypeOf :: Proxy ApplyVotesPredicateFailure -> String
NoThunks)
instance STS APPLYVOTES where
type Environment APPLYVOTES = UPIEnv
type State APPLYVOTES = UPIState
type Signal APPLYVOTES = [Vote]
type PredicateFailure APPLYVOTES = ApplyVotesPredicateFailure
initialRules :: [InitialRule APPLYVOTES]
initialRules = [UPIState -> F (Clause APPLYVOTES 'Initial) UPIState
forall a. a -> F (Clause APPLYVOTES 'Initial) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UPIState -> F (Clause APPLYVOTES 'Initial) UPIState)
-> UPIState -> F (Clause APPLYVOTES 'Initial) UPIState
forall a b. (a -> b) -> a -> b
$! UPIState
emptyUPIState]
transitionRules :: [TransitionRule APPLYVOTES]
transitionRules =
[ do
TRC (Environment APPLYVOTES
env, State APPLYVOTES
us, Signal APPLYVOTES
sig) <- Rule APPLYVOTES 'Transition (RuleContext 'Transition APPLYVOTES)
F (Clause APPLYVOTES 'Transition) (TRC APPLYVOTES)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
case ([Vote]
Signal APPLYVOTES
sig :: [Vote]) of
[] -> UPIState -> F (Clause APPLYVOTES 'Transition) UPIState
forall a. a -> F (Clause APPLYVOTES 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return UPIState
State APPLYVOTES
us
(Vote
x : [Vote]
xs) -> do
UPIState
us' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPIVOTE (RuleContext 'Transition UPIVOTE
-> Rule APPLYVOTES 'Transition (State UPIVOTE))
-> RuleContext 'Transition UPIVOTE
-> Rule APPLYVOTES 'Transition (State UPIVOTE)
forall a b. (a -> b) -> a -> b
$ (Environment UPIVOTE, State UPIVOTE, Signal UPIVOTE) -> TRC UPIVOTE
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment APPLYVOTES
Environment UPIVOTE
env, State APPLYVOTES
State UPIVOTE
us, Signal UPIVOTE
Vote
x)
UPIState
us'' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @APPLYVOTES (RuleContext 'Transition APPLYVOTES -> TransitionRule APPLYVOTES)
-> RuleContext 'Transition APPLYVOTES -> TransitionRule APPLYVOTES
forall a b. (a -> b) -> a -> b
$ (Environment APPLYVOTES, State APPLYVOTES, Signal APPLYVOTES)
-> TRC APPLYVOTES
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment APPLYVOTES
env, UPIState
State APPLYVOTES
us', [Vote]
Signal APPLYVOTES
xs)
UPIState -> F (Clause APPLYVOTES 'Transition) UPIState
forall a. a -> F (Clause APPLYVOTES 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return UPIState
us''
]
instance Embed UPIVOTE APPLYVOTES where
wrapFailed :: PredicateFailure UPIVOTE -> PredicateFailure APPLYVOTES
wrapFailed = PredicateFailure UPIVOTE -> PredicateFailure APPLYVOTES
PredicateFailure UPIVOTE -> ApplyVotesPredicateFailure
UpivoteFailure
data UPIVOTES deriving ((forall x. UPIVOTES -> Rep UPIVOTES x)
-> (forall x. Rep UPIVOTES x -> UPIVOTES) -> Generic UPIVOTES
forall x. Rep UPIVOTES x -> UPIVOTES
forall x. UPIVOTES -> Rep UPIVOTES x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPIVOTES -> Rep UPIVOTES x
from :: forall x. UPIVOTES -> Rep UPIVOTES x
$cto :: forall x. Rep UPIVOTES x -> UPIVOTES
to :: forall x. Rep UPIVOTES x -> UPIVOTES
Generic, Typeable UPIVOTES
Typeable UPIVOTES =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTES -> c UPIVOTES)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTES)
-> (UPIVOTES -> Constr)
-> (UPIVOTES -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTES))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTES))
-> ((forall b. Data b => b -> b) -> UPIVOTES -> UPIVOTES)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPIVOTES -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTES -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES)
-> Data UPIVOTES
UPIVOTES -> Constr
UPIVOTES -> DataType
(forall b. Data b => b -> b) -> UPIVOTES -> UPIVOTES
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTES -> u
forall u. (forall d. Data d => d -> u) -> UPIVOTES -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTES
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTES -> c UPIVOTES
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTES)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTES)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTES -> c UPIVOTES
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIVOTES -> c UPIVOTES
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTES
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIVOTES
$ctoConstr :: UPIVOTES -> Constr
toConstr :: UPIVOTES -> Constr
$cdataTypeOf :: UPIVOTES -> DataType
dataTypeOf :: UPIVOTES -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTES)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIVOTES)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTES)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIVOTES)
$cgmapT :: (forall b. Data b => b -> b) -> UPIVOTES -> UPIVOTES
gmapT :: (forall b. Data b => b -> b) -> UPIVOTES -> UPIVOTES
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIVOTES -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPIVOTES -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPIVOTES -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTES -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIVOTES -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIVOTES -> m UPIVOTES
Data)
data UpivotesPredicateFailure
= ApplyVotesFailure (PredicateFailure APPLYVOTES)
deriving (UpivotesPredicateFailure -> UpivotesPredicateFailure -> Bool
(UpivotesPredicateFailure -> UpivotesPredicateFailure -> Bool)
-> (UpivotesPredicateFailure -> UpivotesPredicateFailure -> Bool)
-> Eq UpivotesPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpivotesPredicateFailure -> UpivotesPredicateFailure -> Bool
== :: UpivotesPredicateFailure -> UpivotesPredicateFailure -> Bool
$c/= :: UpivotesPredicateFailure -> UpivotesPredicateFailure -> Bool
/= :: UpivotesPredicateFailure -> UpivotesPredicateFailure -> Bool
Eq, Int -> UpivotesPredicateFailure -> ShowS
[UpivotesPredicateFailure] -> ShowS
UpivotesPredicateFailure -> String
(Int -> UpivotesPredicateFailure -> ShowS)
-> (UpivotesPredicateFailure -> String)
-> ([UpivotesPredicateFailure] -> ShowS)
-> Show UpivotesPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpivotesPredicateFailure -> ShowS
showsPrec :: Int -> UpivotesPredicateFailure -> ShowS
$cshow :: UpivotesPredicateFailure -> String
show :: UpivotesPredicateFailure -> String
$cshowList :: [UpivotesPredicateFailure] -> ShowS
showList :: [UpivotesPredicateFailure] -> ShowS
Show, Typeable UpivotesPredicateFailure
Typeable UpivotesPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotesPredicateFailure
-> c UpivotesPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotesPredicateFailure)
-> (UpivotesPredicateFailure -> Constr)
-> (UpivotesPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c UpivotesPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotesPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpivotesPredicateFailure -> UpivotesPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpivotesPredicateFailure -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> UpivotesPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure)
-> Data UpivotesPredicateFailure
UpivotesPredicateFailure -> Constr
UpivotesPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpivotesPredicateFailure -> UpivotesPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> UpivotesPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpivotesPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotesPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotesPredicateFailure
-> c UpivotesPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpivotesPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotesPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotesPredicateFailure
-> c UpivotesPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpivotesPredicateFailure
-> c UpivotesPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotesPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpivotesPredicateFailure
$ctoConstr :: UpivotesPredicateFailure -> Constr
toConstr :: UpivotesPredicateFailure -> Constr
$cdataTypeOf :: UpivotesPredicateFailure -> DataType
dataTypeOf :: UpivotesPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpivotesPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpivotesPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotesPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpivotesPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpivotesPredicateFailure -> UpivotesPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpivotesPredicateFailure -> UpivotesPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpivotesPredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpivotesPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpivotesPredicateFailure -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> UpivotesPredicateFailure -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> UpivotesPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpivotesPredicateFailure -> m UpivotesPredicateFailure
Data, (forall x.
UpivotesPredicateFailure -> Rep UpivotesPredicateFailure x)
-> (forall x.
Rep UpivotesPredicateFailure x -> UpivotesPredicateFailure)
-> Generic UpivotesPredicateFailure
forall x.
Rep UpivotesPredicateFailure x -> UpivotesPredicateFailure
forall x.
UpivotesPredicateFailure -> Rep UpivotesPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
UpivotesPredicateFailure -> Rep UpivotesPredicateFailure x
from :: forall x.
UpivotesPredicateFailure -> Rep UpivotesPredicateFailure x
$cto :: forall x.
Rep UpivotesPredicateFailure x -> UpivotesPredicateFailure
to :: forall x.
Rep UpivotesPredicateFailure x -> UpivotesPredicateFailure
Generic, Context -> UpivotesPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpivotesPredicateFailure -> String
(Context -> UpivotesPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpivotesPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpivotesPredicateFailure -> String)
-> NoThunks UpivotesPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpivotesPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpivotesPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpivotesPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpivotesPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpivotesPredicateFailure -> String
showTypeOf :: Proxy UpivotesPredicateFailure -> String
NoThunks)
instance STS UPIVOTES where
type Environment UPIVOTES = UPIEnv
type State UPIVOTES = UPIState
type Signal UPIVOTES = [Vote]
type PredicateFailure UPIVOTES = UpivotesPredicateFailure
initialRules :: [InitialRule UPIVOTES]
initialRules = [UPIState -> F (Clause UPIVOTES 'Initial) UPIState
forall a. a -> F (Clause UPIVOTES 'Initial) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UPIState -> F (Clause UPIVOTES 'Initial) UPIState)
-> UPIState -> F (Clause UPIVOTES 'Initial) UPIState
forall a b. (a -> b) -> a -> b
$! UPIState
emptyUPIState]
transitionRules :: [TransitionRule UPIVOTES]
transitionRules =
[ do
TRC (Environment UPIVOTES
env, State UPIVOTES
us, Signal UPIVOTES
xs) <- Rule UPIVOTES 'Transition (RuleContext 'Transition UPIVOTES)
F (Clause UPIVOTES 'Transition) (TRC UPIVOTES)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
UPIState
us' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @APPLYVOTES (RuleContext 'Transition APPLYVOTES
-> Rule UPIVOTES 'Transition (State APPLYVOTES))
-> RuleContext 'Transition APPLYVOTES
-> Rule UPIVOTES 'Transition (State APPLYVOTES)
forall a b. (a -> b) -> a -> b
$ (Environment APPLYVOTES, State APPLYVOTES, Signal APPLYVOTES)
-> TRC APPLYVOTES
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment UPIVOTES
Environment APPLYVOTES
env, State UPIVOTES
State APPLYVOTES
us, Signal UPIVOTES
Signal APPLYVOTES
xs)
let (Slot
sn, Bimap VKeyGenesis VKey
_dms, BlockCount
_k, Word8
_ngk) = Environment UPIVOTES
env
( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads
, Map ApName (ApVer, Slot, Metadata)
avs
, Map UpId (ProtVer, PParams)
rpus
, Map UpId (ApName, ApVer, Metadata)
raus
, Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts
, Set (ProtVer, VKeyGenesis)
bvs
, Map UpId Slot
pws
) = UPIState
us'
cfmRaus :: Map UpId (ApName, ApVer, Metadata)
cfmRaus = (Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId Slot
cps) Set (Domain (Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
-> Map UpId (ApName, ApVer, Metadata)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId (ApName, ApVer, Metadata))), Foldable f) =>
f (Domain (Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
-> Map UpId (ApName, ApVer, Metadata)
◁ Map UpId (ApName, ApVer, Metadata)
raus
avsNew :: [(ApName, (ApVer, Slot, Metadata))]
avsNew =
[ (ApName
an, (ApVer
av, Slot
sn, Metadata
m))
| (ApName
an, ApVer
av, Metadata
m) <- Map UpId (ApName, ApVer, Metadata) -> [(ApName, ApVer, Metadata)]
forall a. Map UpId a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map UpId (ApName, ApVer, Metadata)
cfmRaus
]
UPIState -> F (Clause UPIVOTES 'Transition) UPIState
forall a. a -> F (Clause UPIVOTES 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UPIState -> F (Clause UPIVOTES 'Transition) UPIState)
-> UPIState -> F (Clause UPIVOTES 'Transition) UPIState
forall a b. (a -> b) -> a -> b
$!
( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads
, Map ApName (ApVer, Slot, Metadata)
avs Map ApName (ApVer, Slot, Metadata)
-> [(Domain (Map ApName (ApVer, Slot, Metadata)),
Range (Map ApName (ApVer, Slot, Metadata)))]
-> Map ApName (ApVer, Slot, Metadata)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Ord (Range m), Foldable f) =>
m -> f (Domain m, Range m) -> m
forall (f :: * -> *).
(Ord (Domain (Map ApName (ApVer, Slot, Metadata))),
Ord (Range (Map ApName (ApVer, Slot, Metadata))), Foldable f) =>
Map ApName (ApVer, Slot, Metadata)
-> f (Domain (Map ApName (ApVer, Slot, Metadata)),
Range (Map ApName (ApVer, Slot, Metadata)))
-> Map ApName (ApVer, Slot, Metadata)
⨃ [(Domain (Map ApName (ApVer, Slot, Metadata)),
Range (Map ApName (ApVer, Slot, Metadata)))]
[(ApName, (ApVer, Slot, Metadata))]
avsNew
, Map UpId (ProtVer, PParams)
rpus
, (Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId Slot
cps) Set (Domain (Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
-> Map UpId (ApName, ApVer, Metadata)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId (ApName, ApVer, Metadata))), Foldable f) =>
f (Domain (Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
-> Map UpId (ApName, ApVer, Metadata)
⋪ Map UpId (ApName, ApVer, Metadata)
raus
, Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts
, Set (ProtVer, VKeyGenesis)
bvs
, Map UpId Slot
pws
)
]
instance Embed APPLYVOTES UPIVOTES where
wrapFailed :: PredicateFailure APPLYVOTES -> PredicateFailure UPIVOTES
wrapFailed = PredicateFailure APPLYVOTES -> PredicateFailure UPIVOTES
PredicateFailure APPLYVOTES -> UpivotesPredicateFailure
ApplyVotesFailure
instance HasTrace UPIVOTES where
envGen :: Word64 -> Gen (Environment UPIVOTES)
envGen Word64
_ = Gen UPIEnv
Gen (Environment UPIVOTES)
upiEnvGen
sigGen :: SignalGenerator UPIVOTES
sigGen (Slot
_slot, Bimap VKeyGenesis VKey
dms, BlockCount
_k, Word8
_ngk) ((ProtVer
_pv, PParams
_pps), [(Slot, (ProtVer, PParams))]
_fads, Map ApName (ApVer, Slot, Metadata)
_avs, Map UpId (ProtVer, PParams)
rpus, Map UpId (ApName, ApVer, Metadata)
_raus, Map UpId Slot
_cps, Set (UpId, VKeyGenesis)
vts, Set (ProtVer, VKeyGenesis)
_bvs, Map UpId Slot
_pws) =
((UpId, VKeyGenesis) -> Vote
mkVoteForDelegate ((UpId, VKeyGenesis) -> Vote) -> [(UpId, VKeyGenesis)] -> [Vote]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(UpId, VKeyGenesis)] -> [Vote])
-> ([(UpId, [VKeyGenesis])] -> [(UpId, VKeyGenesis)])
-> [(UpId, [VKeyGenesis])]
-> [Vote]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UpId, [VKeyGenesis]) -> [(UpId, VKeyGenesis)])
-> [(UpId, [VKeyGenesis])] -> [(UpId, VKeyGenesis)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UpId, [VKeyGenesis]) -> [(UpId, VKeyGenesis)]
forall a b. (a, [b]) -> [(a, b)]
replicateFst
([(UpId, [VKeyGenesis])] -> [Vote])
-> GenT Identity [(UpId, [VKeyGenesis])] -> GenT Identity [Vote]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UpId, [VKeyGenesis])] -> GenT Identity [(UpId, [VKeyGenesis])]
genVotesOnMostVotedProposals [(UpId, [VKeyGenesis])]
completedVotes
where
completedVotes :: [(UpId, [Core.VKeyGenesis])]
completedVotes :: [(UpId, [VKeyGenesis])]
completedVotes =
Set VKeyGenesis
-> Map UpId (Set VKeyGenesis) -> Map UpId (Set VKeyGenesis)
completeVotes
(Bimap VKeyGenesis VKey -> Set (Domain (Bimap VKeyGenesis VKey))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Bimap VKeyGenesis VKey
dms)
(Set (UpId, VKeyGenesis) -> Map UpId (Set VKeyGenesis)
groupVotesPerProposalId Set (UpId, VKeyGenesis)
vts)
Map UpId (Set VKeyGenesis)
-> (Map UpId (Set VKeyGenesis) -> Map UpId [VKeyGenesis])
-> Map UpId [VKeyGenesis]
forall a b. a -> (a -> b) -> b
& (Set VKeyGenesis -> [VKeyGenesis])
-> Map UpId (Set VKeyGenesis) -> Map UpId [VKeyGenesis]
forall a b. (a -> b) -> Map UpId a -> Map UpId b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set VKeyGenesis -> [VKeyGenesis]
forall a. Set a -> [a]
Set.toList
Map UpId [VKeyGenesis]
-> (Map UpId [VKeyGenesis] -> [(UpId, [VKeyGenesis])])
-> [(UpId, [VKeyGenesis])]
forall a b. a -> (a -> b) -> b
& Map UpId [VKeyGenesis] -> [(UpId, [VKeyGenesis])]
forall k a. Map k a -> [(k, a)]
Map.toList
mkVoteForDelegate ::
(UpId, Core.VKeyGenesis) ->
Vote
mkVoteForDelegate :: (UpId, VKeyGenesis) -> Vote
mkVoteForDelegate (UpId
proposalId, VKeyGenesis
vkg) =
VKey -> UpId -> Sig UpId -> Vote
Vote VKey
vk UpId
proposalId (SKey -> UpId -> Sig UpId
forall a. SKey -> a -> Sig a
Core.sign (VKey -> SKey
skey VKey
vk) UpId
proposalId)
where
vk :: VKey
vk = VKey -> Maybe VKey -> VKey
forall a. a -> Maybe a -> a
fromMaybe VKey
forall {a}. a
err (Maybe VKey -> VKey) -> Maybe VKey -> VKey
forall a b. (a -> b) -> a -> b
$ VKeyGenesis -> Bimap VKeyGenesis VKey -> Maybe VKey
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
Bimap.lookup VKeyGenesis
vkg Bimap VKeyGenesis VKey
dms
where
err :: a
err =
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
String
"Byron.Spec.Ledger.Update.mkVoteForDelegate: "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"the genesis key was not found in the delegation map, "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"but it should be since we used `dms` to get the keys"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"that can vote (and so they should have a pre-image in `dms`)."
groupVotesPerProposalId ::
Set (UpId, Core.VKeyGenesis) ->
Map UpId (Set Core.VKeyGenesis)
groupVotesPerProposalId :: Set (UpId, VKeyGenesis) -> Map UpId (Set VKeyGenesis)
groupVotesPerProposalId =
(Map UpId (Set VKeyGenesis)
-> (UpId, VKeyGenesis) -> Map UpId (Set VKeyGenesis))
-> Map UpId (Set VKeyGenesis)
-> Set (UpId, VKeyGenesis)
-> Map UpId (Set VKeyGenesis)
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Map UpId (Set VKeyGenesis)
-> (UpId, VKeyGenesis) -> Map UpId (Set VKeyGenesis)
addVote Map UpId (Set VKeyGenesis)
proposalIdsWithNoVotes
where
proposalIdsWithNoVotes :: Map UpId (Set Core.VKeyGenesis)
proposalIdsWithNoVotes :: Map UpId (Set VKeyGenesis)
proposalIdsWithNoVotes = [(UpId, Set VKeyGenesis)] -> Map UpId (Set VKeyGenesis)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UpId, Set VKeyGenesis)] -> Map UpId (Set VKeyGenesis))
-> [(UpId, Set VKeyGenesis)] -> Map UpId (Set VKeyGenesis)
forall a b. (a -> b) -> a -> b
$ (,Set VKeyGenesis
forall a. Set a
Set.empty) (UpId -> (UpId, Set VKeyGenesis))
-> [UpId] -> [(UpId, Set VKeyGenesis)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set UpId -> [UpId]
forall a. Set a -> [a]
Set.toList (Map UpId (ProtVer, PParams)
-> Set (Domain (Map UpId (ProtVer, PParams)))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId (ProtVer, PParams)
rpus)
addVote ::
Map UpId (Set Core.VKeyGenesis) ->
(UpId, Core.VKeyGenesis) ->
Map UpId (Set Core.VKeyGenesis)
addVote :: Map UpId (Set VKeyGenesis)
-> (UpId, VKeyGenesis) -> Map UpId (Set VKeyGenesis)
addVote Map UpId (Set VKeyGenesis)
m (UpId
proposalId, VKeyGenesis
genesisKey) =
case UpId -> Map UpId (Set VKeyGenesis) -> Maybe (Set VKeyGenesis)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UpId
proposalId Map UpId (Set VKeyGenesis)
m of
Maybe (Set VKeyGenesis)
Nothing ->
UpId
-> Set VKeyGenesis
-> Map UpId (Set VKeyGenesis)
-> Map UpId (Set VKeyGenesis)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert UpId
proposalId (VKeyGenesis -> Set VKeyGenesis
forall a. a -> Set a
Set.singleton VKeyGenesis
genesisKey) Map UpId (Set VKeyGenesis)
m
Just Set VKeyGenesis
votesForProposalId ->
UpId
-> Set VKeyGenesis
-> Map UpId (Set VKeyGenesis)
-> Map UpId (Set VKeyGenesis)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert UpId
proposalId (VKeyGenesis -> Set VKeyGenesis -> Set VKeyGenesis
forall a. Ord a => a -> Set a -> Set a
Set.insert VKeyGenesis
genesisKey Set VKeyGenesis
votesForProposalId) Map UpId (Set VKeyGenesis)
m
completeVotes ::
Set Core.VKeyGenesis ->
Map UpId (Set Core.VKeyGenesis) ->
Map UpId (Set Core.VKeyGenesis)
completeVotes :: Set VKeyGenesis
-> Map UpId (Set VKeyGenesis) -> Map UpId (Set VKeyGenesis)
completeVotes Set VKeyGenesis
genesisKeys Map UpId (Set VKeyGenesis)
votes =
(Set VKeyGenesis
genesisKeys Set VKeyGenesis -> Set VKeyGenesis -> Set VKeyGenesis
forall a. Ord a => Set a -> Set a -> Set a
\\) (Set VKeyGenesis -> Set VKeyGenesis)
-> Map UpId (Set VKeyGenesis) -> Map UpId (Set VKeyGenesis)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map UpId (Set VKeyGenesis)
votes
genVotesOnMostVotedProposals ::
[(UpId, [Core.VKeyGenesis])] ->
Gen [(UpId, [Core.VKeyGenesis])]
genVotesOnMostVotedProposals :: [(UpId, [VKeyGenesis])] -> GenT Identity [(UpId, [VKeyGenesis])]
genVotesOnMostVotedProposals [(UpId, [VKeyGenesis])]
votesNeeded = do
Int
numberOfProposals <- Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 ([(UpId, [VKeyGenesis])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UpId, [VKeyGenesis])]
votesNeeded))
let votes :: [(UpId, [Core.VKeyGenesis])]
votes :: [(UpId, [VKeyGenesis])]
votes = Int -> [(UpId, [VKeyGenesis])] -> [(UpId, [VKeyGenesis])]
forall a. Int -> [a] -> [a]
take Int
numberOfProposals ([(UpId, [VKeyGenesis])] -> [(UpId, [VKeyGenesis])])
-> [(UpId, [VKeyGenesis])] -> [(UpId, [VKeyGenesis])]
forall a b. (a -> b) -> a -> b
$ ((UpId, [VKeyGenesis]) -> Int)
-> [(UpId, [VKeyGenesis])] -> [(UpId, [VKeyGenesis])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ([VKeyGenesis] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([VKeyGenesis] -> Int)
-> ((UpId, [VKeyGenesis]) -> [VKeyGenesis])
-> (UpId, [VKeyGenesis])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpId, [VKeyGenesis]) -> [VKeyGenesis]
forall a b. (a, b) -> b
snd) [(UpId, [VKeyGenesis])]
votesNeeded
[UpId] -> [[VKeyGenesis]] -> [(UpId, [VKeyGenesis])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((UpId, [VKeyGenesis]) -> UpId
forall a b. (a, b) -> a
fst ((UpId, [VKeyGenesis]) -> UpId)
-> [(UpId, [VKeyGenesis])] -> [UpId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UpId, [VKeyGenesis])]
votes) ([[VKeyGenesis]] -> [(UpId, [VKeyGenesis])])
-> GenT Identity [[VKeyGenesis]]
-> GenT Identity [(UpId, [VKeyGenesis])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([VKeyGenesis] -> GenT Identity [VKeyGenesis])
-> [[VKeyGenesis]] -> GenT Identity [[VKeyGenesis]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [VKeyGenesis] -> GenT Identity [VKeyGenesis]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence ((UpId, [VKeyGenesis]) -> [VKeyGenesis]
forall a b. (a, b) -> b
snd ((UpId, [VKeyGenesis]) -> [VKeyGenesis])
-> [(UpId, [VKeyGenesis])] -> [[VKeyGenesis]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UpId, [VKeyGenesis])]
votes)
replicateFst ::
(a, [b]) ->
[(a, b)]
replicateFst :: forall a b. (a, [b]) -> [(a, b)]
replicateFst (a
a, [b]
bs) = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (a -> [a]
forall a. a -> [a]
repeat a
a) [b]
bs
data UPIEND deriving ((forall x. UPIEND -> Rep UPIEND x)
-> (forall x. Rep UPIEND x -> UPIEND) -> Generic UPIEND
forall x. Rep UPIEND x -> UPIEND
forall x. UPIEND -> Rep UPIEND x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPIEND -> Rep UPIEND x
from :: forall x. UPIEND -> Rep UPIEND x
$cto :: forall x. Rep UPIEND x -> UPIEND
to :: forall x. Rep UPIEND x -> UPIEND
Generic, Typeable UPIEND
Typeable UPIEND =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEND -> c UPIEND)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEND)
-> (UPIEND -> Constr)
-> (UPIEND -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEND))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEND))
-> ((forall b. Data b => b -> b) -> UPIEND -> UPIEND)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UPIEND -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UPIEND -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPIEND -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPIEND -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND)
-> Data UPIEND
UPIEND -> Constr
UPIEND -> DataType
(forall b. Data b => b -> b) -> UPIEND -> UPIEND
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPIEND -> u
forall u. (forall d. Data d => d -> u) -> UPIEND -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIEND -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIEND -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEND
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEND -> c UPIEND
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEND)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEND)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEND -> c UPIEND
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEND -> c UPIEND
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEND
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEND
$ctoConstr :: UPIEND -> Constr
toConstr :: UPIEND -> Constr
$cdataTypeOf :: UPIEND -> DataType
dataTypeOf :: UPIEND -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEND)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEND)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEND)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEND)
$cgmapT :: (forall b. Data b => b -> b) -> UPIEND -> UPIEND
gmapT :: (forall b. Data b => b -> b) -> UPIEND -> UPIEND
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIEND -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIEND -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIEND -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIEND -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPIEND -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPIEND -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIEND -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIEND -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEND -> m UPIEND
Data)
data UpiendPredicateFailure
= UPENDFailure (PredicateFailure UPEND)
deriving (UpiendPredicateFailure -> UpiendPredicateFailure -> Bool
(UpiendPredicateFailure -> UpiendPredicateFailure -> Bool)
-> (UpiendPredicateFailure -> UpiendPredicateFailure -> Bool)
-> Eq UpiendPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpiendPredicateFailure -> UpiendPredicateFailure -> Bool
== :: UpiendPredicateFailure -> UpiendPredicateFailure -> Bool
$c/= :: UpiendPredicateFailure -> UpiendPredicateFailure -> Bool
/= :: UpiendPredicateFailure -> UpiendPredicateFailure -> Bool
Eq, Int -> UpiendPredicateFailure -> ShowS
[UpiendPredicateFailure] -> ShowS
UpiendPredicateFailure -> String
(Int -> UpiendPredicateFailure -> ShowS)
-> (UpiendPredicateFailure -> String)
-> ([UpiendPredicateFailure] -> ShowS)
-> Show UpiendPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpiendPredicateFailure -> ShowS
showsPrec :: Int -> UpiendPredicateFailure -> ShowS
$cshow :: UpiendPredicateFailure -> String
show :: UpiendPredicateFailure -> String
$cshowList :: [UpiendPredicateFailure] -> ShowS
showList :: [UpiendPredicateFailure] -> ShowS
Show, Typeable UpiendPredicateFailure
Typeable UpiendPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiendPredicateFailure
-> c UpiendPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiendPredicateFailure)
-> (UpiendPredicateFailure -> Constr)
-> (UpiendPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiendPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiendPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpiendPredicateFailure -> UpiendPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpiendPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpiendPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure)
-> Data UpiendPredicateFailure
UpiendPredicateFailure -> Constr
UpiendPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpiendPredicateFailure -> UpiendPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpiendPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpiendPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiendPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiendPredicateFailure
-> c UpiendPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiendPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiendPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiendPredicateFailure
-> c UpiendPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiendPredicateFailure
-> c UpiendPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiendPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiendPredicateFailure
$ctoConstr :: UpiendPredicateFailure -> Constr
toConstr :: UpiendPredicateFailure -> Constr
$cdataTypeOf :: UpiendPredicateFailure -> DataType
dataTypeOf :: UpiendPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiendPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiendPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiendPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiendPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpiendPredicateFailure -> UpiendPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpiendPredicateFailure -> UpiendPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiendPredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpiendPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpiendPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpiendPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpiendPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiendPredicateFailure -> m UpiendPredicateFailure
Data, (forall x. UpiendPredicateFailure -> Rep UpiendPredicateFailure x)
-> (forall x.
Rep UpiendPredicateFailure x -> UpiendPredicateFailure)
-> Generic UpiendPredicateFailure
forall x. Rep UpiendPredicateFailure x -> UpiendPredicateFailure
forall x. UpiendPredicateFailure -> Rep UpiendPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpiendPredicateFailure -> Rep UpiendPredicateFailure x
from :: forall x. UpiendPredicateFailure -> Rep UpiendPredicateFailure x
$cto :: forall x. Rep UpiendPredicateFailure x -> UpiendPredicateFailure
to :: forall x. Rep UpiendPredicateFailure x -> UpiendPredicateFailure
Generic, Context -> UpiendPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpiendPredicateFailure -> String
(Context -> UpiendPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpiendPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpiendPredicateFailure -> String)
-> NoThunks UpiendPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpiendPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpiendPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpiendPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpiendPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpiendPredicateFailure -> String
showTypeOf :: Proxy UpiendPredicateFailure -> String
NoThunks)
instance STS UPIEND where
type Environment UPIEND = UPIEnv
type State UPIEND = UPIState
type Signal UPIEND = (ProtVer, Core.VKey)
type PredicateFailure UPIEND = UpiendPredicateFailure
initialRules :: [InitialRule UPIEND]
initialRules = [UPIState -> F (Clause UPIEND 'Initial) UPIState
forall a. a -> F (Clause UPIEND 'Initial) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UPIState -> F (Clause UPIEND 'Initial) UPIState)
-> UPIState -> F (Clause UPIEND 'Initial) UPIState
forall a b. (a -> b) -> a -> b
$! UPIState
emptyUPIState]
transitionRules :: [TransitionRule UPIEND]
transitionRules =
[ do
TRC
( (Slot
sn, Bimap VKeyGenesis VKey
dms, BlockCount
k, Word8
ngk)
, ( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads
, Map ApName (ApVer, Slot, Metadata)
avs
, Map UpId (ProtVer, PParams)
rpus
, Map UpId (ApName, ApVer, Metadata)
raus
, Map UpId Slot
cps
, Set (UpId, VKeyGenesis)
vts
, Set (ProtVer, VKeyGenesis)
bvs
, Map UpId Slot
pws
)
, (ProtVer
bv, VKey
vk)
) <-
Rule UPIEND 'Transition (RuleContext 'Transition UPIEND)
F (Clause UPIEND 'Transition) (TRC UPIEND)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let t :: Natural
t = UpAdptThd -> Natural
forall b. Integral b => UpAdptThd -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (UpAdptThd -> Natural) -> UpAdptThd -> Natural
forall a b. (a -> b) -> a -> b
$ PParams
pps PParams -> Getting UpAdptThd PParams UpAdptThd -> UpAdptThd
forall s a. s -> Getting a s a -> a
^. Getting UpAdptThd PParams UpAdptThd
Lens' PParams UpAdptThd
upAdptThd UpAdptThd -> UpAdptThd -> UpAdptThd
forall a. Num a => a -> a -> a
* Word8 -> UpAdptThd
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ngk
([(Slot, (ProtVer, PParams))]
fads', Set (ProtVer, VKeyGenesis)
bvs') <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @UPEND (RuleContext 'Transition UPEND
-> Rule UPIEND 'Transition (State UPEND))
-> RuleContext 'Transition UPEND
-> Rule UPIEND 'Transition (State UPEND)
forall a b. (a -> b) -> a -> b
$ (Environment UPEND, State UPEND, Signal UPEND) -> TRC UPEND
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((Slot
sn, Natural
t, Bimap VKeyGenesis VKey
dms, Map UpId Slot
cps, Map UpId (ProtVer, PParams)
rpus, BlockCount
k), ([(Slot, (ProtVer, PParams))]
fads, Set (ProtVer, VKeyGenesis)
bvs), (ProtVer
bv, VKey
vk))
let u :: SlotCount
u = PParams
pps PParams -> Getting SlotCount PParams SlotCount -> SlotCount
forall s a. s -> Getting a s a -> a
^. Getting SlotCount PParams SlotCount
Lens' PParams SlotCount
upTtl
pidskeep :: Set UpId
pidskeep = Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (Map UpId Slot
pws Map UpId Slot -> Range (Map UpId Slot) -> Map UpId Slot
forall m. (Relation m, Ord (Range m)) => m -> Range m -> m
▷>= Slot
sn Slot -> SlotCount -> Slot
-. SlotCount
u) Set UpId -> Set UpId -> Set UpId
forall a. Ord a => Set a -> Set a -> Set a
`union` Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId Slot
cps
vskeep :: Set (Domain (Set (ProtVer, PParams)))
vskeep = Set (ProtVer, PParams) -> Set (Domain (Set (ProtVer, PParams)))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (Map UpId (ProtVer, PParams)
-> Set (Range (Map UpId (ProtVer, PParams)))
forall m. (Relation m, Ord (Range m)) => m -> Set (Range m)
range Map UpId (ProtVer, PParams)
rpus')
rpus' :: Map UpId (ProtVer, PParams)
rpus' = Set (Domain (Map UpId (ProtVer, PParams)))
Set UpId
pidskeep Set (Domain (Map UpId (ProtVer, PParams)))
-> Map UpId (ProtVer, PParams) -> Map UpId (ProtVer, PParams)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId (ProtVer, PParams))), Foldable f) =>
f (Domain (Map UpId (ProtVer, PParams)))
-> Map UpId (ProtVer, PParams) -> Map UpId (ProtVer, PParams)
◁ Map UpId (ProtVer, PParams)
rpus
UPIState -> F (Clause UPIEND 'Transition) UPIState
forall a. a -> F (Clause UPIEND 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return
( (ProtVer
pv, PParams
pps)
, [(Slot, (ProtVer, PParams))]
fads'
, Map ApName (ApVer, Slot, Metadata)
avs
, Map UpId (ProtVer, PParams)
rpus'
, Set (Domain (Map UpId (ApName, ApVer, Metadata)))
Set UpId
pidskeep Set (Domain (Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
-> Map UpId (ApName, ApVer, Metadata)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId (ApName, ApVer, Metadata))), Foldable f) =>
f (Domain (Map UpId (ApName, ApVer, Metadata)))
-> Map UpId (ApName, ApVer, Metadata)
-> Map UpId (ApName, ApVer, Metadata)
◁ Map UpId (ApName, ApVer, Metadata)
raus
, Map UpId Slot
cps
, Set (Domain (Set (UpId, VKeyGenesis)))
Set UpId
pidskeep Set (Domain (Set (UpId, VKeyGenesis)))
-> Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Set (UpId, VKeyGenesis))), Foldable f) =>
f (Domain (Set (UpId, VKeyGenesis)))
-> Set (UpId, VKeyGenesis) -> Set (UpId, VKeyGenesis)
◁ Set (UpId, VKeyGenesis)
vts
, Set (Domain (Set (ProtVer, VKeyGenesis)))
Set (Domain (Set (ProtVer, PParams)))
vskeep Set (Domain (Set (ProtVer, VKeyGenesis)))
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Set (ProtVer, VKeyGenesis))), Foldable f) =>
f (Domain (Set (ProtVer, VKeyGenesis)))
-> Set (ProtVer, VKeyGenesis) -> Set (ProtVer, VKeyGenesis)
◁ Set (ProtVer, VKeyGenesis)
bvs'
, Set (Domain (Map UpId Slot))
Set UpId
pidskeep Set (Domain (Map UpId Slot)) -> Map UpId Slot -> Map UpId Slot
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId Slot)), Foldable f) =>
f (Domain (Map UpId Slot)) -> Map UpId Slot -> Map UpId Slot
◁ Map UpId Slot
pws
)
]
instance Embed UPEND UPIEND where
wrapFailed :: PredicateFailure UPEND -> PredicateFailure UPIEND
wrapFailed = PredicateFailure UPEND -> PredicateFailure UPIEND
PredicateFailure UPEND -> UpiendPredicateFailure
UPENDFailure
pickHighlyEndorsedProtocolVersion ::
[(ProtVer, Set Core.VKeyGenesis)] ->
Gen (Maybe ProtVer)
pickHighlyEndorsedProtocolVersion :: [(ProtVer, Set VKeyGenesis)] -> Gen (Maybe ProtVer)
pickHighlyEndorsedProtocolVersion [(ProtVer, Set VKeyGenesis)]
endorsementsList =
if [ProtVer] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProtVer]
mostEndorsedProposals
then Maybe ProtVer -> Gen (Maybe ProtVer)
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ProtVer
forall a. Maybe a
Nothing
else ProtVer -> Maybe ProtVer
forall a. a -> Maybe a
Just (ProtVer -> Maybe ProtVer)
-> GenT Identity ProtVer -> Gen (Maybe ProtVer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProtVer] -> GenT Identity ProtVer
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [ProtVer]
mostEndorsedProposals
where
mostEndorsedProposals :: [ProtVer]
mostEndorsedProposals :: [ProtVer]
mostEndorsedProposals =
((ProtVer, Set VKeyGenesis) -> Down (ProtVer, Int))
-> [(ProtVer, Set VKeyGenesis)] -> [(ProtVer, Set VKeyGenesis)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((ProtVer, Int) -> Down (ProtVer, Int)
forall a. a -> Down a
Down ((ProtVer, Int) -> Down (ProtVer, Int))
-> ((ProtVer, Set VKeyGenesis) -> (ProtVer, Int))
-> (ProtVer, Set VKeyGenesis)
-> Down (ProtVer, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set VKeyGenesis -> Int)
-> (ProtVer, Set VKeyGenesis) -> (ProtVer, Int)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Set VKeyGenesis -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [(ProtVer, Set VKeyGenesis)]
endorsementsList
[(ProtVer, Set VKeyGenesis)]
-> ([(ProtVer, Set VKeyGenesis)] -> [(ProtVer, Set VKeyGenesis)])
-> [(ProtVer, Set VKeyGenesis)]
forall a b. a -> (a -> b) -> b
& Int -> [(ProtVer, Set VKeyGenesis)] -> [(ProtVer, Set VKeyGenesis)]
forall a. Int -> [a] -> [a]
take Int
5
[(ProtVer, Set VKeyGenesis)]
-> ([(ProtVer, Set VKeyGenesis)] -> [ProtVer]) -> [ProtVer]
forall a b. a -> (a -> b) -> b
& ((ProtVer, Set VKeyGenesis) -> ProtVer)
-> [(ProtVer, Set VKeyGenesis)] -> [ProtVer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProtVer, Set VKeyGenesis) -> ProtVer
forall a b. (a, b) -> a
fst
data PVBUMP deriving ((forall x. PVBUMP -> Rep PVBUMP x)
-> (forall x. Rep PVBUMP x -> PVBUMP) -> Generic PVBUMP
forall x. Rep PVBUMP x -> PVBUMP
forall x. PVBUMP -> Rep PVBUMP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PVBUMP -> Rep PVBUMP x
from :: forall x. PVBUMP -> Rep PVBUMP x
$cto :: forall x. Rep PVBUMP x -> PVBUMP
to :: forall x. Rep PVBUMP x -> PVBUMP
Generic, Typeable PVBUMP
Typeable PVBUMP =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PVBUMP -> c PVBUMP)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PVBUMP)
-> (PVBUMP -> Constr)
-> (PVBUMP -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PVBUMP))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PVBUMP))
-> ((forall b. Data b => b -> b) -> PVBUMP -> PVBUMP)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PVBUMP -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PVBUMP -> r)
-> (forall u. (forall d. Data d => d -> u) -> PVBUMP -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> PVBUMP -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP)
-> Data PVBUMP
PVBUMP -> Constr
PVBUMP -> DataType
(forall b. Data b => b -> b) -> PVBUMP -> PVBUMP
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PVBUMP -> u
forall u. (forall d. Data d => d -> u) -> PVBUMP -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PVBUMP -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PVBUMP -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PVBUMP
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PVBUMP -> c PVBUMP
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PVBUMP)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PVBUMP)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PVBUMP -> c PVBUMP
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PVBUMP -> c PVBUMP
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PVBUMP
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PVBUMP
$ctoConstr :: PVBUMP -> Constr
toConstr :: PVBUMP -> Constr
$cdataTypeOf :: PVBUMP -> DataType
dataTypeOf :: PVBUMP -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PVBUMP)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PVBUMP)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PVBUMP)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PVBUMP)
$cgmapT :: (forall b. Data b => b -> b) -> PVBUMP -> PVBUMP
gmapT :: (forall b. Data b => b -> b) -> PVBUMP -> PVBUMP
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PVBUMP -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PVBUMP -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PVBUMP -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PVBUMP -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PVBUMP -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PVBUMP -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PVBUMP -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PVBUMP -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PVBUMP -> m PVBUMP
Data)
data PvbumpPredicateFailure = NoPVBUMPFailure
deriving (PvbumpPredicateFailure -> PvbumpPredicateFailure -> Bool
(PvbumpPredicateFailure -> PvbumpPredicateFailure -> Bool)
-> (PvbumpPredicateFailure -> PvbumpPredicateFailure -> Bool)
-> Eq PvbumpPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PvbumpPredicateFailure -> PvbumpPredicateFailure -> Bool
== :: PvbumpPredicateFailure -> PvbumpPredicateFailure -> Bool
$c/= :: PvbumpPredicateFailure -> PvbumpPredicateFailure -> Bool
/= :: PvbumpPredicateFailure -> PvbumpPredicateFailure -> Bool
Eq, Int -> PvbumpPredicateFailure -> ShowS
[PvbumpPredicateFailure] -> ShowS
PvbumpPredicateFailure -> String
(Int -> PvbumpPredicateFailure -> ShowS)
-> (PvbumpPredicateFailure -> String)
-> ([PvbumpPredicateFailure] -> ShowS)
-> Show PvbumpPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PvbumpPredicateFailure -> ShowS
showsPrec :: Int -> PvbumpPredicateFailure -> ShowS
$cshow :: PvbumpPredicateFailure -> String
show :: PvbumpPredicateFailure -> String
$cshowList :: [PvbumpPredicateFailure] -> ShowS
showList :: [PvbumpPredicateFailure] -> ShowS
Show, Typeable PvbumpPredicateFailure
Typeable PvbumpPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PvbumpPredicateFailure
-> c PvbumpPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PvbumpPredicateFailure)
-> (PvbumpPredicateFailure -> Constr)
-> (PvbumpPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PvbumpPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PvbumpPredicateFailure))
-> ((forall b. Data b => b -> b)
-> PvbumpPredicateFailure -> PvbumpPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> PvbumpPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PvbumpPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure)
-> Data PvbumpPredicateFailure
PvbumpPredicateFailure -> Constr
PvbumpPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> PvbumpPredicateFailure -> PvbumpPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PvbumpPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> PvbumpPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PvbumpPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PvbumpPredicateFailure
-> c PvbumpPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PvbumpPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PvbumpPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PvbumpPredicateFailure
-> c PvbumpPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PvbumpPredicateFailure
-> c PvbumpPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PvbumpPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PvbumpPredicateFailure
$ctoConstr :: PvbumpPredicateFailure -> Constr
toConstr :: PvbumpPredicateFailure -> Constr
$cdataTypeOf :: PvbumpPredicateFailure -> DataType
dataTypeOf :: PvbumpPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PvbumpPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PvbumpPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PvbumpPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PvbumpPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> PvbumpPredicateFailure -> PvbumpPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> PvbumpPredicateFailure -> PvbumpPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> PvbumpPredicateFailure
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> PvbumpPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> PvbumpPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PvbumpPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PvbumpPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PvbumpPredicateFailure -> m PvbumpPredicateFailure
Data, (forall x. PvbumpPredicateFailure -> Rep PvbumpPredicateFailure x)
-> (forall x.
Rep PvbumpPredicateFailure x -> PvbumpPredicateFailure)
-> Generic PvbumpPredicateFailure
forall x. Rep PvbumpPredicateFailure x -> PvbumpPredicateFailure
forall x. PvbumpPredicateFailure -> Rep PvbumpPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PvbumpPredicateFailure -> Rep PvbumpPredicateFailure x
from :: forall x. PvbumpPredicateFailure -> Rep PvbumpPredicateFailure x
$cto :: forall x. Rep PvbumpPredicateFailure x -> PvbumpPredicateFailure
to :: forall x. Rep PvbumpPredicateFailure x -> PvbumpPredicateFailure
Generic, Context -> PvbumpPredicateFailure -> IO (Maybe ThunkInfo)
Proxy PvbumpPredicateFailure -> String
(Context -> PvbumpPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> PvbumpPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy PvbumpPredicateFailure -> String)
-> NoThunks PvbumpPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> PvbumpPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> PvbumpPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PvbumpPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PvbumpPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PvbumpPredicateFailure -> String
showTypeOf :: Proxy PvbumpPredicateFailure -> String
NoThunks)
instance STS PVBUMP where
type
Environment PVBUMP =
( Core.Slot
, [(Core.Slot, (ProtVer, PParams))]
, BlockCount
)
type
State PVBUMP =
(ProtVer, PParams)
type Signal PVBUMP = ()
type PredicateFailure PVBUMP = PvbumpPredicateFailure
initialRules :: [InitialRule PVBUMP]
initialRules = []
transitionRules :: [TransitionRule PVBUMP]
transitionRules =
[ do
TRC ((Slot
s_n, [(Slot, (ProtVer, PParams))]
fads, BlockCount
k), (ProtVer
pv, PParams
pps), ()) <- Rule PVBUMP 'Transition (RuleContext 'Transition PVBUMP)
F (Clause PVBUMP 'Transition) (TRC PVBUMP)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
case Slot
s_n Slot -> SlotCount -> Slot
-. Word64
4 Word64 -> BlockCount -> SlotCount
*. BlockCount
k Domain [(Slot, (ProtVer, PParams))]
-> [(Slot, (ProtVer, PParams))] -> [(Slot, (ProtVer, PParams))]
forall m. (Relation m, Ord (Domain m)) => Domain m -> m -> m
<=◁ [(Slot, (ProtVer, PParams))]
fads of
[] ->
(ProtVer, PParams)
-> F (Clause PVBUMP 'Transition) (ProtVer, PParams)
forall a. a -> F (Clause PVBUMP 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ProtVer, PParams)
-> F (Clause PVBUMP 'Transition) (ProtVer, PParams))
-> (ProtVer, PParams)
-> F (Clause PVBUMP 'Transition) (ProtVer, PParams)
forall a b. (a -> b) -> a -> b
$! (ProtVer
pv, PParams
pps)
(Slot
_s, (ProtVer
pv_c, PParams
pps_c)) : [(Slot, (ProtVer, PParams))]
_xs ->
(ProtVer, PParams)
-> F (Clause PVBUMP 'Transition) (ProtVer, PParams)
forall a. a -> F (Clause PVBUMP 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ProtVer, PParams)
-> F (Clause PVBUMP 'Transition) (ProtVer, PParams))
-> (ProtVer, PParams)
-> F (Clause PVBUMP 'Transition) (ProtVer, PParams)
forall a b. (a -> b) -> a -> b
$! (ProtVer
pv_c, PParams
pps_c)
]
data UPIEC deriving ((forall x. UPIEC -> Rep UPIEC x)
-> (forall x. Rep UPIEC x -> UPIEC) -> Generic UPIEC
forall x. Rep UPIEC x -> UPIEC
forall x. UPIEC -> Rep UPIEC x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UPIEC -> Rep UPIEC x
from :: forall x. UPIEC -> Rep UPIEC x
$cto :: forall x. Rep UPIEC x -> UPIEC
to :: forall x. Rep UPIEC x -> UPIEC
Generic, Typeable UPIEC
Typeable UPIEC =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEC -> c UPIEC)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEC)
-> (UPIEC -> Constr)
-> (UPIEC -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEC))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEC))
-> ((forall b. Data b => b -> b) -> UPIEC -> UPIEC)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r)
-> (forall u. (forall d. Data d => d -> u) -> UPIEC -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UPIEC -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC)
-> Data UPIEC
UPIEC -> Constr
UPIEC -> DataType
(forall b. Data b => b -> b) -> UPIEC -> UPIEC
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UPIEC -> u
forall u. (forall d. Data d => d -> u) -> UPIEC -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEC
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEC -> c UPIEC
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEC)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEC)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEC -> c UPIEC
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UPIEC -> c UPIEC
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEC
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UPIEC
$ctoConstr :: UPIEC -> Constr
toConstr :: UPIEC -> Constr
$cdataTypeOf :: UPIEC -> DataType
dataTypeOf :: UPIEC -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEC)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UPIEC)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEC)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UPIEC)
$cgmapT :: (forall b. Data b => b -> b) -> UPIEC -> UPIEC
gmapT :: (forall b. Data b => b -> b) -> UPIEC -> UPIEC
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UPIEC -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UPIEC -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UPIEC -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIEC -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UPIEC -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UPIEC -> m UPIEC
Data)
data UpiecPredicateFailure
= PVBUMPFailure (PredicateFailure PVBUMP)
deriving (UpiecPredicateFailure -> UpiecPredicateFailure -> Bool
(UpiecPredicateFailure -> UpiecPredicateFailure -> Bool)
-> (UpiecPredicateFailure -> UpiecPredicateFailure -> Bool)
-> Eq UpiecPredicateFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpiecPredicateFailure -> UpiecPredicateFailure -> Bool
== :: UpiecPredicateFailure -> UpiecPredicateFailure -> Bool
$c/= :: UpiecPredicateFailure -> UpiecPredicateFailure -> Bool
/= :: UpiecPredicateFailure -> UpiecPredicateFailure -> Bool
Eq, Int -> UpiecPredicateFailure -> ShowS
[UpiecPredicateFailure] -> ShowS
UpiecPredicateFailure -> String
(Int -> UpiecPredicateFailure -> ShowS)
-> (UpiecPredicateFailure -> String)
-> ([UpiecPredicateFailure] -> ShowS)
-> Show UpiecPredicateFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpiecPredicateFailure -> ShowS
showsPrec :: Int -> UpiecPredicateFailure -> ShowS
$cshow :: UpiecPredicateFailure -> String
show :: UpiecPredicateFailure -> String
$cshowList :: [UpiecPredicateFailure] -> ShowS
showList :: [UpiecPredicateFailure] -> ShowS
Show, Typeable UpiecPredicateFailure
Typeable UpiecPredicateFailure =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiecPredicateFailure
-> c UpiecPredicateFailure)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiecPredicateFailure)
-> (UpiecPredicateFailure -> Constr)
-> (UpiecPredicateFailure -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiecPredicateFailure))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiecPredicateFailure))
-> ((forall b. Data b => b -> b)
-> UpiecPredicateFailure -> UpiecPredicateFailure)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiecPredicateFailure
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> UpiecPredicateFailure
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> UpiecPredicateFailure -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UpiecPredicateFailure -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure)
-> Data UpiecPredicateFailure
UpiecPredicateFailure -> Constr
UpiecPredicateFailure -> DataType
(forall b. Data b => b -> b)
-> UpiecPredicateFailure -> UpiecPredicateFailure
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpiecPredicateFailure -> u
forall u.
(forall d. Data d => d -> u) -> UpiecPredicateFailure -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpiecPredicateFailure -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpiecPredicateFailure -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiecPredicateFailure
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiecPredicateFailure
-> c UpiecPredicateFailure
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiecPredicateFailure)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiecPredicateFailure)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiecPredicateFailure
-> c UpiecPredicateFailure
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> UpiecPredicateFailure
-> c UpiecPredicateFailure
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiecPredicateFailure
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpiecPredicateFailure
$ctoConstr :: UpiecPredicateFailure -> Constr
toConstr :: UpiecPredicateFailure -> Constr
$cdataTypeOf :: UpiecPredicateFailure -> DataType
dataTypeOf :: UpiecPredicateFailure -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiecPredicateFailure)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpiecPredicateFailure)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiecPredicateFailure)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpiecPredicateFailure)
$cgmapT :: (forall b. Data b => b -> b)
-> UpiecPredicateFailure -> UpiecPredicateFailure
gmapT :: (forall b. Data b => b -> b)
-> UpiecPredicateFailure -> UpiecPredicateFailure
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpiecPredicateFailure -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpiecPredicateFailure -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpiecPredicateFailure -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpiecPredicateFailure -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> UpiecPredicateFailure -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> UpiecPredicateFailure -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpiecPredicateFailure -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpiecPredicateFailure -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpiecPredicateFailure -> m UpiecPredicateFailure
Data, (forall x. UpiecPredicateFailure -> Rep UpiecPredicateFailure x)
-> (forall x. Rep UpiecPredicateFailure x -> UpiecPredicateFailure)
-> Generic UpiecPredicateFailure
forall x. Rep UpiecPredicateFailure x -> UpiecPredicateFailure
forall x. UpiecPredicateFailure -> Rep UpiecPredicateFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpiecPredicateFailure -> Rep UpiecPredicateFailure x
from :: forall x. UpiecPredicateFailure -> Rep UpiecPredicateFailure x
$cto :: forall x. Rep UpiecPredicateFailure x -> UpiecPredicateFailure
to :: forall x. Rep UpiecPredicateFailure x -> UpiecPredicateFailure
Generic, Context -> UpiecPredicateFailure -> IO (Maybe ThunkInfo)
Proxy UpiecPredicateFailure -> String
(Context -> UpiecPredicateFailure -> IO (Maybe ThunkInfo))
-> (Context -> UpiecPredicateFailure -> IO (Maybe ThunkInfo))
-> (Proxy UpiecPredicateFailure -> String)
-> NoThunks UpiecPredicateFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> UpiecPredicateFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> UpiecPredicateFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> UpiecPredicateFailure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> UpiecPredicateFailure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy UpiecPredicateFailure -> String
showTypeOf :: Proxy UpiecPredicateFailure -> String
NoThunks)
instance STS UPIEC where
type
Environment UPIEC =
( Core.Epoch
, BlockCount
)
type State UPIEC = UPIState
type Signal UPIEC = ()
type PredicateFailure UPIEC = UpiecPredicateFailure
initialRules :: [InitialRule UPIEC]
initialRules = []
transitionRules :: [TransitionRule UPIEC]
transitionRules =
[ do
TRC ((Epoch
e_n, BlockCount
k), State UPIEC
us, ()) <- Rule UPIEC 'Transition (RuleContext 'Transition UPIEC)
F (Clause UPIEC 'Transition) (TRC UPIEC)
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let (ProtVer
pv, PParams
pps) = UPIState -> (ProtVer, PParams)
fstUPIState UPIState
State UPIEC
us :: (ProtVer, PParams)
fads :: [(Slot, (ProtVer, PParams))]
fads = UPIState -> [(Slot, (ProtVer, PParams))]
sndUPIState UPIState
State UPIEC
us :: [(Core.Slot, (ProtVer, PParams))]
(ProtVer
pv', PParams
pps') <-
forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @PVBUMP (RuleContext 'Transition PVBUMP
-> Rule UPIEC 'Transition (State PVBUMP))
-> RuleContext 'Transition PVBUMP
-> Rule UPIEC 'Transition (State PVBUMP)
forall a b. (a -> b) -> a -> b
$
(Environment PVBUMP, State PVBUMP, Signal PVBUMP) -> TRC PVBUMP
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((BlockCount -> Epoch -> Slot
GP.epochFirstSlot BlockCount
k Epoch
e_n, [(Slot, (ProtVer, PParams))]
fads, BlockCount
k), (ProtVer
pv, PParams
pps), ())
UPIState -> F (Clause UPIEC 'Transition) UPIState
forall a. a -> F (Clause UPIEC 'Transition) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UPIState -> F (Clause UPIEC 'Transition) UPIState)
-> UPIState -> F (Clause UPIEC 'Transition) UPIState
forall a b. (a -> b) -> a -> b
$!
if ProtVer
pv ProtVer -> ProtVer -> Bool
forall a. Eq a => a -> a -> Bool
== ProtVer
pv'
then UPIState
State UPIEC
us
else
( (ProtVer
pv', PParams
pps') :: (ProtVer, PParams)
, [] :: [(Core.Slot, (ProtVer, PParams))]
, UPIState -> Map ApName (ApVer, Slot, Metadata)
trdUPIState UPIState
State UPIEC
us :: Map ApName (ApVer, Core.Slot, Metadata)
, Map UpId (ProtVer, PParams)
forall k a. Map k a
Map.empty :: Map UpId (ProtVer, PParams)
,
Map UpId (ApName, ApVer, Metadata)
forall k a. Map k a
Map.empty :: Map UpId (ApName, ApVer, Metadata)
, Map UpId Slot
forall k a. Map k a
Map.empty :: Map UpId Core.Slot
, Set (UpId, VKeyGenesis)
forall a. Set a
Set.empty :: Set (UpId, Core.VKeyGenesis)
, Set (ProtVer, VKeyGenesis)
forall a. Set a
Set.empty :: Set (ProtVer, Core.VKeyGenesis)
, Map UpId Slot
forall k a. Map k a
Map.empty :: Map UpId Core.Slot
)
]
instance Embed PVBUMP UPIEC where
wrapFailed :: PredicateFailure PVBUMP -> PredicateFailure UPIEC
wrapFailed = PredicateFailure PVBUMP -> PredicateFailure UPIEC
PredicateFailure PVBUMP -> UpiecPredicateFailure
PVBUMPFailure
updateProposalAndVotesGen ::
UPIEnv ->
UPIState ->
Gen (Maybe UProp, [Vote])
updateProposalAndVotesGen :: UPIEnv -> UPIState -> Gen (Maybe UProp, [Vote])
updateProposalAndVotesGen UPIEnv
upienv UPIState
upistate = do
let rpus :: Map UpId (ProtVer, PParams)
rpus = UPIState -> Map UpId (ProtVer, PParams)
registeredProtocolUpdateProposals UPIState
upistate
if Set UpId -> Bool
forall a. Set a -> Bool
Set.null (Map UpId (ProtVer, PParams)
-> Set (Domain (Map UpId (ProtVer, PParams)))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom Map UpId (ProtVer, PParams)
rpus)
then Gen (Maybe UProp, [Vote])
generateUpdateProposalAndVotes
else
[(Int, Gen (Maybe UProp, [Vote]))] -> Gen (Maybe UProp, [Vote])
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
Gen.frequency
[ (Int
5, Gen (Maybe UProp, [Vote])
generateOnlyVotes)
, (Int
1, Gen (Maybe UProp, [Vote])
generateUpdateProposalAndVotes)
]
where
generateOnlyVotes :: Gen (Maybe UProp, [Vote])
generateOnlyVotes = (Maybe UProp
forall a. Maybe a
Nothing,) ([Vote] -> (Maybe UProp, [Vote]))
-> GenT Identity [Vote] -> Gen (Maybe UProp, [Vote])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. HasTrace s => SignalGenerator s
sigGen @UPIVOTES UPIEnv
Environment UPIVOTES
upienv UPIState
State UPIVOTES
upistate
generateUpdateProposalAndVotes :: Gen (Maybe UProp, [Vote])
generateUpdateProposalAndVotes = do
UProp
updateProposal <- forall s. HasTrace s => SignalGenerator s
sigGen @UPIREG UPIEnv
Environment UPIREG
upienv UPIState
State UPIREG
upistate
case forall s (rtype :: RuleType).
(STS s, RuleTypeRep rtype, BaseM s ~ Identity) =>
RuleContext rtype s
-> Either (NonEmpty (PredicateFailure s)) (State s)
applySTS @UPIREG ((Environment UPIREG, State UPIREG, Signal UPIREG) -> TRC UPIREG
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (UPIEnv
Environment UPIREG
upienv, UPIState
State UPIREG
upistate, Signal UPIREG
UProp
updateProposal)) of
Left NonEmpty (PredicateFailure UPIREG)
_ ->
(UProp -> Maybe UProp
forall a. a -> Maybe a
Just UProp
updateProposal,)
([Vote] -> (Maybe UProp, [Vote]))
-> GenT Identity [Vote] -> Gen (Maybe UProp, [Vote])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. HasTrace s => SignalGenerator s
sigGen @UPIVOTES UPIEnv
Environment UPIVOTES
upienv UPIState
State UPIVOTES
upistate
Right State UPIREG
upistateAfterRegistration ->
(UProp -> Maybe UProp
forall a. a -> Maybe a
Just UProp
updateProposal,)
([Vote] -> (Maybe UProp, [Vote]))
-> GenT Identity [Vote] -> Gen (Maybe UProp, [Vote])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. HasTrace s => SignalGenerator s
sigGen @UPIVOTES UPIEnv
Environment UPIVOTES
upienv State UPIVOTES
State UPIREG
upistateAfterRegistration
protocolVersionEndorsementGen ::
UPIEnv ->
UPIState ->
Gen ProtVer
protocolVersionEndorsementGen :: UPIEnv -> UPIState -> GenT Identity ProtVer
protocolVersionEndorsementGen UPIEnv
upienv UPIState
upistate =
ProtVer -> Maybe ProtVer -> ProtVer
forall a. a -> Maybe a -> a
fromMaybe (UPIState -> ProtVer
protocolVersion UPIState
upistate)
(Maybe ProtVer -> ProtVer)
-> Gen (Maybe ProtVer) -> GenT Identity ProtVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ProtVer, Set VKeyGenesis)] -> Gen (Maybe ProtVer)
pickHighlyEndorsedProtocolVersion [(ProtVer, Set VKeyGenesis)]
endorsementsList
where
endorsementsList :: [(ProtVer, Set Core.VKeyGenesis)]
endorsementsList :: [(ProtVer, Set VKeyGenesis)]
endorsementsList =
Map ProtVer (Set VKeyGenesis)
endorsementsMap Map ProtVer (Set VKeyGenesis)
-> Map ProtVer (Set VKeyGenesis) -> Map ProtVer (Set VKeyGenesis)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map ProtVer (Set VKeyGenesis)
emptyEndorsements
Map ProtVer (Set VKeyGenesis)
-> (Map ProtVer (Set VKeyGenesis) -> [(ProtVer, Set VKeyGenesis)])
-> [(ProtVer, Set VKeyGenesis)]
forall a b. a -> (a -> b) -> b
& Map ProtVer (Set VKeyGenesis) -> [(ProtVer, Set VKeyGenesis)]
forall k a. Map k a -> [(k, a)]
Map.toList
where
emptyEndorsements :: Map ProtVer (Set Core.VKeyGenesis)
emptyEndorsements :: Map ProtVer (Set VKeyGenesis)
emptyEndorsements =
[ProtVer] -> [Set VKeyGenesis] -> [(ProtVer, Set VKeyGenesis)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ProtVer]
stableAndConfirmedVersions (Set VKeyGenesis -> [Set VKeyGenesis]
forall a. a -> [a]
repeat Set VKeyGenesis
forall a. Set a
Set.empty)
[(ProtVer, Set VKeyGenesis)]
-> ([(ProtVer, Set VKeyGenesis)] -> Map ProtVer (Set VKeyGenesis))
-> Map ProtVer (Set VKeyGenesis)
forall a b. a -> (a -> b) -> b
& [(ProtVer, Set VKeyGenesis)] -> Map ProtVer (Set VKeyGenesis)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
where
stableAndConfirmedVersions ::
[ProtVer]
stableAndConfirmedVersions :: [ProtVer]
stableAndConfirmedVersions =
Set (Domain (Map UpId (ProtVer, PParams)))
Set (Domain (Map UpId Slot))
stableAndConfirmedProposalIDs Set (Domain (Map UpId (ProtVer, PParams)))
-> Map UpId (ProtVer, PParams) -> Map UpId (ProtVer, PParams)
forall m (f :: * -> *).
(Relation m, Ord (Domain m), Foldable f) =>
f (Domain m) -> m -> m
forall (f :: * -> *).
(Ord (Domain (Map UpId (ProtVer, PParams))), Foldable f) =>
f (Domain (Map UpId (ProtVer, PParams)))
-> Map UpId (ProtVer, PParams) -> Map UpId (ProtVer, PParams)
◁ Map UpId (ProtVer, PParams)
rpus
Map UpId (ProtVer, PParams)
-> (Map UpId (ProtVer, PParams) -> [(ProtVer, PParams)])
-> [(ProtVer, PParams)]
forall a b. a -> (a -> b) -> b
& Map UpId (ProtVer, PParams) -> [(ProtVer, PParams)]
forall k a. Map k a -> [a]
Map.elems
[(ProtVer, PParams)]
-> ([(ProtVer, PParams)] -> [ProtVer]) -> [ProtVer]
forall a b. a -> (a -> b) -> b
& ((ProtVer, PParams) -> ProtVer)
-> [(ProtVer, PParams)] -> [ProtVer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProtVer, PParams) -> ProtVer
forall a b. (a, b) -> a
fst
where
stableAndConfirmedProposalIDs :: Set (Domain (Map UpId Slot))
stableAndConfirmedProposalIDs =
Map UpId Slot -> Set (Domain (Map UpId Slot))
forall m. (Relation m, Ord (Domain m)) => m -> Set (Domain m)
dom (UPIState -> Map UpId Slot
confirmedProposals UPIState
upistate Map UpId Slot -> Range (Map UpId Slot) -> Map UpId Slot
forall m. (Relation m, Ord (Range m)) => m -> Range m -> m
▷<= Slot
sn Slot -> SlotCount -> Slot
-. Word64
4 Word64 -> BlockCount -> SlotCount
*. BlockCount
k)
where
(Slot
sn, Bimap VKeyGenesis VKey
_, BlockCount
k, Word8
_) = UPIEnv
upienv
rpus :: Map UpId (ProtVer, PParams)
rpus = UPIState -> Map UpId (ProtVer, PParams)
registeredProtocolUpdateProposals UPIState
upistate
endorsementsMap :: Map ProtVer (Set Core.VKeyGenesis)
endorsementsMap :: Map ProtVer (Set VKeyGenesis)
endorsementsMap =
Set (ProtVer, VKeyGenesis) -> [(ProtVer, VKeyGenesis)]
forall a. Set a -> [a]
Set.toList (UPIState -> Set (ProtVer, VKeyGenesis)
endorsements UPIState
upistate)
[(ProtVer, VKeyGenesis)]
-> ([(ProtVer, VKeyGenesis)] -> [(ProtVer, Set VKeyGenesis)])
-> [(ProtVer, Set VKeyGenesis)]
forall a b. a -> (a -> b) -> b
& ((ProtVer, VKeyGenesis) -> (ProtVer, Set VKeyGenesis))
-> [(ProtVer, VKeyGenesis)] -> [(ProtVer, Set VKeyGenesis)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((VKeyGenesis -> Set VKeyGenesis)
-> (ProtVer, VKeyGenesis) -> (ProtVer, Set VKeyGenesis)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second VKeyGenesis -> Set VKeyGenesis
forall a. a -> Set a
Set.singleton)
[(ProtVer, Set VKeyGenesis)]
-> ([(ProtVer, Set VKeyGenesis)] -> Map ProtVer (Set VKeyGenesis))
-> Map ProtVer (Set VKeyGenesis)
forall a b. a -> (a -> b) -> b
& (Set VKeyGenesis -> Set VKeyGenesis -> Set VKeyGenesis)
-> [(ProtVer, Set VKeyGenesis)] -> Map ProtVer (Set VKeyGenesis)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set VKeyGenesis -> Set VKeyGenesis -> Set VKeyGenesis
forall a. Ord a => Set a -> Set a -> Set a
Set.union
instance Field1 (a, b, c, d, e, f, g, h, i) (a', b, c, d, e, f, g, h, i) a a' where
_1 :: Lens (a, b, c, d, e, f, g, h, i) (a', b, c, d, e, f, g, h, i) a a'
_1 a -> f a'
k ~(a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (\a'
a' -> (a'
a', b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)) (a' -> (a', b, c, d, e, f, g, h, i))
-> f a' -> f (a', b, c, d, e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
{-# INLINE _1 #-}
instance Field2 (a, b, c, d, e, f, g, h, i) (a, b', c, d, e, f, g, h, i) b b' where
_2 :: Lens (a, b, c, d, e, f, g, h, i) (a, b', c, d, e, f, g, h, i) b b'
_2 b -> f b'
k ~(a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (\b'
b' -> (a
a, b'
b', c
c, d
d, e
e, f
f, g
g, h
h, i
i)) (b' -> (a, b', c, d, e, f, g, h, i))
-> f b' -> f (a, b', c, d, e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
{-# INLINE _2 #-}
instance Field3 (a, b, c, d, e, f, g, h, i) (a, b, c', d, e, f, g, h, i) c c' where
_3 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c', d, e, f, g, h, i) c c'
_3 c -> f c'
k ~(a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (\c'
c' -> (a
a, b
b, c'
c', d
d, e
e, f
f, g
g, h
h, i
i)) (c' -> (a, b, c', d, e, f, g, h, i))
-> f c' -> f (a, b, c', d, e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
{-# INLINE _3 #-}