Skip to content

Commit 4741b1d

Browse files
Jimbo4350Jimbo4350
committed
Fix type errors
1 parent 1ec35bc commit 4741b1d

File tree

22 files changed

+159
-237
lines changed

22 files changed

+159
-237
lines changed

‎cabal.project‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,8 +33,8 @@ constraints: process >= 1.6.26.1
3333
-- with solving constraints. Remove this when not needed anymore.
3434
max-backjumps: 50000
3535

36-
-- program-options
37-
-- ghc-options: -Werror
36+
program-options
37+
ghc-options: -Werror
3838

3939
package crypton
4040
-- Using RDRAND instead of /dev/urandom as an entropy source for key

‎cardano-api/cardano-api.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -318,8 +318,10 @@ library gen
318318
bytestring,
319319
cardano-api,
320320
cardano-binary >=1.6 && <1.8,
321+
cardano-ledger-byron,
321322
cardano-crypto-class ^>=2.2.1,
322323
cardano-crypto-test ^>=1.6,
324+
cardano-crypto-wrapper,
323325
cardano-ledger-alonzo >=1.8.1,
324326
cardano-ledger-babbage,
325327
cardano-ledger-conway,

‎cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs‎

Lines changed: 55 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE EmptyCase #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE GADTs #-}
45
{-# LANGUAGE NamedFieldPuns #-}
@@ -161,9 +162,14 @@ import Cardano.Api.Parser.Text qualified as P
161162
import Cardano.Api.Tx qualified as A
162163

163164
import Cardano.Binary qualified as CBOR
165+
import Cardano.Chain.UTxO qualified as Byron
166+
import Cardano.Crypto.DSIGN.Class qualified as Crypto
164167
import Cardano.Crypto.Hash qualified as Crypto
165168
import Cardano.Crypto.Hash.Class qualified as CRYPTO
169+
import Cardano.Crypto.Hashing qualified as ByronCrypto
170+
import Cardano.Crypto.ProtocolMagic qualified as Byron
166171
import Cardano.Crypto.Seed qualified as Crypto
172+
import Cardano.Crypto.Signing qualified as Crypto
167173
import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
168174
import Cardano.Ledger.BaseTypes qualified as Ledger
169175
import Cardano.Ledger.Core qualified as Ledger
@@ -181,6 +187,7 @@ import Data.Int (Int64)
181187
import Data.Maybe
182188
import Data.Ratio (Ratio, (%))
183189
import Data.String
190+
import Data.Text (Text)
184191
import Data.Typeable
185192
import Data.Word (Word16, Word32, Word64)
186193
import GHC.Exts (IsList (..))
@@ -192,7 +199,6 @@ import Test.Gen.Cardano.Api.Hardcoded
192199
import Test.Gen.Cardano.Api.Metadata (genTxMetadata)
193200
import Test.Gen.Cardano.Api.Orphans (obtainArbitraryConstraints)
194201

195-
import Test.Cardano.Chain.UTxO.Gen (genVKWitness)
196202
import Test.Cardano.Crypto.Gen (genProtocolMagicId)
197203

198204
import Hedgehog (Gen, MonadGen, Range)
@@ -216,9 +222,6 @@ genAddressShelley =
216222
genAddressInEra :: ShelleyBasedEra era -> Gen (AddressInEra era)
217223
genAddressInEra sbe = shelleyAddressInEra sbe <$> genAddressShelley
218224

219-
_genAddressInEraByron :: Gen (AddressInEra era)
220-
_genAddressInEraByron = byronAddressInEra <$> genAddressByron
221-
222225
genKESPeriod :: Gen KESPeriod
223226
genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded
224227

@@ -1185,6 +1188,47 @@ genVerificationKeyHash
11851188
genVerificationKeyHash roletoken =
11861189
verificationKeyHash <$> genVerificationKey roletoken
11871190

1191+
genVKWitness :: Byron.ProtocolMagicId -> Gen Byron.TxInWitness
1192+
genVKWitness pm = Byron.VKWitness <$> genByronVerificationKey <*> genTxSig pm
1193+
1194+
genTxSig :: Byron.ProtocolMagicId -> Gen Byron.TxSig
1195+
genTxSig pm = Crypto.sign pm <$> genSignTag <*> genByronSigningKey <*> genTxSigData
1196+
1197+
genTxSigData :: Gen Byron.TxSigData
1198+
genTxSigData = Byron.TxSigData <$> genTxHash
1199+
1200+
genTxHash :: Gen (ByronCrypto.Hash Byron.Tx)
1201+
genTxHash = coerce <$> genTextHash
1202+
1203+
genTextHash :: Gen (ByronCrypto.Hash Text)
1204+
genTextHash = ByronCrypto.serializeCborHash <$> Gen.text (Range.linear 0 10) Gen.alphaNum
1205+
1206+
genSignTag :: Gen Crypto.SignTag
1207+
genSignTag =
1208+
Gen.choice
1209+
[ pure Crypto.SignForTestingOnly
1210+
, pure Crypto.SignTx
1211+
, pure Crypto.SignRedeemTx
1212+
, pure Crypto.SignVssCert
1213+
, pure Crypto.SignUSProposal
1214+
, pure Crypto.SignCommitment
1215+
, pure Crypto.SignUSVote
1216+
, Crypto.SignBlock <$> genByronVerificationKey
1217+
, pure Crypto.SignCertificate
1218+
]
1219+
1220+
genByronVerificationKey :: Gen Crypto.VerificationKey
1221+
genByronVerificationKey = fst <$> genKeypair
1222+
1223+
genByronSigningKey :: Gen Crypto.SigningKey
1224+
genByronSigningKey = snd <$> genKeypair
1225+
1226+
genKeypair :: Gen (Crypto.VerificationKey, Crypto.SigningKey)
1227+
genKeypair = Crypto.deterministicKeyGen <$> gen32Bytes
1228+
1229+
gen32Bytes :: Gen ByteString
1230+
gen32Bytes = Gen.bytes (Range.singleton 32)
1231+
11881232
genByronKeyWitness :: Gen (KeyWitness ByronEra)
11891233
genByronKeyWitness = do
11901234
pmId <- genProtocolMagicId
@@ -1599,12 +1643,18 @@ genAnyPlutusScriptVersion = do
15991643

16001644
plutusScriptLangaugeInEra
16011645
:: Exp.Era era -> PlutusScriptVersion lang -> ScriptLanguageInEra lang era
1646+
plutusScriptLangaugeInEra Exp.DijkstraEra l =
1647+
case l of
1648+
PlutusScriptV1 -> PlutusScriptV1InDijkstra
1649+
PlutusScriptV2 -> PlutusScriptV2InDijkstra
1650+
PlutusScriptV3 -> PlutusScriptV3InDijkstra
1651+
PlutusScriptV4 -> PlutusScriptV4InDijkstra
16021652
plutusScriptLangaugeInEra Exp.ConwayEra l =
16031653
case l of
16041654
PlutusScriptV1 -> PlutusScriptV1InConway
16051655
PlutusScriptV2 -> PlutusScriptV2InConway
16061656
PlutusScriptV3 -> PlutusScriptV3InConway
1607-
PlutusScriptV4 -> error "plutusScriptLangaugeInEra: PlutusScriptV4 not supported yet"
1657+
PlutusScriptV4 -> case undefined :: ScriptLanguageInEra PlutusScriptV4 ConwayEra of {}
16081658

16091659
genApiPlutusScriptWitness
16101660
:: WitCtx witctx -> Exp.Era era -> Gen (Api.ScriptWitness witctx era)

‎cardano-api/src/Cardano/Api/Certificate/Internal.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -236,7 +236,7 @@ certificateToTxCert c =
236236
ConwayCertificate eon cert ->
237237
case eon of
238238
ConwayEraOnwardsConway -> cert
239-
ConwayEraOnwardsDijkstra -> cert
239+
ConwayEraOnwardsDijkstra -> error "certificateToTxCert: Dijkstra era is not yet supported"
240240

241241
-- ----------------------------------------------------------------------------
242242
-- Stake pool parameters

‎cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,7 @@ where
2222

2323
import Cardano.Api.Consensus.Internal.Mode
2424

25-
import qualified Control.Tracer as Tracer
26-
import Ouroboros.Consensus.Block.Forging (BlockForging)
25+
import Ouroboros.Consensus.Block.Forging (MkBlockForging (..))
2726
import Ouroboros.Consensus.Byron.ByronHFC (ByronBlockHFC)
2827
import Ouroboros.Consensus.Cardano
2928
import Ouroboros.Consensus.Cardano.Block
@@ -40,6 +39,7 @@ import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
4039
import Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC)
4140
import Ouroboros.Consensus.Util.IOLike (IOLike)
4241

