diff --git a/cabal.project b/cabal.project index 83bc444b000..e1c379f9214 100644 --- a/cabal.project +++ b/cabal.project @@ -42,6 +42,18 @@ source-repository-package -- points to a commit in `MAlonzo-code` if you were fiddling with the SRP -- as part of your PR. +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-base + tag: 391a2c5cfd30d2234097e000dbd8d9db21ef94d7 + --sha256: sha256-cw1BmYagp37B1n4PVWJF4AJ8nc/MYjSRlTLEWwL+EEk= + subdir: + -- cardano-binary + cardano-crypto-class + cardano-crypto-tests + cardano-crypto-praos + cardano-mempool + index-state: -- Bump this if you need newer packages from Hackage , hackage.haskell.org 2024-11-07T23:54:03Z @@ -89,7 +101,7 @@ packages: libs/cardano-ledger-conformance libs/cardano-ledger-test libs/plutus-preprocessor - libs/ledger-state + -- libs/ledger-state libs/constrained-generators libs/cardano-ledger-repl-environment @@ -111,6 +123,14 @@ package cardano-ledger-mary package cardano-ledger-conway flags: +asserts +allow-newer: + -- Plutus-core has an upper bound on cardano-crypto-class that would prevent + -- us from depending on the updated KES API; however, these changes to + -- cardano-crypto-class are inconsequential for plutus-core, so until the + -- dependency from plutus-core to cardano-crypto-class is updated, we will + -- have to add this exemption. + plutus-core:cardano-crypto-class + -- Always write GHC env files, because they are needed for repl and by the doctests. write-ghc-environment-files: always diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs index a50f4e7dda5..01852787527 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs @@ -14,6 +14,7 @@ module Test.Cardano.Ledger.Shelley.Examples.Consensus where import Cardano.Crypto.DSIGN as DSIGN import Cardano.Crypto.Hash as Hash +import Cardano.Crypto.KES as KES import Cardano.Crypto.Seed as Seed import qualified Cardano.Crypto.VRF as VRF import Cardano.Ledger.AuxiliaryData @@ -181,7 +182,7 @@ exampleShelleyLedgerBlock tx = Block blockHeader blockBody KeyPair vKeyCold _ = aikCold keys blockHeader :: BHeader (EraCrypto era) - blockHeader = BHeader blockHeaderBody (signedKES () 0 blockHeaderBody hotKey) + blockHeader = BHeader blockHeaderBody (unsoundPureSignedKES () 0 blockHeaderBody hotKey) blockHeaderBody :: BHBody (EraCrypto era) blockHeaderBody = diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs index a6d3a551bed..2188ff52e34 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs @@ -48,9 +48,9 @@ import Cardano.Crypto.Hash ( hashToBytes, ) import Cardano.Crypto.KES ( - KESAlgorithm (..), - deriveVerKeyKES, - genKeyKES, + UnsoundPureKESAlgorithm (..), + unsoundPureDeriveVerKeyKES, + unsoundPureGenKeyKES, ) import Cardano.Crypto.Seed (Seed, mkSeedFromBytes) import Cardano.Crypto.VRF ( @@ -210,10 +210,11 @@ mkCertifiedVRF a sk = -- | For testing purposes, generate a deterministic KES key pair given a seed. mkKESKeyPair :: Crypto c => RawSeed -> KESKeyPair c mkKESKeyPair seed = - let sk = genKeyKES $ mkSeedFromWords seed + let sk = unsoundPureGenKeyKES (mkSeedFromWords seed) + vk = unsoundPureDeriveVerKeyKES sk in KESKeyPair { kesSignKey = sk - , kesVerKey = deriveVerKeyKES sk + , kesVerKey = vk } runShelleyBase :: ShelleyBase a -> a diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs index 28ad8d2e784..6a9d88ea0ca 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs @@ -16,7 +16,7 @@ module Test.Cardano.Ledger.Shelley.Serialisation.Golden.Encoding (tests) where import qualified Cardano.Crypto.Hash as Monomorphic -import Cardano.Crypto.KES (SignedKES) +import Cardano.Crypto.KES (SignedKES, unsoundPureSignedKES) import Cardano.Crypto.VRF (CertifiedVRF) import Cardano.Ledger.Address (Addr (..), RewardAccount (..)) import Cardano.Ledger.BaseTypes ( @@ -76,7 +76,6 @@ import Cardano.Ledger.Keys ( hashKey, hashVerKeyVRF, signedDSIGN, - signedKES, ) import Cardano.Ledger.PoolParams ( PoolMetadata (..), @@ -382,7 +381,7 @@ testBHBSigTokens :: testBHBSigTokens = e where s = - signedKES @(KES (EraCrypto era)) + unsoundPureSignedKES @(KES (EraCrypto era)) () 0 (testBHB @era) @@ -990,7 +989,7 @@ tests = ) , -- checkEncodingCBOR "block_header" let sig :: (SignedKES (KES C_Crypto) (BHBody C_Crypto)) - sig = signedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto) + sig = unsoundPureSignedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto) in checkEncodingCBORAnnotated shelleyProtVer "block_header" @@ -1001,7 +1000,7 @@ tests = ) , -- checkEncodingCBOR "empty_block" let sig :: (SignedKES (KES C_Crypto) (BHBody C_Crypto)) - sig = signedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto) + sig = unsoundPureSignedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto) bh = BHeader (testBHB @C) sig txns = ShelleyTxSeq StrictSeq.Empty in checkEncodingCBORAnnotated @@ -1014,7 +1013,7 @@ tests = ) , -- checkEncodingCBOR "rich_block" let sig :: SignedKES (KES C_Crypto) (BHBody C_Crypto) - sig = signedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto) + sig = unsoundPureSignedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto) bh = BHeader (testBHB @C) sig tout = StrictSeq.singleton $ ShelleyTxOut @C testAddrE (Coin 2) txb :: Word64 -> ShelleyTxBody C diff --git a/flake.nix b/flake.nix index dcc4f692cf1..c2e666c437c 100644 --- a/flake.nix +++ b/flake.nix @@ -80,6 +80,9 @@ ''; shell = { + # Due to plutus-tx-plugin being a bit special, we need to augment the default package selection. + packages = ps: builtins.attrValues (nixpkgs.haskell-nix.haskellLib.selectLocalPackages ps) ++ [ps.plutus-tx-plugin]; + # force LANG to be UTF-8, otherwise GHC might choke on UTF encoded data. shellHook = '' export LANG=en_US.UTF-8 diff --git a/hie.yaml b/hie.yaml index 08034031a9f..cd3718ef07c 100644 --- a/hie.yaml +++ b/hie.yaml @@ -294,21 +294,6 @@ cradle: - path: "libs/constrained-generators/bench/Constrained/Bench.hs" component: "constrained-generators:bench:bench" - - path: "libs/ledger-state/src" - component: "lib:ledger-state" - - - path: "libs/ledger-state/app/Main.hs" - component: "ledger-state:exe:ledger-state" - - - path: "libs/ledger-state/bench/Memory.hs" - component: "ledger-state:bench:memory" - - - path: "libs/ledger-state/bench/Performance.hs" - component: "ledger-state:bench:performance" - - - path: "libs/ledger-state/bench/Address.hs" - component: "ledger-state:bench:address" - - path: "libs/non-integral/src" component: "lib:non-integral" diff --git a/libs/cardano-ledger-binary/.ghcid b/libs/cardano-ledger-binary/.ghcid index 996f651d355..aa68a71ebf7 100644 --- a/libs/cardano-ledger-binary/.ghcid +++ b/libs/cardano-ledger-binary/.ghcid @@ -1 +1 @@ ---command="cabal repl --repl-options='-isrc -fwarn-unused-binds -fwarn-unused-imports -fno-code -fobject-code -g2 -fno-break-on-exception -fno-break-on-error -ferror-spans -j -Wno-unused-packages'" --clear --no-height-limit --reverse-errors --reload=../../ --outputfile=/tmp/cardano-ledger-binary-ghcid.txt \ No newline at end of file +--command="cabal repl --repl-options='-isrc -fwarn-unused-binds -fwarn-unused-imports -fno-code -fobject-code -g2 -fno-break-on-exception -fno-break-on-error -ferror-spans -j -Wno-unused-packages'" --clear --no-height-limit --reverse-errors --reload=../../ --outputfile=/tmp/cardano-ledger-binary-ghcid.txt diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs index 831e4f39465..ca849eef8b0 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs @@ -14,8 +14,6 @@ module Cardano.Ledger.Binary.Crypto ( -- * KES encodeVerKeyKES, decodeVerKeyKES, - encodeSignKeyKES, - decodeSignKeyKES, encodeSigKES, decodeSigKES, encodeSignedKES, @@ -85,14 +83,6 @@ decodeVerKeyKES :: C.KESAlgorithm v => Decoder s (C.VerKeyKES v) decodeVerKeyKES = fromPlainDecoder C.decodeVerKeyKES {-# INLINE decodeVerKeyKES #-} -encodeSignKeyKES :: C.KESAlgorithm v => C.SignKeyKES v -> Encoding -encodeSignKeyKES = fromPlainEncoding . C.encodeSignKeyKES -{-# INLINE encodeSignKeyKES #-} - -decodeSignKeyKES :: C.KESAlgorithm v => Decoder s (C.SignKeyKES v) -decodeSignKeyKES = fromPlainDecoder C.decodeSignKeyKES -{-# INLINE decodeSignKeyKES #-} - encodeSigKES :: C.KESAlgorithm v => C.SigKES v -> Encoding encodeSigKES = fromPlainEncoding . C.encodeSigKES {-# INLINE encodeSigKES #-} diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs index 00fc9993dfc..dd91989b27d 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs @@ -23,20 +23,13 @@ where import qualified Cardano.Binary as Plain (Decoder, FromCBOR (..)) import Cardano.Crypto.DSIGN.Class ( DSIGNAlgorithm, - SeedSizeDSIGN, SigDSIGN, SignKeyDSIGN, SignedDSIGN, VerKeyDSIGN, ) import Cardano.Crypto.Hash.Class (Hash, HashAlgorithm) -import Cardano.Crypto.KES.Class (KESAlgorithm, OptimizedKESAlgorithm, SigKES, SignKeyKES, VerKeyKES) -import Cardano.Crypto.KES.CompactSingle (CompactSingleKES) -import Cardano.Crypto.KES.CompactSum (CompactSumKES) -import Cardano.Crypto.KES.Mock (MockKES) -import Cardano.Crypto.KES.Simple (SimpleKES) -import Cardano.Crypto.KES.Single (SingleKES) -import Cardano.Crypto.KES.Sum (SumKES) +import Cardano.Crypto.KES.Class (KESAlgorithm, SigKES, VerKeyKES) import Cardano.Crypto.VRF.Class ( CertVRF, CertifiedVRF (..), @@ -92,7 +85,6 @@ import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU import Data.Void (Void) import Data.Word (Word16, Word32, Word64, Word8) -import GHC.TypeNats (KnownNat, type (*)) import Numeric.Natural (Natural) import qualified PlutusLedgerApi.V1 as PV1 import qualified PlutusLedgerApi.V2 as PV2 @@ -487,93 +479,11 @@ instance (HashAlgorithm h, Typeable a) => DecCBOR (Hash h a) -- KES -------------------------------------------------------------------------------- -instance - (DSIGNAlgorithm d, KnownNat t, KnownNat (SeedSizeDSIGN d * t)) => - DecCBOR (VerKeyKES (SimpleKES d t)) - where - decCBOR = decodeVerKeyKES - {-# INLINE decCBOR #-} - -instance - (DSIGNAlgorithm d, KnownNat t, KnownNat (SeedSizeDSIGN d * t)) => - DecCBOR (SignKeyKES (SimpleKES d t)) - where - decCBOR = decodeSignKeyKES - {-# INLINE decCBOR #-} - -instance - (DSIGNAlgorithm d, KnownNat t, KnownNat (SeedSizeDSIGN d * t)) => - DecCBOR (SigKES (SimpleKES d t)) - where - decCBOR = decodeSigKES - {-# INLINE decCBOR #-} - -instance (KESAlgorithm d, HashAlgorithm h) => DecCBOR (VerKeyKES (SumKES h d)) where - decCBOR = decodeVerKeyKES - {-# INLINE decCBOR #-} - -instance (KESAlgorithm d, HashAlgorithm h) => DecCBOR (SignKeyKES (SumKES h d)) where - decCBOR = decodeSignKeyKES - {-# INLINE decCBOR #-} - -instance (KESAlgorithm d, HashAlgorithm h) => DecCBOR (SigKES (SumKES h d)) where - decCBOR = decodeSigKES - {-# INLINE decCBOR #-} - -instance DSIGNAlgorithm d => DecCBOR (VerKeyKES (CompactSingleKES d)) where - decCBOR = decodeVerKeyKES - {-# INLINE decCBOR #-} - -instance DSIGNAlgorithm d => DecCBOR (SignKeyKES (CompactSingleKES d)) where - decCBOR = decodeSignKeyKES - {-# INLINE decCBOR #-} - -instance DSIGNAlgorithm d => DecCBOR (SigKES (CompactSingleKES d)) where - decCBOR = decodeSigKES - {-# INLINE decCBOR #-} - -instance - (OptimizedKESAlgorithm d, HashAlgorithm h) => - DecCBOR (VerKeyKES (CompactSumKES h d)) - where +instance KESAlgorithm k => DecCBOR (VerKeyKES k) where decCBOR = decodeVerKeyKES {-# INLINE decCBOR #-} -instance - (OptimizedKESAlgorithm d, HashAlgorithm h) => - DecCBOR (SignKeyKES (CompactSumKES h d)) - where - decCBOR = decodeSignKeyKES - {-# INLINE decCBOR #-} - -instance - (OptimizedKESAlgorithm d, HashAlgorithm h) => - DecCBOR (SigKES (CompactSumKES h d)) - where - decCBOR = decodeSigKES - {-# INLINE decCBOR #-} - -instance DSIGNAlgorithm d => DecCBOR (VerKeyKES (SingleKES d)) where - decCBOR = decodeVerKeyKES - {-# INLINE decCBOR #-} - -instance DSIGNAlgorithm d => DecCBOR (SignKeyKES (SingleKES d)) where - decCBOR = decodeSignKeyKES - {-# INLINE decCBOR #-} - -instance DSIGNAlgorithm d => DecCBOR (SigKES (SingleKES d)) where - decCBOR = decodeSigKES - {-# INLINE decCBOR #-} - -instance KnownNat t => DecCBOR (VerKeyKES (MockKES t)) where - decCBOR = decodeVerKeyKES - {-# INLINE decCBOR #-} - -instance KnownNat t => DecCBOR (SignKeyKES (MockKES t)) where - decCBOR = decodeSignKeyKES - {-# INLINE decCBOR #-} - -instance KnownNat t => DecCBOR (SigKES (MockKES t)) where +instance KESAlgorithm k => DecCBOR (SigKES k) where decCBOR = decodeSigKES {-# INLINE decCBOR #-} diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs index 99586f051d5..24984e3c47a 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs @@ -13,6 +13,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoStarIsType #-} @@ -57,7 +58,6 @@ where import Cardano.Crypto.DSIGN.Class ( DSIGNAlgorithm, - SeedSizeDSIGN, SigDSIGN, SignKeyDSIGN, SignedDSIGN, @@ -74,7 +74,6 @@ import Cardano.Crypto.Hash.Class ( ) import Cardano.Crypto.KES.Class ( KESAlgorithm, - OptimizedKESAlgorithm, SigKES, SignKeyKES, VerKeyKES, @@ -82,12 +81,6 @@ import Cardano.Crypto.KES.Class ( sizeSignKeyKES, sizeVerKeyKES, ) -import Cardano.Crypto.KES.CompactSingle (CompactSingleKES) -import Cardano.Crypto.KES.CompactSum (CompactSumKES) -import Cardano.Crypto.KES.Mock (MockKES) -import Cardano.Crypto.KES.Simple (SimpleKES) -import Cardano.Crypto.KES.Single (SingleKES) -import Cardano.Crypto.KES.Sum (SumKES) import Cardano.Crypto.VRF.Class ( CertVRF, CertifiedVRF (..), @@ -159,7 +152,6 @@ import Data.Word (Word16, Word32, Word64, Word8) import Foreign.Storable (sizeOf) import Formatting (bprint, build, shown, stext) import qualified Formatting.Buildable as B (Buildable (..)) -import GHC.TypeNats (KnownNat, type (*)) import Numeric.Natural (Natural) import qualified PlutusLedgerApi.V1 as PV1 import qualified PlutusLedgerApi.V2 as PV2 @@ -941,102 +933,11 @@ encodedSigKESSizeExpr _proxy = -- payload + fromIntegral (sizeSigKES (Proxy :: Proxy v)) -instance - (DSIGNAlgorithm d, KnownNat t, KnownNat (SeedSizeDSIGN d * t)) => - EncCBOR (VerKeyKES (SimpleKES d t)) - where - encCBOR = encodeVerKeyKES - encodedSizeExpr _size = encodedVerKeyKESSizeExpr - -instance - (DSIGNAlgorithm d, KnownNat t, KnownNat (SeedSizeDSIGN d * t)) => - EncCBOR (SignKeyKES (SimpleKES d t)) - where - encCBOR = encodeSignKeyKES - encodedSizeExpr _size = encodedSignKeyKESSizeExpr - -instance - (DSIGNAlgorithm d, KnownNat t, KnownNat (SeedSizeDSIGN d * t)) => - EncCBOR (SigKES (SimpleKES d t)) - where - encCBOR = encodeSigKES - encodedSizeExpr _size = encodedSigKESSizeExpr - -instance - (KESAlgorithm d, HashAlgorithm h) => - EncCBOR (VerKeyKES (SumKES h d)) - where - encCBOR = encodeVerKeyKES - encodedSizeExpr _size = encodedVerKeyKESSizeExpr - -instance - (KESAlgorithm d, HashAlgorithm h) => - EncCBOR (SignKeyKES (SumKES h d)) - where - encCBOR = encodeSignKeyKES - encodedSizeExpr _size = encodedSignKeyKESSizeExpr - -instance - (KESAlgorithm d, HashAlgorithm h) => - EncCBOR (SigKES (SumKES h d)) - where - encCBOR = encodeSigKES - encodedSizeExpr _size = encodedSigKESSizeExpr - -instance DSIGNAlgorithm d => EncCBOR (VerKeyKES (CompactSingleKES d)) where - encCBOR = encodeVerKeyKES - encodedSizeExpr _size = encodedVerKeyKESSizeExpr - -instance DSIGNAlgorithm d => EncCBOR (SignKeyKES (CompactSingleKES d)) where - encCBOR = encodeSignKeyKES - encodedSizeExpr _size = encodedSignKeyKESSizeExpr - -instance DSIGNAlgorithm d => EncCBOR (SigKES (CompactSingleKES d)) where - encCBOR = encodeSigKES - encodedSizeExpr _size = encodedSigKESSizeExpr - -instance - (OptimizedKESAlgorithm d, HashAlgorithm h) => - EncCBOR (VerKeyKES (CompactSumKES h d)) - where +instance KESAlgorithm k => EncCBOR (VerKeyKES k) where encCBOR = encodeVerKeyKES encodedSizeExpr _size = encodedVerKeyKESSizeExpr -instance - (OptimizedKESAlgorithm d, HashAlgorithm h) => - EncCBOR (SignKeyKES (CompactSumKES h d)) - where - encCBOR = encodeSignKeyKES - encodedSizeExpr _size = encodedSignKeyKESSizeExpr - -instance - (OptimizedKESAlgorithm d, HashAlgorithm h) => - EncCBOR (SigKES (CompactSumKES h d)) - where - encCBOR = encodeSigKES - encodedSizeExpr _size = encodedSigKESSizeExpr - -instance DSIGNAlgorithm d => EncCBOR (VerKeyKES (SingleKES d)) where - encCBOR = encodeVerKeyKES - encodedSizeExpr _size = encodedVerKeyKESSizeExpr - -instance DSIGNAlgorithm d => EncCBOR (SignKeyKES (SingleKES d)) where - encCBOR = encodeSignKeyKES - encodedSizeExpr _size = encodedSignKeyKESSizeExpr - -instance DSIGNAlgorithm d => EncCBOR (SigKES (SingleKES d)) where - encCBOR = encodeSigKES - encodedSizeExpr _size = encodedSigKESSizeExpr - -instance KnownNat t => EncCBOR (VerKeyKES (MockKES t)) where - encCBOR = encodeVerKeyKES - encodedSizeExpr _size = encodedVerKeyKESSizeExpr - -instance KnownNat t => EncCBOR (SignKeyKES (MockKES t)) where - encCBOR = encodeSignKeyKES - encodedSizeExpr _size = encodedSignKeyKESSizeExpr - -instance KnownNat t => EncCBOR (SigKES (MockKES t)) where +instance KESAlgorithm k => EncCBOR (SigKES k) where encCBOR = encodeSigKES encodedSizeExpr _size = encodedSigKESSizeExpr diff --git a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs b/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs index a89d82689ba..e5812de1c92 100644 --- a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs +++ b/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs @@ -17,7 +17,7 @@ import Cardano.Crypto.Hash.Keccak256 (Keccak256) import Cardano.Crypto.Hash.SHA256 (SHA256) import Cardano.Crypto.Hash.SHA3_256 (SHA3_256) import Cardano.Crypto.Hash.Short (ShortHash) -import Cardano.Crypto.KES.Class (SigKES, SignKeyKES, VerKeyKES) +import Cardano.Crypto.KES.Class (SigKES, VerKeyKES) import Cardano.Crypto.KES.CompactSingle (CompactSingleKES) import Cardano.Crypto.KES.CompactSum ( CompactSum0KES, @@ -173,73 +173,44 @@ spec = do roundTripSpec @(CertVRF MockVRF) cborTrip describe "KES" $ do describe "CompactSingle" $ do - roundTripSpec @(SignKeyKES (CompactSingleKES Ed25519DSIGN)) cborTrip roundTripSpec @(VerKeyKES (CompactSingleKES Ed25519DSIGN)) cborTrip roundTripSpec @(SigKES (CompactSingleKES Ed25519DSIGN)) cborTrip describe "CompactSum" $ do - roundTripSpec @(SignKeyKES (CompactSum0KES Ed25519DSIGN)) cborTrip roundTripSpec @(VerKeyKES (CompactSum0KES Ed25519DSIGN)) cborTrip roundTripSpec @(SigKES (CompactSum0KES Ed25519DSIGN)) cborTrip - roundTripSpec @(SignKeyKES (CompactSum1KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (CompactSum1KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (CompactSum1KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (CompactSum2KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (CompactSum2KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (CompactSum2KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (CompactSum3KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (CompactSum3KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (CompactSum3KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (CompactSum4KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (CompactSum4KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (CompactSum4KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (CompactSum5KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (CompactSum5KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (CompactSum5KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (CompactSum6KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (CompactSum6KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (CompactSum6KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (CompactSum7KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (CompactSum7KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (CompactSum7KES Ed25519DSIGN Blake2b_256)) cborTrip describe "Sum" $ do - roundTripSpec @(SignKeyKES (Sum0KES Ed25519DSIGN)) cborTrip roundTripSpec @(VerKeyKES (Sum0KES Ed25519DSIGN)) cborTrip roundTripSpec @(SigKES (Sum0KES Ed25519DSIGN)) cborTrip - roundTripSpec @(SignKeyKES (Sum1KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (Sum1KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (Sum1KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (Sum2KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (Sum2KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (Sum2KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (Sum3KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (Sum3KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (Sum3KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (Sum4KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (Sum4KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (Sum4KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (Sum5KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (Sum5KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (Sum5KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (Sum6KES Ed25519DSIGN Blake2b_256)) cborTrip - roundTripSpec @(SignKeyKES (Sum7KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(VerKeyKES (Sum7KES Ed25519DSIGN Blake2b_256)) cborTrip roundTripSpec @(SigKES (Sum7KES Ed25519DSIGN Blake2b_256)) cborTrip -- below we also test some tuple roundtripping as well as KES describe "Simple" $ do - roundTripSpec - @( SignKeyKES (SimpleKES Ed25519DSIGN 1) - , SignKeyKES (SimpleKES Ed25519DSIGN 2) - , SignKeyKES (SimpleKES Ed25519DSIGN 3) - , SignKeyKES (SimpleKES Ed25519DSIGN 4) - , SignKeyKES (SimpleKES Ed25519DSIGN 5) - , SignKeyKES (SimpleKES Ed25519DSIGN 6) - ) - cborTrip - roundTripSpec - @(SignKeyKES (SimpleKES Ed25519DSIGN 7)) - cborTrip roundTripSpec @( VerKeyKES (SimpleKES Ed25519DSIGN 1) , VerKeyKES (SimpleKES Ed25519DSIGN 2) @@ -264,19 +235,18 @@ spec = do ) cborTrip describe "Mock" $ do - roundTripSpec @(SignKeyKES (MockKES 7)) cborTrip roundTripSpec @(VerKeyKES (MockKES 7)) cborTrip roundTripSpec @(SigKES (MockKES 7)) cborTrip - describe "Hash" $ do - roundTripSpec - @( Hash Blake2b_224 () - , Hash Blake2b_256 () - , Hash SHA256 () - , Hash SHA3_256 () - , Hash Keccak256 () - , Hash ShortHash () - ) - cborTrip + describe "Hash" $ do + roundTripSpec + @( Hash Blake2b_224 () + , Hash Blake2b_256 () + , Hash SHA256 () + , Hash SHA3_256 () + , Hash Keccak256 () + , Hash ShortHash () + ) + cborTrip describe "EmbedTrip" $ do forM_ [shelleyProtVer .. maxBound] $ \v -> describe (show v) $ do diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Crypto.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Crypto.hs index 53887b9f6ea..d29f04189ce 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Crypto.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Crypto.hs @@ -17,7 +17,7 @@ class ( HashAlgorithm (HASH c) , HashAlgorithm (ADDRHASH c) , DSIGNAlgorithm (DSIGN c) - , KESAlgorithm (KES c) + , UnsoundPureKESAlgorithm (KES c) , VRFAlgorithm (VRF c) , ContextDSIGN (DSIGN c) ~ () , ContextKES (KES c) ~ () diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/KES.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/KES.hs index 91073f34c90..4e1f360b352 100644 --- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/KES.hs +++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/KES.hs @@ -9,15 +9,14 @@ module Test.Cardano.Protocol.Crypto.KES ( import qualified Cardano.Crypto.KES.Class as KES import Cardano.Ledger.Crypto -import Cardano.Ledger.Keys ( - SignKeyKES, - VerKeyKES, - ) +import Cardano.Ledger.Keys (VerKeyKES) data KESKeyPair c = KESKeyPair - { kesSignKey :: !(SignKeyKES c) + { kesSignKey :: !(KES.UnsoundPureSignKeyKES (KES c)) , kesVerKey :: !(VerKeyKES c) } -deriving instance - (Show (KES.SignKeyKES (KES c)), Show (KES.VerKeyKES (KES c))) => Show (KESKeyPair c) +instance Show (KES.VerKeyKES (KES c)) => Show (KESKeyPair c) where + show (KESKeyPair _ vk) = + -- showing `SignKeyKES` is impossible for security reasons. + "KESKeyPair " <> show vk diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs index d32c740cdc3..4276b984bdb 100644 --- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs +++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs @@ -25,7 +25,6 @@ import Cardano.Ledger.BaseTypes (BlockNo (..), Nonce, Seed, SlotNo (..)) import Cardano.Ledger.Block (Block (Block)) import Cardano.Ledger.Core import Cardano.Ledger.Crypto (Crypto (KES, VRF), DSIGN) -import Cardano.Ledger.Keys (signedKES) import Cardano.Protocol.TPraos.API (PraosCrypto) import Cardano.Protocol.TPraos.BHeader ( BHBody (BHBody), @@ -69,7 +68,7 @@ instance arbitrary = do bhBody <- arbitrary hotKey <- arbitrary - let sig = signedKES () 1 bhBody hotKey + let sig = KES.unsoundPureSignedKES () 1 bhBody hotKey pure $ BHeader bhBody sig genBHeader :: diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Create.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Create.hs index e6c7b9ae3e7..2e84cf7e907 100644 --- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Create.hs +++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Create.hs @@ -44,7 +44,6 @@ import Cardano.Ledger.Keys ( KeyHash, KeyRole (..), signedDSIGN, - signedKES, ) import Cardano.Protocol.TPraos.BHeader ( BHBody (..), @@ -199,24 +198,24 @@ mkBHeader pKeys kesPeriod keyRegKesPeriod bhBody = , "kpDiff: " ++ show kpDiff ] Just hKey -> hKey - sig = signedKES () kpDiff bhBody hotKey + sig = KES.unsoundPureSignedKES () kpDiff bhBody hotKey in BHeader bhBody sig -- | Try to evolve KES key until specific KES period is reached, given the -- current KES period. evolveKESUntil :: - (KES.KESAlgorithm v, KES.ContextKES v ~ ()) => - KES.SignKeyKES v -> + (KES.UnsoundPureKESAlgorithm v, KES.ContextKES v ~ ()) => + KES.UnsoundPureSignKeyKES v -> -- | Current KES period KESPeriod -> -- | Target KES period KESPeriod -> - Maybe (KES.SignKeyKES v) + Maybe (KES.UnsoundPureSignKeyKES v) evolveKESUntil sk1 (KESPeriod current) (KESPeriod target) = go sk1 current target where go !_ c t | t < c = Nothing go !sk c t | c == t = Just sk - go !sk c t = case KES.updateKES () sk c of + go !sk c t = case KES.unsoundPureUpdateKES () sk c of Nothing -> Nothing Just sk' -> go sk' (c + 1) t diff --git a/libs/constrained-generators/CHANGELOG.md b/libs/constrained-generators/CHANGELOG.md new file mode 100644 index 00000000000..a53cc607c3a --- /dev/null +++ b/libs/constrained-generators/CHANGELOG.md @@ -0,0 +1,3 @@ +# Version history for `constrain-generators` + +## This package is not being released yet.