Skip to content

Commit bf2d5f7

Browse files
aniketdlehins
aniketd
and
lehins
committed
CDDL: Typeclass-based Huddle: core/shelley/allegra
* Add new sub-libraries named `cddl`. * 3 typeclasses: HuddleRule, HuddleGroup and HuddleGRule * Proxy parameters are used to specify the era. * Polymorphic smart-constructors for all reusable huddle-specs Co-Authored-By: Alexey Kuleshevich <alexey.kuleshevich@iohk.io>
1 parent 2e373d8 commit bf2d5f7

File tree

15 files changed

+1326
-2
lines changed

15 files changed

+1326
-2
lines changed

‎eras/allegra/impl/CHANGELOG.md‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
## 1.9.0.0
44

5+
* Add `cddl` sub-library.
56
* Remove deprecated type `Allegra`
67
* Remove deprecated type `TimelockConstr`
78
* Add `invalidBeforeL`, `invalidHereAfterL`
@@ -11,6 +12,12 @@
1112
* Add `EraTxLevel` instance
1213
* Remove deprecated `timelockScriptsTxAuxDataL`
1314

15+
### `cddl`
16+
17+
* Add `HuddleSpec` module with `Huddle{Rule|Group}` instances for all types.
18+
* Add smart constructors `mkBlock` and `mkTransaction`.
19+
* Add `generate-cddl` executable target to test the generation of `.cddl` files against the existing `huddle-cddl` executable.
20+
1421
### `testlib`
1522

1623
* Add CDDL definitions for int64 types: `int64`, `min_int64`, `max_int64`, `negative_int64`, `positive_int64`, `nonzero_int64`

‎eras/allegra/impl/cardano-ledger-allegra.cabal‎

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,50 @@ library
8484
transformers,
8585
validation-selective,
8686

87+
library cddl
88+
exposed-modules:
89+
Cardano.Ledger.Allegra.HuddleSpec
90+
91+
visibility: public
92+
hs-source-dirs: cddl/lib
93+
default-language: Haskell2010
94+
ghc-options:
95+
-Wall
96+
-Wcompat
97+
-Wincomplete-record-updates
98+
-Wincomplete-uni-patterns
99+
-Wredundant-constraints
100+
-Wpartial-fields
101+
-Wunused-packages
102+
103+
build-depends:
104+
base,
105+
cardano-ledger-allegra,
106+
cardano-ledger-shelley:cddl,
107+
cuddle >=0.4,
108+
heredoc,
109+
110+
executable generate-cddl
111+
main-is: Main.hs
112+
hs-source-dirs: cddl/exe
113+
other-modules: Paths_cardano_ledger_allegra
114+
default-language: Haskell2010
115+
ghc-options:
116+
-Wall
117+
-Wcompat
118+
-Wincomplete-record-updates
119+
-Wincomplete-uni-patterns
120+
-Wredundant-constraints
121+
-Wpartial-fields
122+
-Wunused-packages
123+
124+
build-depends:
125+
base,
126+
cardano-ledger-binary:testlib >=1.4,
127+
cddl,
128+
directory,
129+
filepath,
130+
87131
library testlib
88132
exposed-modules:
89133
Test.Cardano.Ledger.Allegra.Arbitrary

‎eras/allegra/impl/cddl-files/allegra.cddl‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -166,6 +166,7 @@ pool_keyhash = hash28
166166

167167
pool_registration_cert = (3, pool_params)
168168