42+
import Control.Tracer qualified as Tracer
4343
import Data.Bifunctor (bimap)
4444

4545
import Type.Reflection ((:~:) (..))
@@ -49,7 +49,7 @@ class (RunNode blk, IOLike m) => Protocol m blk where
4949
protocolInfo
5050
:: ProtocolInfoArgs blk
5151
-> ( ProtocolInfo blk
52-
, Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m blk]
52+
, Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m blk]
5353
)
5454

5555
-- | Node client support for each consensus protocol.
@@ -65,10 +65,13 @@ instance IOLike m => Protocol m ByronBlockHFC where
6565
data ProtocolInfoArgs ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron
6666
protocolInfo (ProtocolInfoArgsByron params) =
6767
( inject $ protocolInfoByron params
68-
, \_ -> pure . map inject $ blockForgingByron params
68+
, \_ -> pure . map (MkBlockForging . pure . inject) $ blockForgingByron params
6969
)
7070

71-
instance (CardanoHardForkConstraints StandardCrypto, IOLike m, MonadKESAgent m) => Protocol m (CardanoBlock StandardCrypto) where
71+
instance
72+
(CardanoHardForkConstraints StandardCrypto, IOLike m, MonadKESAgent m)
73+
=> Protocol m (CardanoBlock StandardCrypto)
74+
where
7275
data ProtocolInfoArgs (CardanoBlock StandardCrypto)
7376
= ProtocolInfoArgsCardano
7477
(CardanoProtocolParams StandardCrypto)

