/
Deleg.hs
61 lines (53 loc) · 1.89 KB
/
Deleg.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies #-}
module STS.Deleg
( DELEG
)
where
import qualified Data.Map.Strict as Map
import Address
import BlockChain (slotsPrior)
import Delegation.Certificates
import Keys
import LedgerState
import Slot
import Control.State.Transition
data DELEG hashAlgo dsignAlgo
instance
(HashAlgorithm hashAlgo, DSIGNAlgorithm dsignAlgo)
=> STS (DELEG hashAlgo dsignAlgo)
where
type State (DELEG hashAlgo dsignAlgo) = DState hashAlgo dsignAlgo
type Signal (DELEG hashAlgo dsignAlgo) = DCert hashAlgo dsignAlgo
type Environment (DELEG hashAlgo dsignAlgo) = (Slot, Ptr)
data PredicateFailure (DELEG hashAlgo dsignAlgo)
= StakeKeyAlreadyRegisteredDELEG
| StakeKeyNotRegisteredDELEG
| StakeDelegationImpossibleDELEG
| WrongCertificateTypeDELEG
| GenesisKeyNotInpMappingDELEG
deriving (Show, Eq)
initialRules = [pure emptyDState]
transitionRules = [delegationTransition]
delegationTransition
:: (HashAlgorithm hashAlgo, DSIGNAlgorithm dsignAlgo)
=> TransitionRule (DELEG hashAlgo dsignAlgo)
delegationTransition = do
TRC ((_slot, p), d@(DState _ _ _ _ genMap (Dms _dms)), c) <- judgmentContext
case c of
RegKey _ -> do
validKeyRegistration c d == Valid ?! StakeKeyAlreadyRegisteredDELEG
pure $ applyDCertDState p c d
DeRegKey _ -> do
validKeyDeregistration c d == Valid ?! StakeKeyNotRegisteredDELEG
pure $ applyDCertDState p c d
Delegate _ -> do
validStakeDelegation c d == Valid ?! StakeDelegationImpossibleDELEG
pure $ applyDCertDState p c d
GenesisDelegate (gkey, vk) -> do
Map.member gkey _dms ?! GenesisKeyNotInpMappingDELEG
let s' = _slot +* slotsPrior
pure $ d { _fdms = Map.insert (s', gkey) vk genMap}
_ -> do
failBecause WrongCertificateTypeDELEG -- this always fails
pure d