From 8a9d67b4836b76ad18d025aa6e81117c0382b219 Mon Sep 17 00:00:00 2001 From: Alex Byaly Date: Tue, 14 Jul 2020 10:24:55 -0500 Subject: [PATCH] Update base --- cabal.project | 16 +- .../executable-spec/src/Data/AbstractSize.hs | 86 +++++---- .../State/Transition/Examples/CommitReveal.hs | 164 +++++++++--------- .../src/Shelley/Spec/Ledger/Address.hs | 9 +- .../Shelley/Spec/Ledger/Address/Bootstrap.hs | 7 +- .../src/Shelley/Spec/Ledger/BaseTypes.hs | 6 +- .../src/Shelley/Spec/Ledger/BlockChain.hs | 13 +- .../src/Shelley/Spec/Ledger/Genesis.hs | 6 +- .../src/Shelley/Spec/Ledger/Keys.hs | 2 +- .../src/Shelley/Spec/Ledger/MetaData.hs | 4 +- .../src/Shelley/Spec/Ledger/Orphans.hs | 5 + .../test/Test/Cardano/Crypto/VRF/Fake.hs | 4 +- .../test/Test/Shelley/Spec/Ledger/Address.hs | 11 +- .../Shelley/Spec/Ledger/Address/Bootstrap.hs | 3 +- .../test/Test/Shelley/Spec/Ledger/Examples.hs | 10 +- .../Shelley/Spec/Ledger/Generator/Core.hs | 5 +- .../Shelley/Spec/Ledger/Generator/Genesis.hs | 3 +- .../Spec/Ledger/Generator/Trace/Chain.hs | 9 +- .../test/Test/Shelley/Spec/Ledger/Orphans.hs | 11 ++ .../test/Test/Shelley/Spec/Ledger/Rewards.hs | 15 +- .../Test/Shelley/Spec/Ledger/Serialization.hs | 16 +- .../Spec/Ledger/SerializationProperties.hs | 4 +- .../test/Test/Shelley/Spec/Ledger/Utils.hs | 18 +- stack.yaml | 2 +- 24 files changed, 250 insertions(+), 179 deletions(-) diff --git a/cabal.project b/cabal.project index 27f18c091b2..2accefee6f9 100644 --- a/cabal.project +++ b/cabal.project @@ -23,29 +23,29 @@ write-ghc-environment-files: always source-repository-package type: git location: https://github.com/input-output-hk/cardano-base - tag: c454b6e791ee2fe84508b4d5ed2c4dedafb7dce4 - --sha256: 01m5jq6gsym3j4v85lv01n6f8480lglrb0n2mv87aqm5ksh4di9y + tag: 7d795c3040ea7785812efa1c97864bbb41b15d3e + --sha256: 130i0yj4y9br1m2bhisi6wni3f40i31nfhg878hv0kwi17chl9sz subdir: binary source-repository-package type: git location: https://github.com/input-output-hk/cardano-base - tag: c454b6e791ee2fe84508b4d5ed2c4dedafb7dce4 - --sha256: 01m5jq6gsym3j4v85lv01n6f8480lglrb0n2mv87aqm5ksh4di9y + tag: 7d795c3040ea7785812efa1c97864bbb41b15d3e + --sha256: 130i0yj4y9br1m2bhisi6wni3f40i31nfhg878hv0kwi17chl9sz subdir: binary/test source-repository-package type: git location: https://github.com/input-output-hk/cardano-base - tag: c454b6e791ee2fe84508b4d5ed2c4dedafb7dce4 - --sha256: 01m5jq6gsym3j4v85lv01n6f8480lglrb0n2mv87aqm5ksh4di9y + tag: 7d795c3040ea7785812efa1c97864bbb41b15d3e + --sha256: 130i0yj4y9br1m2bhisi6wni3f40i31nfhg878hv0kwi17chl9sz subdir: cardano-crypto-class source-repository-package type: git location: https://github.com/input-output-hk/cardano-base - tag: c454b6e791ee2fe84508b4d5ed2c4dedafb7dce4 - --sha256: 01m5jq6gsym3j4v85lv01n6f8480lglrb0n2mv87aqm5ksh4di9y + tag: 7d795c3040ea7785812efa1c97864bbb41b15d3e + --sha256: 130i0yj4y9br1m2bhisi6wni3f40i31nfhg878hv0kwi17chl9sz subdir: slotting source-repository-package diff --git a/semantics/executable-spec/src/Data/AbstractSize.hs b/semantics/executable-spec/src/Data/AbstractSize.hs index 82e257ef420..cc2b461ea42 100644 --- a/semantics/executable-spec/src/Data/AbstractSize.hs +++ b/semantics/executable-spec/src/Data/AbstractSize.hs @@ -5,32 +5,39 @@ {-# LANGUAGE TypeOperators #-} -- | An approach to computing the abstract size of data using 'TypeRep'. --- module Data.AbstractSize - ( HasTypeReps - , typeReps - , abstractSize - , AccountingMap - , Size - ) where - + ( HasTypeReps, + typeReps, + abstractSize, + AccountingMap, + Size, + ) +where + +import Cardano.Crypto.DSIGN.Class (SignedDSIGN (SignedDSIGN), VerKeyDSIGN) +import Cardano.Crypto.DSIGN.Mock (MockDSIGN, SigDSIGN (SigMockDSIGN)) +import Cardano.Crypto.Hash (Hash (..)) +import Cardano.Crypto.Hash.Short (ShortHash) import qualified Crypto.Hash as Crypto -import qualified Data.ByteString as BS -import Data.Map.Strict (Map) +import qualified Data.ByteString.Short as SBS +import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Sequence (Seq, empty, (<|), (><)) +import Data.Sequence (Seq, empty, (<|), (><)) import qualified Data.Sequence as Seq -import Data.Set (Set) -import Data.Typeable (TypeRep, Typeable, typeOf) -import Data.Word (Word16, Word32, Word64, Word8) -import GHC.Generics ((:*:) ((:*:)), (:+:) (L1, R1), Generic, K1 (K1), M1 (M1), Rep, - U1 (U1), from) -import GHC.Natural (Natural) - -import Cardano.Crypto.DSIGN.Class (SignedDSIGN (SignedDSIGN), VerKeyDSIGN) -import Cardano.Crypto.DSIGN.Mock (MockDSIGN, SigDSIGN (SigMockDSIGN)) -import Cardano.Crypto.Hash (Hash(..)) -import Cardano.Crypto.Hash.Short (ShortHash) +import Data.Set (Set) +import Data.Typeable (TypeRep, Typeable, typeOf) +import Data.Word (Word16, Word32, Word64, Word8) +import GHC.Generics + ( Generic, + K1 (K1), + M1 (M1), + Rep, + U1 (U1), + from, + (:*:) ((:*:)), + (:+:) (L1, R1), + ) +import GHC.Natural (Natural) -- | @abstractSize m a@ computes the abstract size of @a@, using the accounting -- map @m@. The map @m@ determines the abstract size of each 'TypeRep' @@ -55,7 +62,6 @@ import Cardano.Crypto.Hash.Short (ShortHash) -- -- >>> abstractSize [(typeOf (undefined :: [Int]), 3), (typeOf (1 :: Int), -1)] ([0, 1, 2] :: [Int]) -- 0 --- abstractSize :: HasTypeReps a => AccountingMap -> a -> Size abstractSize m a = sum $ fmap cost trs where @@ -63,6 +69,7 @@ abstractSize m a = sum $ fmap cost trs cost t = Map.findWithDefault 0 t m type Size = Int + type AccountingMap = Map TypeRep Size -------------------------------------------------------------------------------- @@ -102,15 +109,15 @@ type AccountingMap = Map TypeRep Size -- >>> instance HasTypeReps Foo -- >>> typeReps $ Foo [1, 2] ('a', 'b') -- fromList [Foo,[Int],Int,Int,(Char,Char),Char,Char] --- class HasTypeReps a where typeReps :: a -> Seq TypeRep - - default typeReps - :: ( Generic a - , GHasTypeReps (Rep a) - , Typeable a - ) => a -> Seq TypeRep + default typeReps :: + ( Generic a, + GHasTypeReps (Rep a), + Typeable a + ) => + a -> + Seq TypeRep typeReps a = typeOf a <| gTypeReps (from a) class GHasTypeReps f where @@ -135,11 +142,11 @@ instance (GHasTypeReps a, GHasTypeReps b) => GHasTypeReps (a :+: b) where -- | We do need to do anything for the metadata. instance (GHasTypeReps a) => GHasTypeReps (M1 i c a) where - gTypeReps (M1 x) = gTypeReps x + gTypeReps (M1 x) = gTypeReps x -- | And the only interesting case, get the type of a type constructor instance (HasTypeReps a) => GHasTypeReps (K1 i a) where - gTypeReps (K1 x) = typeReps x + gTypeReps (K1 x) = typeReps x -------------------------------------------------------------------------------- -- HasTypeReps instances @@ -154,11 +161,14 @@ instance (Typeable a, HasTypeReps a) => HasTypeReps [a] where instance (Typeable a, HasTypeReps a) => HasTypeReps (Set a) where typeReps xs = typeOf xs <| foldMap typeReps xs -instance ( Typeable a - , Typeable b - , HasTypeReps a - , HasTypeReps b - ) => HasTypeReps (a, b) where +instance + ( Typeable a, + Typeable b, + HasTypeReps a, + HasTypeReps b + ) => + HasTypeReps (a, b) + where typeReps t@(a, b) = typeOf t <| (typeReps a >< typeReps b) instance HasTypeReps Bool where @@ -208,7 +218,7 @@ instance HasTypeReps (SignedDSIGN MockDSIGN a) where -- and a 'Word64'. For the 'ByteString' representation we return one character -- per byte. typeReps (SignedDSIGN (SigMockDSIGN (UnsafeHash bs) i)) = - typeOf i <| Seq.replicate (BS.length bs) (typeOf (undefined :: Char)) + typeOf i <| Seq.replicate (SBS.length bs) (typeOf (undefined :: Char)) instance HasTypeReps (VerKeyDSIGN MockDSIGN) where -- A mock verification key is just an 'Int'. diff --git a/semantics/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs b/semantics/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs index fe640075e8f..c4e51f79a9d 100644 --- a/semantics/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs +++ b/semantics/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs @@ -13,25 +13,31 @@ module Control.State.Transition.Examples.CommitReveal where -import Prelude hiding (id) - -import Data.List.Unique (allUnique) -import Data.Map.Strict (Map) +import Cardano.Binary (ToCBOR (..)) +import Cardano.Crypto.Hash (Hash, HashAlgorithm, hashWithSerialiser) +import Cardano.Crypto.Hash.Short (ShortHash) +import Control.State.Transition + ( Environment, + PredicateFailure, + STS, + Signal, + State, + TRC (TRC), + initialRules, + judgmentContext, + transitionRules, + (?!), + ) +import qualified Control.State.Transition.Trace as Trace +import qualified Control.State.Transition.Trace.Generator.QuickCheck as STS.Gen +import Data.List.Unique (allUnique) +import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Set (Set) +import Data.Set (Set) import qualified Data.Set as Set -import Data.Typeable (Typeable) +import Data.Typeable (Typeable) import qualified Test.QuickCheck as QC - -import Cardano.Binary (ToCBOR) -import Cardano.Crypto.Hash (Hash, HashAlgorithm, hash) -import Cardano.Crypto.Hash.Short (ShortHash) - -import Control.State.Transition (Environment, PredicateFailure, STS, Signal, State, - TRC (TRC), initialRules, judgmentContext, transitionRules, (?!)) -import qualified Control.State.Transition.Trace as Trace - -import qualified Control.State.Transition.Trace.Generator.QuickCheck as STS.Gen +import Prelude hiding (id) -- | Commit-reveal transition system, where data hashes are committed and then -- revealed. @@ -46,10 +52,8 @@ import qualified Control.State.Transition.Trace.Generator.QuickCheck as STS.Gen data CR hashAlgo (hashToDataMap :: * -> * -> *) commitData -- | Commit-reveal transition system state. -data CRSt hashAlgo hashToDataMap commitData = - CRSt - { hashToData :: !(hashToDataMap (Hash hashAlgo Data) commitData) - -- ^ Part of the state used to associate data to the hash that was committed. +data CRSt hashAlgo hashToDataMap commitData = CRSt + { -- | Part of the state used to associate data to the hash that was committed. -- -- This is used only by the generators, so 'hashToDataMap' will be -- instantiated to a 'Map' in the generators, for testing purposes; and it @@ -58,10 +62,12 @@ data CRSt hashAlgo hashToDataMap commitData = -- Here 'hashToData' is an example of a phantom variable, which wouldn't be -- present in the formal specification, but it is needed in the executable -- spec to be able to generate traces. - , committedHashes :: !(Set (Hash hashAlgo Data)) - } + hashToData :: !(hashToDataMap (Hash hashAlgo Data) commitData), + committedHashes :: !(Set (Hash hashAlgo Data)) + } deriving instance (Eq (hashToDataMap (Hash hashAlgo Data) commitData)) => Eq (CRSt hashAlgo hashToDataMap commitData) + deriving instance (Show (hashToDataMap (Hash hashAlgo Data) commitData)) => Show (CRSt hashAlgo hashToDataMap commitData) class MapLike m k v where @@ -74,13 +80,11 @@ data NoOpMap a b = NoOpMap -- | This is the 'MapLike' instance one would use if the executable spec would -- be used in an implementation (where no generators are needed). instance MapLike NoOpMap a b where - insert _ _ _ = NoOpMap delete _ _ = NoOpMap instance Ord k => MapLike Map k v where - insert = Map.insert delete = Map.delete @@ -94,19 +98,21 @@ isCommit :: CRSignal hashAlgo commitData -> Bool isCommit Commit {} = True isCommit _ = False -newtype Data = Data { getData :: (Id, Int) } +newtype Data = Data {getData :: (Id, Int)} deriving (Eq, Show, ToCBOR, Ord, QC.Arbitrary) -newtype Id = Id { getId :: Int } +newtype Id = Id {getId :: Int} deriving (Eq, Show, ToCBOR, Ord, QC.Arbitrary) -instance ( HashAlgorithm hashAlgo - , Typeable hashToDataMap - , Typeable commitData - , MapLike hashToDataMap (Hash hashAlgo Data) commitData - , Monoid (hashToDataMap (Hash hashAlgo Data) commitData) - ) => STS (CR hashAlgo hashToDataMap commitData) where - +instance + ( HashAlgorithm hashAlgo, + Typeable hashToDataMap, + Typeable commitData, + MapLike hashToDataMap (Hash hashAlgo Data) commitData, + Monoid (hashToDataMap (Hash hashAlgo Data) commitData) + ) => + STS (CR hashAlgo hashToDataMap commitData) + where type Environment (CR hashAlgo hashToDataMap commitData) = () type State (CR hashAlgo hashToDataMap commitData) = CRSt hashAlgo hashToDataMap commitData @@ -118,56 +124,56 @@ instance ( HashAlgorithm hashAlgo | AlreadyComitted (Hash hashAlgo Data) deriving (Eq, Show) - initialRules = [ - pure - $! CRSt - { hashToData = mempty - , committedHashes = Set.empty - } + initialRules = + [ pure + $! CRSt + { hashToData = mempty, + committedHashes = Set.empty + } ] - transitionRules = [ - do - TRC ((), CRSt { hashToData, committedHashes }, crSignal) <- judgmentContext - case crSignal of - Commit dataHash commitData -> do - dataHash `Set.notMember` committedHashes ?! AlreadyComitted dataHash - pure - $! CRSt - { hashToData = insert dataHash commitData hashToData - , committedHashes = Set.insert dataHash committedHashes - } - Reveal someData -> do - hash someData `Set.member` committedHashes ?! InvalidReveal someData - pure - $! CRSt - { hashToData = delete (hash someData) hashToData - , committedHashes = Set.delete (hash someData) committedHashes - } + transitionRules = + [ do + TRC ((), CRSt {hashToData, committedHashes}, crSignal) <- judgmentContext + case crSignal of + Commit dataHash commitData -> do + dataHash `Set.notMember` committedHashes ?! AlreadyComitted dataHash + pure + $! CRSt + { hashToData = insert dataHash commitData hashToData, + committedHashes = Set.insert dataHash committedHashes + } + Reveal someData -> do + hashWithSerialiser toCBOR someData `Set.member` committedHashes ?! InvalidReveal someData + pure + $! CRSt + { hashToData = delete (hashWithSerialiser toCBOR someData) hashToData, + committedHashes = Set.delete (hashWithSerialiser toCBOR someData) committedHashes + } ] instance - HashAlgorithm hashAlgo - => STS.Gen.HasTrace (CR hashAlgo Map Data) () where - + HashAlgorithm hashAlgo => + STS.Gen.HasTrace (CR hashAlgo Map Data) () + where envGen :: () -> QC.Gen () envGen _ = pure () - sigGen - :: () - -> () - -> CRSt hashAlgo Map Data - -> QC.Gen (CRSignal hashAlgo Data) - sigGen () () CRSt { hashToData, committedHashes } = + sigGen :: + () -> + () -> + CRSt hashAlgo Map Data -> + QC.Gen (CRSignal hashAlgo Data) + sigGen () () CRSt {hashToData, committedHashes} = if Set.null committedHashes - then genCommit - else QC.oneof [genCommit, genReveal] + then genCommit + else QC.oneof [genCommit, genReveal] where genCommit = do id <- Id <$> QC.arbitrary n <- QC.choose (-2, 2) let newData = Data (id, n) - pure $! Commit (hash newData) newData + pure $! Commit (hashWithSerialiser toCBOR newData) newData genReveal = do hashToReveal <- QC.elements $ Set.toList committedHashes let dataToReveal = hashToData Map.! hashToReveal @@ -176,7 +182,7 @@ instance shrinkSignal (Commit _ someData) = recalculateCommit <$> QC.shrink someData where - recalculateCommit shrunkData = Commit (hash shrunkData) shrunkData + recalculateCommit shrunkData = Commit (hashWithSerialiser toCBOR shrunkData) shrunkData shrinkSignal (Reveal someData) = Reveal <$> QC.shrink someData -- | Check that unique data is generated. This is supposed to fail, since @@ -186,11 +192,13 @@ instance -- > commit (hash d0) -> reveal d0 -> commit (hash d0) -- -- where it shouldn't be possible to shrink @d0@ any further. --- prop_qc_UniqueData :: QC.Property prop_qc_UniqueData = STS.Gen.forAllTrace @(CR ShortHash Map Data) @() - () 100 () (noDuplicatedData . Trace.traceSignals Trace.OldestFirst) + () + 100 + () + (noDuplicatedData . Trace.traceSignals Trace.OldestFirst) where noDuplicatedData :: [CRSignal ShortHash Data] -> Bool noDuplicatedData = allUnique . filter isCommit @@ -204,10 +212,10 @@ prop_qc_UniqueData = -- > commit (hash d0) -> commit (hash d0) -- -- where it shouldn't be possible to shrink @d0@ any further. --- prop_qc_OnlyValidSignals :: QC.Property -prop_qc_OnlyValidSignals = QC.withMaxSuccess 5000 -- We need to test a large - -- number of times to make sure - -- we get a collision in the - -- generated data - $ STS.Gen.onlyValidSignalsAreGenerated @(CR ShortHash Map Data) @() () 150 () +prop_qc_OnlyValidSignals = + QC.withMaxSuccess 5000 $ -- We need to test a large + -- number of times to make sure + -- we get a collision in the + -- generated data + STS.Gen.onlyValidSignalsAreGenerated @(CR ShortHash Map Data) @() () 150 () diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address.hs index e88d29ae127..30565e899da 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address.hs @@ -69,6 +69,7 @@ import Data.Bits (setBit, shiftL, shiftR, testBit, (.&.), (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Short as SBS import Data.Foldable (foldl') import Data.String (fromString) import qualified Data.Text.Encoding as Text @@ -303,10 +304,12 @@ getRewardAcnt = do pure $ RewardAcnt network cred getHash :: forall h a. Hash.HashAlgorithm h => Get (Hash.Hash h a) -getHash = Hash.UnsafeHash <$> B.getByteString (fromIntegral $ Hash.sizeHash ([] @h)) +getHash = + Hash.UnsafeHash . SBS.toShort + <$> (B.getByteString . fromIntegral $ Hash.sizeHash ([] @h)) putHash :: Hash.Hash h a -> Put -putHash (Hash.UnsafeHash b) = B.putByteString b +putHash (Hash.UnsafeHash b) = B.putByteString (SBS.fromShort b) getPayCred :: Crypto crypto => Word8 -> Get (PaymentCredential crypto) getPayCred header = case testBit header payCredIsScript of @@ -427,4 +430,4 @@ bootstrapKeyHash (BootstrapAddress byronAddress) = -- from Hash.Blake2b_224) let root = Byron.addrRoot byronAddress bytes = Byron.abstractHashToBytes root - in KeyHash (Hash.UnsafeHash bytes) + in KeyHash (Hash.UnsafeHash . SBS.toShort $ bytes) diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address/Bootstrap.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address/Bootstrap.hs index e4fc9e6d9dd..62b5a256852 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address/Bootstrap.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Address/Bootstrap.hs @@ -64,6 +64,7 @@ import Cardano.Prelude panic, ) import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Short as SBS import Data.Ord (comparing) import Quiet import Shelley.Spec.Ledger.Crypto (ADDRHASH, Crypto, DSIGN) @@ -165,7 +166,7 @@ bootstrapWitKeyHash :: BootstrapWitness crypto -> KeyHash 'Witness crypto bootstrapWitKeyHash (BootstrapWitness (VKey key) _ (ChainCode cc) (KeyPadding prefix suffix)) = - KeyHash . Hash.UnsafeHash . hash_crypto . hash_SHA3_256 $ bytes + KeyHash . Hash.UnsafeHash . SBS.toShort . hash_crypto . hash_SHA3_256 $ bytes where -- Here we are reserializing something that we have previously deserialized. -- This is normally naughty. However, this is a blob of bytes -- serializing it @@ -234,7 +235,7 @@ verifyBootstrapWit :: BootstrapWitness crypto -> Bool verifyBootstrapWit txbodyHash witness = - WC.verify xpub (Hash.getHash txbodyHash) xsig + WC.verify xpub (Hash.hashToBytes txbodyHash) xsig where xpub = WC.XPub (DSIGN.rawSerialiseVerKeyDSIGN k) (WC.ChainCode mempty) (VKey k) = (bwKey witness) @@ -258,4 +259,4 @@ makeBootstrapWitness txBodyHash byronSigningKey byronAddress = WC.sign (mempty :: ByteString) (Byron.unSigningKey byronSigningKey) - (Hash.getHash txBodyHash) + (Hash.hashToBytes txBodyHash) diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BaseTypes.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BaseTypes.hs index 7e5c6b334da..3a331f41ad4 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BaseTypes.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BaseTypes.hs @@ -189,7 +189,7 @@ deriving anyclass instance FromJSON Nonce (⭒) :: Nonce -> Nonce -> Nonce Nonce a ⭒ Nonce b = Nonce . castHash $ - hashRaw id (getHash a <> getHash b) + hashWith id (hashToBytes a <> hashToBytes b) x ⭒ NeutralNonce = x NeutralNonce ⭒ x = x @@ -198,14 +198,14 @@ mkNonceFromOutputVRF :: VRF.OutputVRF v -> Nonce mkNonceFromOutputVRF = Nonce . (castHash :: Hash Blake2b_256 (VRF.OutputVRF v) -> Hash Blake2b_256 Nonce) - . hashRaw VRF.getOutputVRFBytes + . hashWith VRF.getOutputVRFBytes -- | Make a nonce from a number. mkNonceFromNumber :: Word64 -> Nonce mkNonceFromNumber = Nonce . (castHash :: Hash Blake2b_256 Word64 -> Hash Blake2b_256 Nonce) - . hashRaw (BSL.toStrict . B.runPut . B.putWord64be) + . hashWith (BSL.toStrict . B.runPut . B.putWord64be) -- | Seed to the verifiable random function. -- diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BlockChain.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BlockChain.hs index a5b87a423bf..03951fc29ef 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BlockChain.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BlockChain.hs @@ -74,6 +74,7 @@ import Cardano.Binary ) import qualified Cardano.Crypto.Hash.Class as Hash import qualified Cardano.Crypto.KES as KES +import Cardano.Crypto.Util (SignableRepresentation (..)) import qualified Cardano.Crypto.VRF as VRF import Cardano.Prelude ( AllowThunksIn (..), @@ -236,7 +237,7 @@ bbHash (TxSeq' _ bodies wits md) = -- This should be directly hashing the provided bytes with no funny business. hashStrict :: ByteString -> Hash crypto ByteString hashStrict = Hash.hashWithSerialiser encodePreEncoded - hashPart = Hash.getHash . hashStrict . BSL.toStrict + hashPart = Hash.hashToBytes . hashStrict . BSL.toStrict -- | HashHeader to Nonce hashHeaderToNonce :: HashHeader crypto -> Nonce @@ -397,6 +398,12 @@ data BHBody crypto = BHBody } deriving (Show, Eq, Generic) +instance + Crypto crypto => + SignableRepresentation (BHBody crypto) + where + getSignableRepresentation = serialize' + instance Crypto crypto => NoUnexpectedThunks (BHBody crypto) @@ -619,12 +626,12 @@ mkSeed ucNonce (SlotNo slot) eNonce = Nonce h -> Hash.xor (Hash.castHash h) ) . Hash.castHash - . Hash.hashRaw id + . Hash.hashWith id . runByteBuilder (8 + 32) $ BS.word64BE slot <> ( case eNonce of NeutralNonce -> mempty - Nonce h -> BS.byteStringCopy (Hash.getHash h) + Nonce h -> BS.byteStringCopy (Hash.hashToBytes h) ) -- | Check that the certified input natural is valid for being slot leader. This diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs index e5ca21d0183..742c9675e06 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Genesis.hs @@ -24,10 +24,6 @@ where import Cardano.Crypto (ProtocolMagicId) import qualified Cardano.Crypto.Hash.Class as Crypto - ( Hash (..), - castHash, - hashRaw, - ) import Cardano.Crypto.KES.Class (totalPeriodsKES) import Cardano.Prelude (NoUnexpectedThunks) import Cardano.Slotting.Slot (EpochSize (..)) @@ -211,7 +207,7 @@ initialFundsPseudoTxIn addr = Crypto.Hash (HASH c) (Addr c) -> Crypto.Hash (HASH c) (TxBody c) ) - . Crypto.hashRaw serialiseAddr + . Crypto.hashWith serialiseAddr {------------------------------------------------------------------------------- Genesis validation diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Keys.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Keys.hs index 0a9f4417e60..b1d29a829f0 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Keys.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Keys.hs @@ -47,7 +47,7 @@ module Shelley.Spec.Ledger.Keys -- * Re-exports from cardano-crypto-class DSIGN.decodeSignedDSIGN, DSIGN.encodeSignedDSIGN, - Hash.hash, + Hash.hashWithSerialiser, KES.decodeSignedKES, KES.decodeVerKeyKES, KES.encodeSignedKES, diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/MetaData.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/MetaData.hs index 899653d39c7..44f0a237e4c 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/MetaData.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/MetaData.hs @@ -37,7 +37,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import GHC.Generics (Generic) import Shelley.Spec.Ledger.Crypto (Crypto) -import Shelley.Spec.Ledger.Keys (Hash, hash) +import Shelley.Spec.Ledger.Keys (Hash, hashWithSerialiser) import Shelley.Spec.Ledger.Serialization (mapFromCBOR, mapToCBOR) -- | A generic metadatum type. @@ -132,4 +132,4 @@ hashMetaData :: Crypto crypto => MetaData -> MetaDataHash crypto -hashMetaData = MetaDataHash . hash +hashMetaData = MetaDataHash . hashWithSerialiser toCBOR diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Orphans.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Orphans.hs index d038fa15698..ba73e60eed5 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Orphans.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Orphans.hs @@ -2,6 +2,8 @@ module Shelley.Spec.Ledger.Orphans where +import qualified Cardano.Crypto.Hash as Hash +import Cardano.Crypto.Util (SignableRepresentation (..)) import qualified Cardano.Crypto.Wallet as WC import Cardano.Prelude (NFData (rnf), NoUnexpectedThunks (..), readEither) import Cardano.Slotting.Slot (WithOrigin (..)) @@ -59,3 +61,6 @@ instance NFData BlockNo instance NoUnexpectedThunks WC.XSignature where whnfNoUnexpectedThunks ctxt s = whnfNoUnexpectedThunks ctxt (WC.unXSignature s) showTypeOf _proxy = "XSignature" + +instance SignableRepresentation (Hash.Hash a b) where + getSignableRepresentation = Hash.hashToBytes diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Cardano/Crypto/VRF/Fake.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Cardano/Crypto/VRF/Fake.hs index d58341143cd..e5c78a45ded 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Cardano/Crypto/VRF/Fake.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Cardano/Crypto/VRF/Fake.hs @@ -66,7 +66,7 @@ instance SneakilyContainResult Seed where type Payload Seed = Seed sneakilyExtractResult s sk = OutputVRF - . getHash + . hashToBytes . hashWithSerialiser @MD5 id $ toCBOR s <> toCBOR sk unsneakilyExtractPayload = id @@ -138,7 +138,7 @@ evalVRF' a sk@(SignKeyFakeVRF n) = let y = sneakilyExtractResult a sk p = unsneakilyExtractPayload a realValue = - fromIntegral . fromHash + fromIntegral . bytesToNatural . hashToBytes . hashWithSerialiser @MD5 id $ toCBOR p <> toCBOR sk in (y, CertFakeVRF n realValue) diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address.hs index ef9b37046ec..ef2f492a126 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address.hs @@ -24,6 +24,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base16.Lazy as LB16 import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Short as SBS import Data.Proxy (Proxy (..)) import GHC.Stack (HasCallStack) import Shelley.Spec.Ledger.Address @@ -119,12 +120,12 @@ goldenTests_MockCrypto = where keyHash :: Credential kh (ConcreteCrypto ShortHash) keyHash = - KeyHashObj . KeyHash . UnsafeHash . fst $ - B16.decode "01020304" + KeyHashObj . KeyHash . UnsafeHash $ + "01020304" scriptHash :: Credential kh (ConcreteCrypto ShortHash) scriptHash = - ScriptHashObj . ScriptHash . UnsafeHash . fst $ - B16.decode "05060708" + ScriptHashObj . ScriptHash . UnsafeHash $ + "05060708" ptr :: Ptr ptr = Ptr (SlotNo 128) 2 3 @@ -191,7 +192,7 @@ goldenTests_ShelleyCrypto = -- and should be 28-byte in the aftermath keyBlake2b224 :: BS.ByteString -> Credential kh ShelleyCrypto keyBlake2b224 vk = - KeyHashObj . KeyHash . UnsafeHash $ hk + KeyHashObj . KeyHash . UnsafeHash $ SBS.toShort hk where hash = digest (Proxy :: Proxy Blake2b_224) vk' = invariantSize 32 vk diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address/Bootstrap.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address/Bootstrap.hs index 089cc1d5c66..80382978c21 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address/Bootstrap.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Address/Bootstrap.hs @@ -25,6 +25,7 @@ import qualified Cardano.Crypto.Wallet as Byron import Cardano.Prelude ( ByteString, ) +import Data.ByteString.Short (ShortByteString) import Data.Coerce ( coerce, ) @@ -225,7 +226,7 @@ aliceBadWitness = bobAddr :: Addr C bobAddr = Addr Testnet (KeyHashObj $ coerce someHash) StakeRefNull where - someHash = "someHash" :: ByteString + someHash = "someHash" :: ShortByteString coinsToBob :: Coin coinsToBob = 1000 diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples.hs index c0433fddb19..c3c51cbcfeb 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples.hs @@ -109,6 +109,7 @@ import Cardano.Prelude (asks) import Cardano.Slotting.Slot (EpochSize (..), WithOrigin (..)) import Control.State.Transition.Extended hiding (Assertion) import qualified Data.ByteString.Char8 as BS (pack) +import Data.ByteString.Short (ShortByteString) import Data.Coerce (coerce) import Data.List (foldl') import qualified Data.List @@ -180,7 +181,6 @@ import Shelley.Spec.Ledger.Keys KeyRole (..), asWitness, coerceKeyRole, - hash, hashKey, vKey, ) @@ -523,10 +523,12 @@ alicePoolParams = -- For our purposes in this test we can bootstrap the chain by just coercing the value. -- When this transition actually occurs, the consensus layer will do the work of making -- sure that the hash gets translated across the fork -lastByronHeaderHash :: forall proxy h. HashAlgorithm h => proxy h -> HashHeader h -lastByronHeaderHash _ = HashHeader $ coerce (hash 0 :: Hash (ConcreteCrypto h) Int) +lastByronHeaderHash :: forall proxy h. proxy h -> HashHeader h +lastByronHeaderHash _ = + HashHeader $ + coerce ("0" :: ShortByteString) -nonce0 :: HashAlgorithm h => proxy h -> Nonce +nonce0 :: proxy h -> Nonce nonce0 p = hashHeaderToNonce (lastByronHeaderHash p) carlPay :: KeyPair h 'Payment diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Core.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Core.hs index 462d47eb143..948d1139acd 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Core.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Core.hs @@ -52,6 +52,7 @@ module Test.Shelley.Spec.Ledger.Generator.Core ) where +import Cardano.Binary (toCBOR) import Cardano.Crypto.Hash (HashAlgorithm) import qualified Cardano.Crypto.Hash as Hash import Control.Monad (replicateM) @@ -185,6 +186,7 @@ import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes pattern KeyPair, ) import Test.Shelley.Spec.Ledger.Generator.Constants (Constants (..)) +import Test.Shelley.Spec.Ledger.Orphans () import Test.Shelley.Spec.Ledger.Utils ( epochFromSlotNo, evolveKESUntil, @@ -602,7 +604,8 @@ genesisId :: (Crypto c) => Ledger.TxId c genesisId = TxId $ - Hash.hash + Hash.hashWithSerialiser + toCBOR ( TxBody Set.empty StrictSeq.Empty diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Genesis.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Genesis.hs index 378fb7a284f..4ea11b669c3 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Genesis.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Genesis.hs @@ -13,6 +13,7 @@ import Cardano.Crypto.VRF.Class import Cardano.Prelude (Natural, Word32, Word64, Word8) import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..)) import qualified Data.ByteString as BS +import qualified Data.ByteString.Short as SBS import Data.Fixed import qualified Data.Map.Strict as Map import Data.Proxy @@ -153,7 +154,7 @@ genCredential = ] genHash :: forall c a. HashAlgorithm (HASH c) => Gen (Hash c a) -genHash = UnsafeHash . BS.pack <$> genWords numBytes +genHash = UnsafeHash . SBS.toShort . BS.pack <$> genWords numBytes where numBytes = fromIntegral $ sizeHash ([] @(HASH c)) diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Trace/Chain.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Trace/Chain.hs index 95f45f439b1..6cd9a357ff2 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Trace/Chain.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Trace/Chain.hs @@ -16,6 +16,7 @@ module Test.Shelley.Spec.Ledger.Generator.Trace.Chain where import Cardano.Crypto.Hash (HashAlgorithm) +import Cardano.Crypto.Hash (Hash (..)) import Cardano.Slotting.Slot (WithOrigin (..)) import Control.Monad.Trans.Reader (runReaderT) import Control.State.Transition (IRC (..)) @@ -27,6 +28,7 @@ import Control.State.Transition.Trace.Generator.QuickCheck shrinkSignal, sigGen, ) +import Data.ByteString.Short (ShortByteString) import Data.Coerce (coerce) import Data.Functor.Identity (runIdentity) import Data.Map.Strict (Map) @@ -39,7 +41,7 @@ import Shelley.Spec.Ledger.BlockChain hashHeaderToNonce, pattern HashHeader, ) -import Shelley.Spec.Ledger.Keys (Hash, KeyRole (BlockIssuer), coerceKeyRole, hash) +import Shelley.Spec.Ledger.Keys (KeyRole (BlockIssuer), coerceKeyRole) import Shelley.Spec.Ledger.LedgerState (esAccountState, nesEs, overlaySchedule, _treasury) import Shelley.Spec.Ledger.STS.Chain (chainNes, initialShelleyState) import qualified Shelley.Spec.Ledger.STS.Chain as STS (ChainState (ChainState)) @@ -49,7 +51,6 @@ import Test.QuickCheck (Gen) import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes ( CHAIN, ChainState, - ConcreteCrypto, GenDelegs, HashHeader, KeyHash, @@ -80,8 +81,8 @@ instance HashAlgorithm h => HasTrace (CHAIN h) (GenEnv h) where -- For our purposes we can bootstrap the chain by just coercing the value. -- When this transition actually occurs, the consensus layer will do the work of making -- sure that the hash gets translated across the fork -lastByronHeaderHash :: forall proxy h. HashAlgorithm h => proxy h -> HashHeader h -lastByronHeaderHash _ = HashHeader $ coerce (hash 0 :: Hash (ConcreteCrypto h) Int) +lastByronHeaderHash :: forall proxy h. proxy h -> HashHeader h +lastByronHeaderHash _ = HashHeader $ coerce ("0" :: ShortByteString) -- Note: this function must be usable in place of 'applySTS' and needs to align -- with the signature 'RuleContext sts -> Gen (Either [[PredicateFailure sts]] (State sts))'. diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Orphans.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Orphans.hs index 8129f889245..a2e5e31dd7f 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Orphans.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Orphans.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} @@ -6,10 +7,20 @@ module Test.Shelley.Spec.Ledger.Orphans () where +import Cardano.Binary (serializeEncoding', toCBOR) import qualified Cardano.Crypto.DSIGN as DSIGN +import qualified Cardano.Crypto.KES as KES +import Cardano.Crypto.Util (SignableRepresentation (..)) +import Numeric.Natural (Natural) import Shelley.Spec.Ledger.Crypto import Shelley.Spec.Ledger.Keys +import Shelley.Spec.Ledger.OCert (KESPeriod (..)) -- We need this here for the tests, but should not be in the actual library because -- a Num instance for this type does not make sense in the general case. deriving instance Num (DSIGN.VerKeyDSIGN (DSIGN crypto)) => Num (VKey kd crypto) + +instance (KES.KESAlgorithm c) => SignableRepresentation (KES.VerKeyKES c, Natural, KESPeriod) where + getSignableRepresentation (vk, nat, KESPeriod p) = + serializeEncoding' $ + KES.encodeVerKeyKES vk <> toCBOR nat <> toCBOR p diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Rewards.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Rewards.hs index df766507fa2..566c4c9cb16 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Rewards.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Rewards.hs @@ -8,12 +8,14 @@ module Test.Shelley.Spec.Ledger.Rewards (rewardTests) where +import Cardano.Binary (toCBOR) import qualified Cardano.Crypto.DSIGN as Crypto -import Cardano.Crypto.Hash (Hash (UnsafeHash), MD5, ShortHash, hash) +import Cardano.Crypto.Hash (Hash (UnsafeHash), MD5, ShortHash) import Cardano.Crypto.Seed (mkSeedFromBytes) import qualified Cardano.Crypto.VRF as Crypto import Cardano.Slotting.Slot (EpochSize (..)) import Control.Monad (replicateM) +import qualified Data.ByteString.Short as SBS import Data.Coerce (coerce) import Data.Foldable (fold) import Data.Map (Map) @@ -42,6 +44,7 @@ import Shelley.Spec.Ledger.Keys KeyRole (..), VKey (..), hashKey, + hashWithSerialiser, vKey, ) import Shelley.Spec.Ledger.PParams @@ -111,13 +114,19 @@ keyPair :: Crypto c => Int -> KeyPair r c keyPair seed = KeyPair vk sk where vk = VKey (Crypto.deriveVerKeyDSIGN sk) - sk = Crypto.genKeyDSIGN $ mkSeedFromBytes . coerce $ hash @MD5 seed + sk = + Crypto.genKeyDSIGN $ + mkSeedFromBytes . SBS.fromShort . coerce $ + hashWithSerialiser @MD5 toCBOR seed vrfKeyPair :: forall v. Crypto.VRFAlgorithm v => Int -> (Crypto.SignKeyVRF v, Crypto.VerKeyVRF v) vrfKeyPair seed = (sk, vk) where vk = Crypto.deriveVerKeyVRF sk - sk = Crypto.genKeyVRF $ mkSeedFromBytes . coerce $ hash @MD5 seed + sk = + Crypto.genKeyVRF $ + mkSeedFromBytes . SBS.fromShort . coerce $ + hashWithSerialiser @MD5 toCBOR seed data PoolSetUpArgs crypto f = PoolSetUpArgs { poolPledge :: f Coin, diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Serialization.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Serialization.hs index 7393d292fbd..30ba68133be 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Serialization.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Serialization.hs @@ -22,7 +22,7 @@ import Cardano.Binary toCBOR, ) import Cardano.Crypto.DSIGN (encodeSignedDSIGN, encodeVerKeyDSIGN) -import Cardano.Crypto.Hash (HashAlgorithm, getHash) +import Cardano.Crypto.Hash (HashAlgorithm) import qualified Cardano.Crypto.Hash as Monomorphic import Cardano.Prelude (LByteString) import Codec.CBOR.Encoding (Encoding (..), Tokens (..)) @@ -105,8 +105,8 @@ import Shelley.Spec.Ledger.Keys KeyRole (..), asWitness, encodeSignedKES, - hash, hashKey, + hashWithSerialiser, sKey, signedDSIGN, signedKES, @@ -289,19 +289,19 @@ checkEncodingCBORCBORGroup name x t = in checkEncoding toCBORGroup d name x t getRawKeyHash :: KeyHash h 'Payment -> ByteString -getRawKeyHash (KeyHash hsh) = getHash hsh +getRawKeyHash (KeyHash hsh) = Monomorphic.hashToBytes hsh getRawGenKeyHash :: KeyHash h 'Genesis -> ByteString -getRawGenKeyHash (KeyHash hsh) = getHash hsh +getRawGenKeyHash (KeyHash hsh) = Monomorphic.hashToBytes hsh getRawScriptHash :: ScriptHash h -> ByteString -getRawScriptHash (ScriptHash hsh) = getHash hsh +getRawScriptHash (ScriptHash hsh) = Monomorphic.hashToBytes hsh getRawTxId :: TxId h -> ByteString -getRawTxId = getHash . _unTxId +getRawTxId = Monomorphic.hashToBytes . _unTxId getRawNonce :: Nonce -> ByteString -getRawNonce (Nonce hsh) = getHash hsh +getRawNonce (Nonce hsh) = Monomorphic.hashToBytes hsh getRawNonce NeutralNonce = error "The neutral nonce has no bytes" testGKey :: GenesisKeyPair h @@ -417,7 +417,7 @@ testScriptHash2 = hashScript (testScript2 p) p = Proxy testHeaderHash :: forall proxy h. proxy h -> HashAlgorithm h => HashHeader h -testHeaderHash _ = HashHeader $ coerce (hash 0 :: Hash (ConcreteCrypto h) Int) +testHeaderHash _ = HashHeader $ coerce (hashWithSerialiser toCBOR 0 :: Hash (ConcreteCrypto h) Int) testBHB :: forall proxy h. HashAlgorithm h => proxy h -> BHBody h testBHB p = diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/SerializationProperties.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/SerializationProperties.hs index 2cd2bfdf0b0..b841a4bcd86 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/SerializationProperties.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/SerializationProperties.hs @@ -40,6 +40,7 @@ import Cardano.Crypto.DSIGN.Mock (MockDSIGN, VerKeyDSIGN (..)) import Cardano.Crypto.Hash (HashAlgorithm) import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Hash as Monomorphic +import Cardano.Crypto.Hash (hashWithSerialiser) import Cardano.Slotting.Block (BlockNo (..)) import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..)) import Codec.CBOR.Decoding (Decoder) @@ -88,7 +89,6 @@ import Shelley.Spec.Ledger.Keys ( Hash, KeyHash (KeyHash), VKey (VKey), - hash, ) import Shelley.Spec.Ledger.LedgerState ( AccountState, @@ -185,7 +185,7 @@ genHash :: forall a c. Crypto c => Proxy c -> Gen (Hash c a) genHash proxy = mkDummyHash proxy <$> arbitrary mkDummyHash :: forall c a. Crypto c => Proxy c -> Int -> Hash c a -mkDummyHash _ = coerce . hash @(HASH c) +mkDummyHash _ = coerce . hashWithSerialiser @(HASH c) toCBOR {------------------------------------------------------------------------------- Serialization Properties diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Utils.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Utils.hs index d3dd8accbaa..a22c0c779d6 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Utils.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Utils.hs @@ -34,7 +34,12 @@ where import Cardano.Binary (ToCBOR (..)) import Cardano.Crypto.DSIGN (deriveVerKeyDSIGN, genKeyDSIGN) -import Cardano.Crypto.Hash (Hash (UnsafeHash), HashAlgorithm, MD5, hash) +import Cardano.Crypto.Hash + ( Hash (UnsafeHash), + HashAlgorithm, + MD5, + hashWithSerialiser, + ) import Cardano.Crypto.KES (deriveVerKeyKES, genKeyKES) import Cardano.Crypto.Seed (Seed, mkSeedFromBytes) import Cardano.Crypto.VRF (deriveVerKeyVRF, evalCertified, genKeyVRF) @@ -47,6 +52,7 @@ import Control.State.Transition.Trace (.-), (.->), ) +import qualified Data.ByteString.Short as SBS import Data.Coerce (coerce) import Data.Functor ((<&>)) import Data.Functor.Identity (runIdentity) @@ -65,7 +71,13 @@ import Shelley.Spec.Ledger.BaseTypes ) import Shelley.Spec.Ledger.Coin (Coin (..)) import Shelley.Spec.Ledger.Credential (Credential (..), StakeReference (..)) -import Shelley.Spec.Ledger.Keys (KeyRole (..), hashKey, updateKES, vKey, pattern KeyPair) +import Shelley.Spec.Ledger.Keys + ( KeyRole (..), + hashKey, + updateKES, + vKey, + pattern KeyPair, + ) import Shelley.Spec.Ledger.OCert (KESPeriod (..)) import Shelley.Spec.Ledger.Slot (EpochNo, EpochSize (..), SlotNo) import Test.Cardano.Crypto.VRF.Fake (WithResult (..)) @@ -98,7 +110,7 @@ mkSeedFromWords :: (Word64, Word64, Word64, Word64, Word64) -> Seed mkSeedFromWords stuff = - mkSeedFromBytes . coerce $ hash @MD5 stuff + mkSeedFromBytes . SBS.fromShort . coerce $ hashWithSerialiser @MD5 toCBOR stuff -- | For testing purposes, generate a deterministic genesis key pair given a seed. mkGenKey :: (Word64, Word64, Word64, Word64, Word64) -> (SignKeyDSIGN h, VKeyGenesis h) diff --git a/stack.yaml b/stack.yaml index 7cf1f761176..4ac18395d71 100644 --- a/stack.yaml +++ b/stack.yaml @@ -37,7 +37,7 @@ extra-deps: - test - git: https://github.com/input-output-hk/cardano-base - commit: c454b6e791ee2fe84508b4d5ed2c4dedafb7dce4 + commit: 7d795c3040ea7785812efa1c97864bbb41b15d3e subdirs: - binary - binary/test