‎cardano-api/src/Cardano/Api/Era/Internal/Case.hs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ caseByronOrShelleyBasedEra l r = \case
5252
AlonzoEra -> r ShelleyBasedEraAlonzo
5353
BabbageEra -> r ShelleyBasedEraBabbage
5454
ConwayEra -> r ShelleyBasedEraConway
55-
DijkstraEra -> r ShelleyBasedEraDijkstra
55+
DijkstraEra -> error "caseByronOrShelleyBasedEra: DijkstraEra is not supported"
5656

5757
-- | @caseByronToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to byron, shelley, allegra, mary, and alonzo;
5858
-- and @g@ to babbage and later eras.
@@ -70,7 +70,7 @@ caseByronToAlonzoOrBabbageEraOnwards l r = \case
7070
AlonzoEra -> l ByronToAlonzoEraAlonzo
7171
BabbageEra -> r BabbageEraOnwardsBabbage
7272
ConwayEra -> r BabbageEraOnwardsConway
73-
DijkstraEra -> r BabbageEraOnwardsDijkstra
73+
DijkstraEra -> error "caseByronToAlonzoOrBabbageEraOnwards: DijkstraEra is not supported"
7474

7575
-- | @caseShelleyEraOnlyOrAllegraEraOnwards f g era@ applies @f@ to shelley;
7676
-- and applies @g@ to allegra and later eras.
@@ -87,7 +87,7 @@ caseShelleyEraOnlyOrAllegraEraOnwards l r = \case
8787
ShelleyBasedEraAlonzo -> r AllegraEraOnwardsAlonzo
8888
ShelleyBasedEraBabbage -> r AllegraEraOnwardsBabbage
8989
ShelleyBasedEraConway -> r AllegraEraOnwardsConway
90-
ShelleyBasedEraDijkstra -> r AllegraEraOnwardsDijkstra
90+
ShelleyBasedEraDijkstra -> error "caseShelleyEraOnlyOrAllegraEraOnwards: DijkstraEra is not supported"
9191

9292
-- | @caseShelleyToAllegraOrMaryEraOnwards f g era@ applies @f@ to shelley and allegra;
9393
-- and applies @g@ to mary and later eras.
@@ -104,7 +104,7 @@ caseShelleyToAllegraOrMaryEraOnwards l r = \case
104104
ShelleyBasedEraAlonzo -> r MaryEraOnwardsAlonzo
105105
ShelleyBasedEraBabbage -> r MaryEraOnwardsBabbage
106106
ShelleyBasedEraConway -> r MaryEraOnwardsConway
107-
ShelleyBasedEraDijkstra -> r MaryEraOnwardsDijkstra
107+
ShelleyBasedEraDijkstra -> error "caseShelleyToAllegraOrMaryEraOnwards: DijkstraEra is not supported"
108108

