Skip to content

Commit 49eeba5

Browse files
soerenbfsoerenbf
committed
Merge branch 'feature/max-lock-duration' into sz/locks/max-lock-dur-update
2 parents cd6c344 + ce84926 commit 49eeba5

8 files changed

Lines changed: 277 additions & 291 deletions

File tree

‎concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/ExternalChainParameters.hs‎

Lines changed: 16 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE DerivingStrategies #-}
3+
{-# LANGUAGE KindSignatures #-}
34
{-# LANGUAGE MonoLocalBinds #-}
45
{-# LANGUAGE ScopedTypeVariables #-}
56
{-# LANGUAGE TypeApplications #-}
@@ -13,7 +14,6 @@ module Concordium.GlobalState.Persistent.BlockState.ExternalChainParameters (
1314
RustExternalChainParameters,
1415
ForeignExternalChainParametersPtr,
1516
wrapFFIPtr,
16-
empty,
1717
p11NewExternalChainParameters,
1818
withExternalChainParameters,
1919
ExternalChainParametersHash (..),
@@ -42,10 +42,10 @@ data RustExternalChainParameters
4242
-- | Opaque pointer to immutable external chain parameters managed by Rust.
4343
--
4444
-- Memory is deallocated using a finalizer.
45-
newtype ForeignExternalChainParametersPtr = ForeignExternalChainParametersPtr (FFI.ForeignPtr RustExternalChainParameters)
45+
newtype ForeignExternalChainParametersPtr (pv :: Types.ProtocolVersion) = ForeignExternalChainParametersPtr (FFI.ForeignPtr RustExternalChainParameters)
4646

4747
-- | Convert a raw pointer returned by Rust into a managed pointer.
48-
wrapFFIPtr :: FFI.Ptr RustExternalChainParameters -> IO ForeignExternalChainParametersPtr
48+
wrapFFIPtr :: FFI.Ptr RustExternalChainParameters -> IO (ForeignExternalChainParametersPtr pv)
4949
wrapFFIPtr paramsPtr = ForeignExternalChainParametersPtr <$> FFI.newForeignPtr ffiFreeExternalChainParameters paramsPtr
5050

5151
-- | Deallocate a pointer to external chain parameters.
@@ -55,29 +55,11 @@ foreign import ccall unsafe "&ffi_free_external_chain_parameters"
5555
-- | Get temporary access to the external chain-parameters pointer.
5656
--
5757
-- The pointer must not be leaked from the computation.
58-
withExternalChainParameters :: ForeignExternalChainParametersPtr -> (FFI.Ptr RustExternalChainParameters -> IO a) -> IO a
58+
withExternalChainParameters :: ForeignExternalChainParametersPtr pv -> (FFI.Ptr RustExternalChainParameters -> IO a) -> IO a
5959
withExternalChainParameters (ForeignExternalChainParametersPtr foreignPtr) = FFI.withForeignPtr foreignPtr
6060

61-
p11ProtocolVersion :: FFI.Word64
62-
p11ProtocolVersion = Types.protocolVersionToWord64 Types.P11
63-
64-
-- | Allocate new empty external chain parameters.
65-
empty :: (BlobStore.MonadBlobStore m) => m ForeignExternalChainParametersPtr
66-
empty = liftIO $ do
67-
FFI.alloca $ \paramsDestPtr -> do
68-
status <- ffiEmptyExternalChainParameters p11ProtocolVersion paramsDestPtr
69-
Monad.unless (status == 0) $ error "Unexpected panic when creating external chain parameters"
70-
params <- FFI.peek paramsDestPtr
71-
wrapFFIPtr params
72-
73-
foreign import ccall "ffi_empty_external_chain_parameters"
74-
ffiEmptyExternalChainParameters ::
75-
FFI.Word64 ->
76-
FFI.Ptr (FFI.Ptr RustExternalChainParameters) ->
77-
IO FFI.Word8
78-
7961
-- | Allocate new P11 external chain parameters with an initial maximum lock duration.
80-
p11NewExternalChainParameters :: (BlobStore.MonadBlobStore m) => Duration -> m ForeignExternalChainParametersPtr
62+
p11NewExternalChainParameters :: (BlobStore.MonadBlobStore m) => Duration -> m (ForeignExternalChainParametersPtr 'Types.P11)
8163
p11NewExternalChainParameters (Duration maxLockDuration) = liftIO $ do
8264
FFI.alloca $ \paramsDestPtr -> do
8365
status <- ffiP11NewExternalChainParameters maxLockDuration paramsDestPtr
@@ -91,14 +73,19 @@ foreign import ccall "ffi_p11_new_external_chain_parameters"
9173
FFI.Ptr (FFI.Ptr RustExternalChainParameters) ->
9274
IO FFI.Word8
9375

94-
instance (BlobStore.MonadBlobStore m) => BlobStore.BlobStorable m ForeignExternalChainParametersPtr where
76+
instance (BlobStore.MonadBlobStore m, Types.IsProtocolVersion pv) => BlobStore.BlobStorable m (ForeignExternalChainParametersPtr pv) where
9577
load = do
9678
blobRef <- S.get
9779
pure $! do
9880
loadCallback <- fst <$> BlobStore.getCallbacks
9981
liftIO $! do
10082
FFI.alloca $ \paramsDestPtr -> do
101-
status <- ffiLoadExternalChainParameters loadCallback blobRef p11ProtocolVersion paramsDestPtr
83+
status <-
84+
ffiLoadExternalChainParameters
85+
loadCallback
86+
blobRef
87+
(Types.protocolVersionToWord64 $ Types.demoteProtocolVersion $ Types.protocolVersion @pv)
88+
paramsDestPtr
10289
Monad.unless (status == 0) $ error "Unexpected panic when loading external chain parameters"
10390
params <- FFI.peek paramsDestPtr
10491
wrapFFIPtr params
@@ -125,7 +112,7 @@ foreign import ccall "ffi_store_external_chain_parameters"
125112
FFI.Ptr RustExternalChainParameters ->
126113
IO FFI.Word8
127114

128-
instance (BlobStore.MonadBlobStore m) => BlobStore.Cacheable m ForeignExternalChainParametersPtr where
115+
instance (BlobStore.MonadBlobStore m) => BlobStore.Cacheable m (ForeignExternalChainParametersPtr pv) where
129116
cache params = do
130117
loadCallback <- fst <$> BlobStore.getCallbacks
131118
status <- liftIO $! withExternalChainParameters params (ffiCacheExternalChainParameters loadCallback)
@@ -142,7 +129,7 @@ foreign import ccall "ffi_cache_external_chain_parameters"
142129
newtype ExternalChainParametersHash = ExternalChainParametersHash {theExternalChainParametersHash :: SHA256.Hash}
143130
deriving newtype (Eq, Ord, Show, S.Serialize)
144131

145-
instance (BlobStore.MonadBlobStore m) => Hashable.MHashableTo m ExternalChainParametersHash ForeignExternalChainParametersPtr where
132+
instance (BlobStore.MonadBlobStore m) => Hashable.MHashableTo m ExternalChainParametersHash (ForeignExternalChainParametersPtr pv) where
146133
getHashM params = do
147134
loadCallback <- fst <$> BlobStore.getCallbacks
148135
((), hash) <-
@@ -161,7 +148,7 @@ foreign import ccall "ffi_hash_external_chain_parameters"
161148
IO FFI.Word8
162149

163150
-- | Apply a max-lock-duration update to external chain parameters.
164-
applyMaxLockDurationUpdate :: ForeignExternalChainParametersPtr -> Duration -> IO ()
151+
applyMaxLockDurationUpdate :: ForeignExternalChainParametersPtr pv -> Duration -> IO ()
165152
applyMaxLockDurationUpdate params (Duration maxLockDuration) =
166153
withExternalChainParameters params $ \paramsPtr -> do
167154
status <- ffiApplyExternalChainParametersMaxLockDurationUpdate paramsPtr maxLockDuration
@@ -174,7 +161,7 @@ foreign import ccall "ffi_apply_external_chain_parameters_max_lock_duration_upda
174161
IO FFI.Word8
175162

176163
-- | Read the current maximum lock duration from external chain parameters.
177-
getMaxLockDuration :: ForeignExternalChainParametersPtr -> IO Duration
164+
getMaxLockDuration :: ForeignExternalChainParametersPtr pv -> IO Duration
178165
getMaxLockDuration params =
179166
withExternalChainParameters params $ \paramsPtr ->
180167
FFI.alloca $ \durationPtr -> do

‎concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Parameters.hs‎

Lines changed: 45 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@
1111
-- This type is the persistent node representation used by the update state. It
1212
-- is distinct from the @concordium-base@ public/wire @ChainParameters'@ view.
1313
-- The aggregate public/wire type is only used at conversion boundaries; the
14-
-- persistent storage model has its own record fields and a P11-and-onwards
14+
-- persistent storage model has its own record fields and a
1515
-- Rust-managed external chain-parameters pointer.
1616
module Concordium.GlobalState.Persistent.BlockState.Parameters (
1717
PersistentChainParameters,
@@ -24,7 +24,6 @@ module Concordium.GlobalState.Persistent.BlockState.Parameters (
2424
) where
2525

2626
import Control.Monad.IO.Class
27-
import Data.Bool.Singletons
2827
import qualified Data.ByteString as BS
2928
import qualified Data.Serialize as S
3029
import Data.Singletons
@@ -38,7 +37,7 @@ import Concordium.Types.HashableTo
3837
import Concordium.Types.Parameters
3938

4039
-- | Persistent node-owned chain parameters.
41-
data PersistentChainParameters' cpv auv = PersistentChainParameters
40+
data PersistentChainParameters' (pv :: ProtocolVersion) cpv auv = PersistentChainParameters
4241
{ -- | Consensus parameters.
4342
pcpConsensusParameters :: !(ConsensusParameters cpv),
4443
-- | Exchange rates.
@@ -59,19 +58,19 @@ data PersistentChainParameters' cpv auv = PersistentChainParameters
5958
pcpFinalizationCommitteeParameters :: !(OParam 'PTFinalizationCommitteeParameters cpv FinalizationCommitteeParameters),
6059
-- | Validator score parameters.
6160
pcpValidatorScoreParameters :: !(OParam 'PTValidatorScoreParameters cpv ValidatorScoreParameters),
62-
-- | Rust-managed external chain parameters, present for P11-and-onwards authorization versions.
63-
pcpExternalChainParameters :: !(Conditionally (SupportsTokenParameters auv) ECP.ForeignExternalChainParametersPtr)
61+
-- | Rust-managed external chain parameters, present when token parameters are supported.
62+
pcpExternalChainParameters :: !(Conditionally (SupportsTokenParameters auv) (ECP.ForeignExternalChainParametersPtr pv))
6463
}
6564

6665
-- | Protocol-indexed persistent node-owned chain parameters.
67-
type PersistentChainParameters pv = PersistentChainParameters' (ChainParametersVersionFor pv) (AuthorizationsVersionFor pv)
66+
type PersistentChainParameters pv = PersistentChainParameters' pv (ChainParametersVersionFor pv) (AuthorizationsVersionFor pv)
6867

6968
-- | Convert a public/wire chain-parameter view and external pointer into the
7069
-- persistent node representation.
7170
fromChainParameters ::
7271
ChainParameters' cpv ->
73-
Conditionally (SupportsTokenParameters auv) ECP.ForeignExternalChainParametersPtr ->
74-
PersistentChainParameters' cpv auv
72+
Conditionally (SupportsTokenParameters auv) (ECP.ForeignExternalChainParametersPtr pv) ->
73+
PersistentChainParameters' pv cpv auv
7574
fromChainParameters ChainParameters{..} pcpExternalChainParameters =
7675
PersistentChainParameters
7776
{ pcpConsensusParameters = _cpConsensusParameters,
@@ -89,28 +88,35 @@ fromChainParameters ChainParameters{..} pcpExternalChainParameters =
8988

9089
-- | Construct persistent chain parameters from the public/wire view.
9190
makePersistentChainParameters ::
92-
forall m cpv auv.
93-
(MonadBlobStore m, IsAuthorizationsVersion auv) =>
94-
ChainParameters' cpv ->
95-
m (PersistentChainParameters' cpv auv)
91+
forall m pv.
92+
(MonadBlobStore m, IsProtocolVersion pv) =>
93+
ChainParameters pv ->
94+
m (PersistentChainParameters pv)
9695
makePersistentChainParameters chainParameters = do
97-
externalChainParameters <- makeInitialExternalChainParameters @m @cpv @auv chainParameters
96+
externalChainParameters <- makeInitialExternalChainParameters @m @pv chainParameters
9897
return $ fromChainParameters chainParameters externalChainParameters
9998

10099
-- | Construct initial external chain parameters from the public chain-parameter view.
101100
makeInitialExternalChainParameters ::
102-
forall m cpv auv.
103-
(MonadBlobStore m, IsAuthorizationsVersion auv) =>
104-
ChainParameters' cpv ->
105-
m (Conditionally (SupportsTokenParameters auv) ECP.ForeignExternalChainParametersPtr)
106-
makeInitialExternalChainParameters ChainParameters{..} =
107-
case sSupportsTokenParameters (authorizationsVersion @auv) of
108-
SFalse -> return CFalse
109-
STrue ->
110-
CTrue <$> case _cpMaxLockDuration of
111-
SomeParam (Just duration) -> ECP.p11NewExternalChainParameters duration
112-
SomeParam Nothing -> error "P11 external chain parameters require max lock duration"
113-
NoParam -> error "P11 external chain parameters require max lock duration"
101+
forall m pv.
102+
(MonadBlobStore m, IsProtocolVersion pv) =>
103+
ChainParameters pv ->
104+
m (Conditionally (SupportsTokenParameters (AuthorizationsVersionFor pv)) (ECP.ForeignExternalChainParametersPtr pv))
105+
makeInitialExternalChainParameters chainParameters = case protocolVersion @pv of
106+
SP1 -> return CFalse
107+
SP2 -> return CFalse
108+
SP3 -> return CFalse
109+
SP4 -> return CFalse
110+
SP5 -> return CFalse
111+
SP6 -> return CFalse
112+
SP7 -> return CFalse
113+
SP8 -> return CFalse
114+
SP9 -> return CFalse
115+
SP10 -> return CFalse
116+
SP11 ->
117+
CTrue <$> case _cpMaxLockDuration chainParameters of
118+
SomeParam (Just duration) -> ECP.p11NewExternalChainParameters duration
119+
SomeParam Nothing -> error "P11 external chain parameters require max lock duration"
114120

115121
-- | Placeholder public-view value for the max-lock-duration field.
116122
--
@@ -125,19 +131,19 @@ maxLockDurationPlaceholder = \case
125131
-- | Convert persistent chain parameters to the public/wire view, using the
126132
-- placeholder external fields.
127133
persistentChainParametersToChainParameters ::
128-
forall cpv auv.
134+
forall pv cpv auv.
129135
(IsChainParametersVersion cpv) =>
130-
PersistentChainParameters' cpv auv ->
136+
PersistentChainParameters' pv cpv auv ->
131137
ChainParameters' cpv
132138
persistentChainParametersToChainParameters params =
133139
makeChainParametersView params (maxLockDurationPlaceholder (chainParametersVersion @cpv))
134140

135141
-- | Convert persistent chain parameters to the public/wire view, sourcing
136142
-- externally-managed fields from the external chain-parameters component when present.
137143
persistentChainParametersToChainParametersM ::
138-
forall m cpv auv.
144+
forall m pv cpv auv.
139145
(MonadIO m, IsChainParametersVersion cpv) =>
140-
PersistentChainParameters' cpv auv ->
146+
PersistentChainParameters' pv cpv auv ->
141147
m (ChainParameters' cpv)
142148
persistentChainParametersToChainParametersM params@PersistentChainParameters{..} = do
143149
maxLockDuration <- case pcpExternalChainParameters of
@@ -152,7 +158,7 @@ persistentChainParametersToChainParametersM params@PersistentChainParameters{..}
152158
-- | Construct the public/wire view from persistent fields and a supplied
153159
-- max-lock-duration value.
154160
makeChainParametersView ::
155-
PersistentChainParameters' cpv auv ->
161+
PersistentChainParameters' pv cpv auv ->
156162
OParam 'PTMaxLockDuration cpv (Maybe Duration) ->
157163
ChainParameters' cpv
158164
makeChainParametersView PersistentChainParameters{..} maxLockDuration =
@@ -174,25 +180,25 @@ makeChainParametersView PersistentChainParameters{..} maxLockDuration =
174180
-- Rust-managed external chain-parameters pointer.
175181
updateChainParameters ::
176182
ChainParameters' cpv ->
177-
PersistentChainParameters' cpv auv ->
178-
PersistentChainParameters' cpv auv
183+
PersistentChainParameters' pv cpv auv ->
184+
PersistentChainParameters' pv cpv auv
179185
updateChainParameters newChainParameters PersistentChainParameters{..} =
180186
fromChainParameters newChainParameters pcpExternalChainParameters
181187

182188
-- | Apply a max-lock-duration update to the Rust-managed external chain-parameters component.
183189
updateMaxLockDuration ::
184190
(MonadIO m) =>
185191
Duration ->
186-
PersistentChainParameters' cpv auv ->
187-
m (PersistentChainParameters' cpv auv)
192+
PersistentChainParameters' pv cpv auv ->
193+
m (PersistentChainParameters' pv cpv auv)
188194
updateMaxLockDuration duration params@PersistentChainParameters{pcpExternalChainParameters = CTrue external} = do
189195
liftIO $ ECP.applyMaxLockDurationUpdate external duration
190196
return params
191197
updateMaxLockDuration _ PersistentChainParameters{pcpExternalChainParameters = CFalse} =
192198
error "Max lock duration update requires external chain parameters"
193199

194200
-- | Serialize persistent chain parameters.
195-
putPersistentChainParameters :: forall cpv auv. (IsChainParametersVersion cpv) => S.Putter (PersistentChainParameters' cpv auv)
201+
putPersistentChainParameters :: forall pv cpv auv. (IsChainParametersVersion cpv) => S.Putter (PersistentChainParameters' pv cpv auv)
196202
putPersistentChainParameters PersistentChainParameters{..} = do
197203
withIsConsensusParametersVersionFor (chainParametersVersion @cpv) $ S.put pcpConsensusParameters
198204
S.put pcpExchangeRates
@@ -224,8 +230,8 @@ getPersistentChainParametersFields = do
224230
return ChainParameters{..}
225231

226232
instance
227-
(MonadBlobStore m, IsChainParametersVersion cpv, IsAuthorizationsVersion auv) =>
228-
BlobStorable m (PersistentChainParameters' cpv auv)
233+
(MonadBlobStore m, IsProtocolVersion pv, IsChainParametersVersion cpv, IsAuthorizationsVersion auv) =>
234+
BlobStorable m (PersistentChainParameters' pv cpv auv)
229235
where
230236
storeUpdate params@PersistentChainParameters{..} = do
231237
(pExternal :: S.Put, external') <- case pcpExternalChainParameters of
@@ -249,15 +255,15 @@ instance
249255

250256
instance
251257
(MonadBlobStore m) =>
252-
Cacheable m (PersistentChainParameters' cpv auv)
258+
Cacheable m (PersistentChainParameters' pv cpv auv)
253259
where
254260
cache params@PersistentChainParameters{..} = do
255261
external' <- traverse cache pcpExternalChainParameters
256262
return params{pcpExternalChainParameters = external'}
257263

258264
instance
259265
(MonadBlobStore m, IsChainParametersVersion cpv) =>
260-
MHashableTo m H.Hash (PersistentChainParameters' cpv auv)
266+
MHashableTo m H.Hash (PersistentChainParameters' pv cpv auv)
261267
where
262268
getHashM params@PersistentChainParameters{..} = do
263269
hExternal <- traverse (getHashM @_ @ECP.ExternalChainParametersHash) pcpExternalChainParameters

0 commit comments

Comments
 (0)