169+
; Pool parameters for stake pool registration
169170
pool_params =
170171
( operator : pool_keyhash
171172
, vrf_keyhash : vrf_keyhash
@@ -292,8 +293,6 @@ transaction_witness_set =
292293
vkeywitness = [vkey, signature]
293294

294295
; Allegra introduces timelock support for native scripts.
295-
; This is the 6-variant native script format used by
296-
; Allegra, Mary, Alonzo, Babbage, and Conway.
297296
;
298297
; Timelock validity intervals are half-open intervals [a, b).
299298
; script_invalid_before: specifies the left (included) endpoint a.

‎eras/allegra/impl/cddl/exe/Main.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
module Main where
2+
3+
import Cardano.Ledger.Allegra.HuddleSpec (allegraCDDL)
4+
import Paths_cardano_ledger_allegra (getDataFileName)
5+
import System.Directory (createDirectoryIfMissing)
6+
import System.FilePath (takeDirectory)
7+
import Test.Cardano.Ledger.Binary.Cuddle (writeSpec)
8+
9+
main :: IO ()
10+
main = do
11+
outputPath <- getDataFileName "cddl-files/allegra.cddl"
12+
createDirectoryIfMissing True (takeDirectory outputPath)
13+
writeSpec allegraCDDL outputPath
14+
putStrLn $ "Generated CDDL file at: " ++ outputPath

‎eras/allegra/impl/cddl/lib/Cardano/Ledger/Allegra/HuddleSpec.hs‎

Lines changed: 280 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,280 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE FlexibleInstances #-}
5+
{-# LANGUAGE MultiParamTypeClasses #-}
6+
{-# LANGUAGE OverloadedLists #-}
7+
{-# LANGUAGE OverloadedStrings #-}
8+
{-# LANGUAGE QuasiQuotes #-}
9+
{-# LANGUAGE ScopedTypeVariables #-}
10+
{-# LANGUAGE TypeApplications #-}
11+
{-# OPTIONS_GHC -Wno-orphans #-}
12+
13+
module Cardano.Ledger.Allegra.HuddleSpec (
14+
allegraCDDL,
15+
blockRule,
16+
transactionRule,
17+
) where
18+
19+
import Cardano.Ledger.Allegra (AllegraEra)
20+
import Cardano.Ledger.Shelley.HuddleSpec
21+
import Codec.CBOR.Cuddle.Huddle
22+
import Data.Proxy (Proxy (..))
23+
import Text.Heredoc
24+
import Prelude hiding ((/))
25+
26+
allegraCDDL :: Huddle
27+
allegraCDDL =
28+
collectFrom
29+
[ HIRule $ huddleRule @"block" (Proxy @AllegraEra)
30+
, HIRule $ huddleRule @"transaction" (Proxy @AllegraEra)
31+
]
32+
33+
blockRule ::
34+
forall era.
35+
( HuddleRule "header" era
36+
, HuddleRule "transaction_body" era
37+
, HuddleRule "transaction_witness_set" era
38+
, HuddleRule "auxiliary_data" era
39+
) =>
40+
Proxy era ->
41+
Rule
42+
blockRule p =
43+
"block"
44+
=:= arr
45+
[ a $ huddleRule @"header" p
46+
, "transaction_bodies" ==> arr [0 <+ a (huddleRule @"transaction_body" p)]
47+
, "transaction_witness_sets" ==> arr [0 <+ a (huddleRule @"transaction_witness_set" p)]
48+
, "auxiliary_data_set"
49+
==> mp
50+
[ 0
51+
<+ asKey (huddleRule @"transaction_index" p)
52+
==> huddleRule @"auxiliary_data" p
53+
]
54+
]
55+
56+
transactionRule ::
57+
forall era.
58+
( HuddleRule "transaction_body" era
59+
, HuddleRule "transaction_witness_set" era
60+
, HuddleRule "auxiliary_data" era
61+
) =>
62+
Proxy era ->
63+
Rule
64+
transactionRule p =
65+
"transaction"
66+
=:= arr
67+
[ a $ huddleRule @"transaction_body" p
68+
, a $ huddleRule @"transaction_witness_set" p
69+
, a (huddleRule @"auxiliary_data" p / VNil)
70+
]
71+
72+
instance HuddleRule "major_protocol_version" AllegraEra where
73+
huddleRule = majorProtocolVersionRule @AllegraEra
74+
75+
instance HuddleGroup "protocol_version" AllegraEra where
76+
huddleGroup = protocolVersionGroup @AllegraEra
77+
78+
instance HuddleRule "protocol_param_update" AllegraEra where
79+
huddleRule = protocolParamUpdateRule @AllegraEra
80+
81+
instance HuddleRule "proposed_protocol_parameter_updates" AllegraEra where
82+
huddleRule = proposedProtocolParameterUpdatesRule @AllegraEra
83+
84+
instance HuddleRule "update" AllegraEra where
85+
huddleRule = updateRule @AllegraEra
86+
87+
instance HuddleRule "genesis_hash" AllegraEra where
88+
huddleRule = genesisHashRule @AllegraEra
89+
90+
instance HuddleGroup "operational_cert" AllegraEra where
91+
huddleGroup = operationalCertGroup @AllegraEra
92+
93+
instance HuddleRule "header_body" AllegraEra where
94+
huddleRule = headerBodyRule @AllegraEra
95+
96+
instance HuddleRule "header" AllegraEra where
97+
huddleRule = headerRule @AllegraEra
98+
99+
instance HuddleRule "min_int64" AllegraEra where
100+
huddleRule _ = "min_int64" =:= (-9223372036854775808 :: Integer)
101+
102+
instance HuddleRule "max_int64" AllegraEra where
103+
huddleRule _ = "max_int64" =:= (9223372036854775807 :: Integer)
104+
105+
instance HuddleRule "int64" AllegraEra where
106+
huddleRule p = "int64" =:= huddleRule @"min_int64" p ... huddleRule @"max_int64" p
107+
108+
instance HuddleGroup "script_all" AllegraEra where
109+
huddleGroup p = "script_all" =:~ grp [1, a $ arr [0 <+ a (huddleRule @"native_script" p)]]
110+
111+
instance HuddleGroup "script_any" AllegraEra where
112+
huddleGroup p = "script_any" =:~ grp [2, a $ arr [0 <+ a (huddleRule @"native_script" p)]]
113+
114+
instance HuddleGroup "script_n_of_k" AllegraEra where
115+
huddleGroup p =
116+
"script_n_of_k"
117+
=:~ grp
118+
[ 3
119+
, "n" ==> huddleRule @"int64" p
120+
, a $ arr [0 <+ a (huddleRule @"native_script" p)]
121+
]
122+
123+
instance HuddleGroup "script_invalid_before" AllegraEra where
124+
huddleGroup p =
125+
comment
126+
[str|Timelock validity intervals are half-open intervals [a, b).
127+
|This field specifies the left (included) endpoint a.
128+
|]
129+
$ "script_invalid_before"
130+
=:~ grp [4, a (huddleRule @"slot" p)]
131+
132+
instance HuddleGroup "script_invalid_hereafter" AllegraEra where
133+
huddleGroup p =
134+
comment
135+
[str|Timelock validity intervals are half-open intervals [a, b).
136+
|This field specifies the right (excluded) endpoint b.
137+
|]
138+
$ "script_invalid_hereafter"
139+
=:~ grp [5, a (huddleRule @"slot" p)]
140+
141+
instance HuddleRule "native_script" AllegraEra where
142+
huddleRule p =
143+
comment
144+
[str|Allegra introduces timelock support for native scripts.
145+
|
146+
|Timelock validity intervals are half-open intervals [a, b).
147+
| script_invalid_before: specifies the left (included) endpoint a.
148+
| script_invalid_hereafter: specifies the right (excluded) endpoint b.
149+
|
150+
|Note: Allegra switched to int64 for script_n_of_k thresholds.
151+
|]
152+
$ "native_script"
153+
=:= arr [a $ huddleGroup @"script_pubkey" p]
154+
/ arr [a $ huddleGroup @"script_all" p]
155+
/ arr [a $ huddleGroup @"script_any" p]
156+
/ arr [a $ huddleGroup @"script_n_of_k" p]
157+
/ arr [a $ huddleGroup @"script_invalid_before" p]
158+
/ arr [a $ huddleGroup @"script_invalid_hereafter" p]
159+
160+
instance HuddleRule "vkeywitness" AllegraEra where
161+
huddleRule = vkeywitnessRule @AllegraEra
162+
163+
instance HuddleRule "bootstrap_witness" AllegraEra where
164+
huddleRule = bootstrapWitnessRule @AllegraEra
165+
166+
instance HuddleRule "transaction_witness_set" AllegraEra where
167+
huddleRule = transactionWitnessSetRule @AllegraEra
168+
169+
instance HuddleGroup "script_pubkey" AllegraEra where
170+
huddleGroup = scriptPubkeyGroup @AllegraEra
171+
172+
instance HuddleRule "transaction_id" AllegraEra where
173+
huddleRule = transactionIdRule @AllegraEra
174+
175+
instance HuddleRule "transaction_input" AllegraEra where
176+
huddleRule = transactionInputRule @AllegraEra
177+
178+
instance HuddleRule "transaction_output" AllegraEra where
179+
huddleRule = transactionOutputRule @AllegraEra
180+
181+
instance HuddleRule "dns_name" AllegraEra where
182+
huddleRule _ = dnsNameRule
183+
184+
instance HuddleRule "url" AllegraEra where
185+
huddleRule _ = urlRule
186+
187+
instance HuddleRule "pool_metadata" AllegraEra where
188+
huddleRule = poolMetadataRule @AllegraEra
189+
190+
instance HuddleGroup "single_host_addr" AllegraEra where
191+
huddleGroup = singleHostAddrGroup @AllegraEra
192+
193+
instance HuddleGroup "single_host_name" AllegraEra where
194+
huddleGroup = singleHostNameGroup @AllegraEra
195+
196+
instance HuddleGroup "multi_host_name" AllegraEra where
197+
huddleGroup = multiHostNameGroup @AllegraEra
198+
199+
instance HuddleRule "relay" AllegraEra where
200+
huddleRule = relayRule @AllegraEra
201+
202+
instance HuddleGroup "pool_params" AllegraEra where
203+
huddleGroup = poolParamsGroup @AllegraEra
204+
205+
instance HuddleGroup "pool_registration_cert" AllegraEra where
206+
huddleGroup = poolRegistrationCertGroup @AllegraEra
207+
208+
instance HuddleGroup "pool_retirement_cert" AllegraEra where
209+
huddleGroup = poolRetirementCertGroup @AllegraEra
210+
211+
instance HuddleRule "genesis_delegate_hash" AllegraEra where
212+
huddleRule = genesisDelegateHashRule @AllegraEra
213+
214+
instance HuddleGroup "genesis_delegation_cert" AllegraEra where
215+
huddleGroup = genesisDelegationCertGroup @AllegraEra
216+
217+
instance HuddleRule "delta_coin" AllegraEra where
218+
huddleRule _ = deltaCoinRule
219+
220+
instance HuddleRule "move_instantaneous_reward" AllegraEra where
221+
huddleRule = moveInstantaneousRewardRule @AllegraEra
222+
223+
instance HuddleGroup "move_instantaneous_rewards_cert" AllegraEra where
224+
huddleGroup = moveInstantaneousRewardsCertGroup @AllegraEra
225+
226+
instance HuddleGroup "account_registration_cert" AllegraEra where
227+
huddleGroup = accountRegistrationCertGroup @AllegraEra
228+
229+
instance HuddleGroup "account_unregistration_cert" AllegraEra where
230+
huddleGroup = accountUnregistrationCertGroup @AllegraEra
231+
232+
instance HuddleGroup "delegation_to_stake_pool_cert" AllegraEra where
233+
huddleGroup = delegationToStakePoolCertGroup @AllegraEra
234+
235+
instance HuddleRule "certificate" AllegraEra where
236+
huddleRule = certificateRule @AllegraEra
237+
238+
instance HuddleRule "withdrawals" AllegraEra where
239+
huddleRule = withdrawalsRule @AllegraEra
240+
241+
instance HuddleRule "auxiliary_scripts" AllegraEra where
242+
huddleRule p = "auxiliary_scripts" =:= arr [0 <+ a (huddleRule @"native_script" p)]
243+
244+
instance HuddleRule "auxiliary_data_array" AllegraEra where
245+
huddleRule p =
246+
"auxiliary_data_array"
247+
=:= arr
248+
[ "transaction_metadata" ==> huddleRule @"metadata" p
249+
, "auxiliary_scripts" ==> huddleRule @"auxiliary_scripts" p
250+
]
251+
252+
instance HuddleRule "auxiliary_data" AllegraEra where
253+
huddleRule p =
254+
"auxiliary_data"
255+
=:= huddleRule @"metadata" p
256+
/ huddleRule @"auxiliary_data_array" p
257+
258+
instance HuddleRule "transaction_body" AllegraEra where
259+
huddleRule p =
260+
comment
261+
[str|Allegra transaction body adds the validity interval start at index 8
262+
|]
263+
$ "transaction_body"
264+
=:= mp
265+
[ idx 0 ==> untaggedSet (huddleRule @"transaction_input" p)
266+
, idx 1 ==> arr [0 <+ a (huddleRule @"transaction_output" p)]
267+
, idx 2 ==> huddleRule @"coin" p
268+
, opt (idx 3 ==> huddleRule @"slot" p)
269+
, opt (idx 4 ==> arr [0 <+ a (huddleRule @"certificate" p)])
270+
, opt (idx 5 ==> huddleRule @"withdrawals" p)
271+
, opt (idx 6 ==> huddleRule @"update" p)
272+
, opt (idx 7 ==> huddleRule @"auxiliary_data_hash" p)
273+
, opt (idx 8 ==> huddleRule @"slot" p)
274+
]
275+
276+
instance HuddleRule "transaction" AllegraEra where
277+
huddleRule = transactionRule @AllegraEra
278+
279+
instance HuddleRule "block" AllegraEra where
280+
huddleRule = blockRule @AllegraEra

0 commit comments

Comments
 (0)