109109
-- | @caseShelleyToMaryOrAlonzoEraOnwards f g era@ applies @f@ to shelley, allegra, and mary;
110110
-- and applies @g@ to alonzo and later eras.
@@ -121,7 +121,7 @@ caseShelleyToMaryOrAlonzoEraOnwards l r = \case
121121
ShelleyBasedEraAlonzo -> r AlonzoEraOnwardsAlonzo
122122
ShelleyBasedEraBabbage -> r AlonzoEraOnwardsBabbage
123123
ShelleyBasedEraConway -> r AlonzoEraOnwardsConway
124-
ShelleyBasedEraDijkstra -> r AlonzoEraOnwardsDijkstra
124+
ShelleyBasedEraDijkstra -> error "caseShelleyToMaryOrAlonzoEraOnwards: DijkstraEra is not supported"
125125

126126
-- | @caseShelleyToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to shelley, allegra, mary, and alonzo;
127127
-- and applies @g@ to babbage and later eras.
@@ -138,7 +138,7 @@ caseShelleyToAlonzoOrBabbageEraOnwards l r = \case
138138
ShelleyBasedEraAlonzo -> l ShelleyToAlonzoEraAlonzo
139139
ShelleyBasedEraBabbage -> r BabbageEraOnwardsBabbage
140140
ShelleyBasedEraConway -> r BabbageEraOnwardsConway
141-
ShelleyBasedEraDijkstra -> r BabbageEraOnwardsDijkstra
141+
ShelleyBasedEraDijkstra -> error "caseShelleyToAlonzoOrBabbageEraOnwards: DijkstraEra is not supported"
142142

143143
-- | @caseShelleyToBabbageOrConwayEraOnwards f g era@ applies @f@ to eras before conway;
144144
-- and applies @g@ to conway and later eras.
@@ -155,7 +155,7 @@ caseShelleyToBabbageOrConwayEraOnwards l r = \case
155155
ShelleyBasedEraAlonzo -> l ShelleyToBabbageEraAlonzo
156156
ShelleyBasedEraBabbage -> l ShelleyToBabbageEraBabbage
157157
ShelleyBasedEraConway -> r ConwayEraOnwardsConway
158-
ShelleyBasedEraDijkstra -> r ConwayEraOnwardsDijkstra
158+
ShelleyBasedEraDijkstra -> error "caseShelleyToBabbageOrConwayEraOnwards: DijkstraEra is not supported"
159159

160160
{-# DEPRECATED shelleyToAlonzoEraToShelleyToBabbageEra "Use convert instead" #-}
161161
shelleyToAlonzoEraToShelleyToBabbageEra

‎cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -120,7 +120,7 @@ allegraEraOnwardsConstraints = \case
120120
AllegraEraOnwardsAlonzo -> id
121121
AllegraEraOnwardsBabbage -> id
122122
AllegraEraOnwardsConway -> id
123-
AllegraEraOnwardsDijkstra -> id
123+
_ -> const $ error "allegraEraOnwardsConstraints: Dijkstra era not supported"
124124

125125
{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
126126
allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era

‎cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -131,7 +131,7 @@ alonzoEraOnwardsConstraints = \case
131131
AlonzoEraOnwardsAlonzo -> id
132132
AlonzoEraOnwardsBabbage -> id
133133
AlonzoEraOnwardsConway -> id
134-
AlonzoEraOnwardsDijkstra -> id
134+
AlonzoEraOnwardsDijkstra -> const $ error "alonzoEraOnwardsConstraints: Dijkstra era not yet supported"
135135

136136
{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
137137
alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era

‎cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,7 @@ babbageEraOnwardsConstraints
137137
babbageEraOnwardsConstraints = \case
138138
BabbageEraOnwardsBabbage -> id
139139
BabbageEraOnwardsConway -> id
140-
BabbageEraOnwardsDijkstra -> id
140+
BabbageEraOnwardsDijkstra -> const $ error "babbageEraOnwardsConstraints: DijkstraEra is currently not supported"
141141

142142
{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
143143
babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era

‎cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -145,7 +145,7 @@ conwayEraOnwardsConstraints
145145
-> a
146146
conwayEraOnwardsConstraints = \case
147147
ConwayEraOnwardsConway -> id
148-
ConwayEraOnwardsDijkstra -> id
148+
_ -> const $ error "conwayEraOnwardsConstraints: Dijkstra era is not yet supported"
149149

150150
{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
151151
conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era

0 commit comments

Comments
 (0)