-
Notifications
You must be signed in to change notification settings - Fork 155
/
Chain.hs
83 lines (76 loc) · 2.39 KB
/
Chain.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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Ledger.Chain
( -- | Chain Checks
ChainChecksPParams (..),
ChainPredicateFailure (..),
pparamsToChainChecksPParams,
chainChecks,
)
where
import Cardano.Ledger.BHeaderView (BHeaderView (..))
import Cardano.Ledger.BaseTypes (ProtVer (..))
import Control.Monad (unless)
import Control.Monad.Except (MonadError, throwError)
import GHC.Generics (Generic)
import GHC.Records
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)
data ChainChecksPParams = ChainChecksPParams
{ ccMaxBHSize :: Natural,
ccMaxBBSize :: Natural,
ccProtocolVersion :: ProtVer
}
deriving (Show, Eq, Generic, NoThunks)
pparamsToChainChecksPParams ::
( HasField "_maxBHSize" pp Natural,
HasField "_maxBBSize" pp Natural,
HasField "_protocolVersion" pp ProtVer
) =>
pp ->
ChainChecksPParams
pparamsToChainChecksPParams pp =
ChainChecksPParams
{ ccMaxBHSize = getField @"_maxBHSize" pp,
ccMaxBBSize = getField @"_maxBBSize" pp,
ccProtocolVersion = getField @"_protocolVersion" pp
}
data ChainPredicateFailure
= HeaderSizeTooLargeCHAIN
!Natural -- Header Size
!Natural -- Max Header Size
| BlockSizeTooLargeCHAIN
!Natural -- Block Size
!Natural -- Max Block Size
| ObsoleteNodeCHAIN
!Natural -- protocol version used
!Natural -- max protocol version
deriving (Generic, Show, Eq, Ord)
instance NoThunks ChainPredicateFailure
chainChecks ::
MonadError ChainPredicateFailure m =>
Natural ->
ChainChecksPParams ->
BHeaderView crypto ->
m ()
chainChecks maxpv ccd bhv = do
unless (m <= maxpv) $ throwError (ObsoleteNodeCHAIN m maxpv)
unless (fromIntegral (bhviewHSize bhv) <= ccMaxBHSize ccd) $
throwError $
HeaderSizeTooLargeCHAIN (fromIntegral $ bhviewHSize bhv) (ccMaxBHSize ccd)
unless (bhviewBSize bhv <= ccMaxBBSize ccd) $
throwError $
BlockSizeTooLargeCHAIN (bhviewBSize bhv) (ccMaxBBSize ccd)
where
(ProtVer m _) = ccProtocolVersion ccd