1
- {-# LANGUAGE EmptyCase #-}
2
1
{-# LANGUAGE FlexibleContexts #-}
3
2
{-# LANGUAGE GADTs #-}
4
3
{-# LANGUAGE RankNTypes #-}
5
- {-# LANGUAGE TemplateHaskell #-}
6
-
7
- {-# OPTIONS_GHC -Wno-deprecations #-} -- TODO Fix deprecations
8
4
9
5
module Test.Cardano.Api.Typed.CBOR
10
6
( tests
11
7
) where
12
8
13
- import Cardano.Prelude
14
-
15
- import Hedgehog (Property , forAll , property , success , tripping )
16
- import Test.Tasty (TestTree , testGroup )
17
- import Test.Tasty.Hedgehog (testProperty )
18
- import Test.Tasty.TH (testGroupGenerator )
19
-
20
9
import Cardano.Api
21
-
10
+ import Cardano.Prelude
11
+ import Data.String (IsString (.. ))
22
12
import Gen.Cardano.Api.Typed
23
13
import Gen.Hedgehog.Roundtrip.CBOR (roundtrip_CBOR )
14
+ import Hedgehog (Property , forAll , property , success , tripping )
24
15
import Test.Cardano.Api.Typed.Orphans ()
16
+ import Test.Tasty (TestTree , testGroup )
17
+ import Test.Tasty.Hedgehog (testPropertyNamed )
25
18
26
19
{- HLINT ignore "Use camelCase" -}
27
20
@@ -30,14 +23,14 @@ import Test.Cardano.Api.Typed.Orphans ()
30
23
31
24
test_roundtrip_txbody_CBOR :: [TestTree ]
32
25
test_roundtrip_txbody_CBOR =
33
- [ testProperty (show era) $
26
+ [ testPropertyNamed (show era) (fromString ( show era) ) $
34
27
roundtrip_CBOR (proxyToAsType Proxy ) (genTxBody era)
35
28
| AnyCardanoEra era <- [minBound .. (AnyCardanoEra AlonzoEra )] -- TODO: Babbage era
36
29
]
37
30
38
31
test_roundtrip_tx_CBOR :: [TestTree ]
39
32
test_roundtrip_tx_CBOR =
40
- [ testProperty (show era) $ roundtrip_CBOR (proxyToAsType Proxy ) (genTx era)
33
+ [ testPropertyNamed (show era) (fromString ( show era) ) $ roundtrip_CBOR (proxyToAsType Proxy ) (genTx era)
41
34
| AnyCardanoEra era <- [minBound .. (AnyCardanoEra AlonzoEra )] -- TODO: Babbage era
42
35
]
43
36
@@ -160,13 +153,13 @@ prop_roundtrip_UpdateProposal_CBOR =
160
153
161
154
test_roundtrip_Tx_Cddl :: [TestTree ]
162
155
test_roundtrip_Tx_Cddl =
163
- [ testProperty (show era) $ roundtrip_Tx_Cddl anyEra
156
+ [ testPropertyNamed (show era) (fromString ( show era) ) $ roundtrip_Tx_Cddl anyEra
164
157
| anyEra@ (AnyCardanoEra era) <- [minBound .. (AnyCardanoEra AlonzoEra )] -- TODO: Babbage era
165
158
]
166
159
167
160
test_roundtrip_TxWitness_Cddl :: [TestTree ]
168
161
test_roundtrip_TxWitness_Cddl =
169
- [ testProperty (show era) $ roundtrip_TxWitness_Cddl era
162
+ [ testPropertyNamed (show era) (fromString ( show era) ) $ roundtrip_TxWitness_Cddl era
170
163
| AnyCardanoEra era <- [minBound .. (AnyCardanoEra AlonzoEra )] -- TODO: Babbage era
171
164
, AnyCardanoEra era /= AnyCardanoEra ByronEra
172
165
]
@@ -193,4 +186,37 @@ roundtrip_Tx_Cddl (AnyCardanoEra era) =
193
186
-- -----------------------------------------------------------------------------
194
187
195
188
tests :: TestTree
196
- tests = $ testGroupGenerator
189
+ tests = testGroup " Test.Cardano.Api.Typed.CBOR"
190
+ [ testPropertyNamed " roundtrip witness byron CBOR" " roundtrip witness byron CBOR" prop_roundtrip_witness_byron_CBOR
191
+ , testPropertyNamed " roundtrip witness shelley CBOR" " roundtrip witness shelley CBOR" prop_roundtrip_witness_shelley_CBOR
192
+ , testPropertyNamed " roundtrip witness allegra CBOR" " roundtrip witness allegra CBOR" prop_roundtrip_witness_allegra_CBOR
193
+ , testPropertyNamed " roundtrip witness mary CBOR" " roundtrip witness mary CBOR" prop_roundtrip_witness_mary_CBOR
194
+ , testPropertyNamed " roundtrip witness alonzo CBOR" " roundtrip witness alonzo CBOR" prop_roundtrip_witness_alonzo_CBOR
195
+ , testPropertyNamed " roundtrip operational certificate CBOR" " roundtrip operational certificate CBOR" prop_roundtrip_operational_certificate_CBOR
196
+ , testPropertyNamed " roundtrip operational certificate issue counter CBOR" " roundtrip operational certificate issue counter CBOR" prop_roundtrip_operational_certificate_issue_counter_CBOR
197
+ , testPropertyNamed " roundtrip verification key byron CBOR" " roundtrip verification key byron CBOR" prop_roundtrip_verification_key_byron_CBOR
198
+ , testPropertyNamed " roundtrip signing key byron CBOR" " roundtrip signing key byron CBOR" prop_roundtrip_signing_key_byron_CBOR
199
+ , testPropertyNamed " roundtrip verification key payment CBOR" " roundtrip verification key payment CBOR" prop_roundtrip_verification_key_payment_CBOR
200
+ , testPropertyNamed " roundtrip signing key payment CBOR" " roundtrip signing key payment CBOR" prop_roundtrip_signing_key_payment_CBOR
201
+ , testPropertyNamed " roundtrip verification key stake CBOR" " roundtrip verification key stake CBOR" prop_roundtrip_verification_key_stake_CBOR
202
+ , testPropertyNamed " roundtrip signing key stake CBOR" " roundtrip signing key stake CBOR" prop_roundtrip_signing_key_stake_CBOR
203
+ , testPropertyNamed " roundtrip verification key genesis CBOR" " roundtrip verification key genesis CBOR" prop_roundtrip_verification_key_genesis_CBOR
204
+ , testPropertyNamed " roundtrip signing key genesis CBOR" " roundtrip signing key genesis CBOR" prop_roundtrip_signing_key_genesis_CBOR
205
+ , testPropertyNamed " roundtrip verification key genesis delegate CBOR" " roundtrip verification key genesis delegate CBOR" prop_roundtrip_verification_key_genesis_delegate_CBOR
206
+ , testPropertyNamed " roundtrip signing key genesis delegate CBOR" " roundtrip signing key genesis delegate CBOR" prop_roundtrip_signing_key_genesis_delegate_CBOR
207
+ , testPropertyNamed " roundtrip verification key stake pool CBOR" " roundtrip verification key stake pool CBOR" prop_roundtrip_verification_key_stake_pool_CBOR
208
+ , testPropertyNamed " roundtrip signing key stake pool CBOR" " roundtrip signing key stake pool CBOR" prop_roundtrip_signing_key_stake_pool_CBOR
209
+ , testPropertyNamed " roundtrip verification key vrf CBOR" " roundtrip verification key vrf CBOR" prop_roundtrip_verification_key_vrf_CBOR
210
+ , testPropertyNamed " roundtrip signing key vrf CBOR" " roundtrip signing key vrf CBOR" prop_roundtrip_signing_key_vrf_CBOR
211
+ , testPropertyNamed " roundtrip verification key kes CBOR" " roundtrip verification key kes CBOR" prop_roundtrip_verification_key_kes_CBOR
212
+ , testPropertyNamed " roundtrip signing key kes CBOR" " roundtrip signing key kes CBOR" prop_roundtrip_signing_key_kes_CBOR
213
+ , testPropertyNamed " roundtrip script SimpleScriptV1 CBOR" " roundtrip script SimpleScriptV1 CBOR" prop_roundtrip_script_SimpleScriptV1_CBOR
214
+ , testPropertyNamed " roundtrip script SimpleScriptV2 CBOR" " roundtrip script SimpleScriptV2 CBOR" prop_roundtrip_script_SimpleScriptV2_CBOR
215
+ , testPropertyNamed " roundtrip script PlutusScriptV1 CBOR" " roundtrip script PlutusScriptV1 CBOR" prop_roundtrip_script_PlutusScriptV1_CBOR
216
+ , testPropertyNamed " roundtrip script PlutusScriptV2 CBOR" " roundtrip script PlutusScriptV2 CBOR" prop_roundtrip_script_PlutusScriptV2_CBOR
217
+ , testPropertyNamed " roundtrip UpdateProposal CBOR" " roundtrip UpdateProposal CBOR" prop_roundtrip_UpdateProposal_CBOR
218
+ , testGroup " roundtrip txbody CBOR" test_roundtrip_txbody_CBOR
219
+ , testGroup " roundtrip tx CBOR" test_roundtrip_tx_CBOR
220
+ , testGroup " roundtrip Tx Cddl" test_roundtrip_Tx_Cddl
221
+ , testGroup " roundtrip TxWitness Cddl" test_roundtrip_TxWitness_Cddl
222
+ ]
0 commit comments