diff --git a/.buildkite/default.nix b/.buildkite/default.nix index 08ecbbf956b..acb9e201439 100644 --- a/.buildkite/default.nix +++ b/.buildkite/default.nix @@ -1,8 +1,7 @@ { pkgs ? import ../nix {} -, commonLib ? pkgs.commonLib }: -commonLib.haskellBuildUtils.stackRebuild { +pkgs.haskellBuildUtils.stackRebuild { script = ./rebuild.hs; buildTools = []; libs = ps: []; diff --git a/nix/haskell.nix b/nix/haskell.nix index ea201861cb2..e47b13d6584 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -3,6 +3,7 @@ ############################################################################ { lib , stdenv +, pkgs , haskell-nix , buildPackages , config ? {} @@ -23,8 +24,9 @@ let packages.cs-blockchain.configureFlags = [ "--ghc-option=-Werror" ]; packages.cs-ledger.configureFlags = [ "--ghc-option=-Werror" ]; packages.delegation.configureFlags = [ "--ghc-option=-Werror" ]; - packages.non-integer.configureFlags = [ "--ghc-option=-Werror" ]; + packages.shelley-spec-non-integral.configureFlags = [ "--ghc-option=-Werror" ]; packages.small-steps.configureFlags = [ "--ghc-option=-Werror" ]; + packages.shelley-spec-ledger.components.tests.shelley-spec-ledger-test.build-tools = [pkgs.cddl pkgs.cbor-diag]; enableLibraryProfiling = profiling; # Disable doctests for now (waiting for https://github.com/input-output-hk/haskell.nix/pull/427): packages.small-steps.components.tests.doctests.buildable = lib.mkForce false; diff --git a/nix/pkgs.nix b/nix/pkgs.nix index 274d2bcd340..aa72112c9fa 100644 --- a/nix/pkgs.nix +++ b/nix/pkgs.nix @@ -4,6 +4,7 @@ pkgs: _: with pkgs; { inherit config lib stdenv + pkgs haskell-nix buildPackages ; diff --git a/nix/sources.json b/nix/sources.json index 7f3f15ab8a2..62927959e6e 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -5,10 +5,10 @@ "homepage": "https://input-output-hk.github.io/haskell.nix", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "6a2fe9ae07de5be7d3cf5410af556ce2f06a0a7d", - "sha256": "0bj7iivivjlfnhcag1dy0g6asyib8r1hsk1g3n51wpar4grgqyyq", + "rev": "8099da8fe035efe49e81a6eb974eea9e5656b9c6", + "sha256": "195rldxg6bmhxfrjz0bzqs0099wiq956wv49fz1i6h6rznaxy5y4", "type": "tarball", - "url": "https://github.com/input-output-hk/haskell.nix/archive/6a2fe9ae07de5be7d3cf5410af556ce2f06a0a7d.tar.gz", + "url": "https://github.com/input-output-hk/haskell.nix/archive/8099da8fe035efe49e81a6eb974eea9e5656b9c6.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "iohk-nix": { @@ -17,10 +17,10 @@ "homepage": null, "owner": "input-output-hk", "repo": "iohk-nix", - "rev": "083761953f5f74ec12e803aa735b460cde9985c8", - "sha256": "16xdndn57br83ayq9xj7f0f7milwqgr5c2sak3ps033n4ndxfsxg", + "rev": "30cf81c421d7fca198660e1e995038dd8b6f3d13", + "sha256": "0sy9gza5gsrbqfbizp0dd98njnymigchj0aszswkfzxndskknarj", "type": "tarball", - "url": "https://github.com/input-output-hk/iohk-nix/archive/083761953f5f74ec12e803aa735b460cde9985c8.tar.gz", + "url": "https://github.com/input-output-hk/iohk-nix/archive/30cf81c421d7fca198660e1e995038dd8b6f3d13.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/shell.nix b/shell.nix index 5ee3764b662..42b6826cd1f 100644 --- a/shell.nix +++ b/shell.nix @@ -18,9 +18,9 @@ let packages = ps: with ps; [ cs-blockchain cs-ledger - non-integer + shelley-spec-non-integral small-steps - delegation + shelley-spec-ledger ]; # These programs will be available inside the nix-shell. diff --git a/shelley/chain-and-ledger/cddl-spec b/shelley/chain-and-ledger/cddl-spec new file mode 120000 index 00000000000..197f7a6b4c9 --- /dev/null +++ b/shelley/chain-and-ledger/cddl-spec @@ -0,0 +1 @@ +executable-spec/cddl-files/ \ No newline at end of file diff --git a/shelley/chain-and-ledger/cddl-spec/mock/crypto.cddl b/shelley/chain-and-ledger/executable-spec/cddl-files/mock/crypto.cddl similarity index 100% rename from shelley/chain-and-ledger/cddl-spec/mock/crypto.cddl rename to shelley/chain-and-ledger/executable-spec/cddl-files/mock/crypto.cddl diff --git a/shelley/chain-and-ledger/cddl-spec/mock/finset.cddl b/shelley/chain-and-ledger/executable-spec/cddl-files/mock/finset.cddl similarity index 100% rename from shelley/chain-and-ledger/cddl-spec/mock/finset.cddl rename to shelley/chain-and-ledger/executable-spec/cddl-files/mock/finset.cddl diff --git a/shelley/chain-and-ledger/cddl-spec/shelley.cddl b/shelley/chain-and-ledger/executable-spec/cddl-files/shelley.cddl similarity index 94% rename from shelley/chain-and-ledger/cddl-spec/shelley.cddl rename to shelley/chain-and-ledger/executable-spec/cddl-files/shelley.cddl index 377a86d796a..e541a1e3ad1 100644 --- a/shelley/chain-and-ledger/cddl-spec/shelley.cddl +++ b/shelley/chain-and-ledger/executable-spec/cddl-files/shelley.cddl @@ -2,10 +2,12 @@ block = [ header - , transaction_bodies : [* transaction_body] ; 19 - , transaction_witness_sets : [* transaction_witness_set] ; 20 + , transaction_bodies : [* transaction_body] + , transaction_witness_sets : [* transaction_witness_set] , transaction_metadata_set : { * transaction_index => transaction_metadata } - ] + ]; Valid blocks must also satisfy the following two constraints: + ; 1) the length of transaction_bodies and transaction_witness_sets must be the same + ; 2) every transaction_index must be strictly smaller than the length of transaction_bodies transaction = [transaction_body, transaction_witness_set, [?transaction_metadata]] diff --git a/shelley/chain-and-ledger/executable-spec/shelley-spec-ledger.cabal b/shelley/chain-and-ledger/executable-spec/shelley-spec-ledger.cabal index 3806bfb15a6..aca629590f3 100644 --- a/shelley/chain-and-ledger/executable-spec/shelley-spec-ledger.cabal +++ b/shelley/chain-and-ledger/executable-spec/shelley-spec-ledger.cabal @@ -5,6 +5,10 @@ author: IOHK Formal Methods Team maintainer: formal.methods@iohk.io build-type: Simple cabal-version: >=1.8 +extra-source-files: + cddl-files/shelley.cddl + cddl-files/mock/crypto.cddl + cddl-files/mock/finset.cddl source-repository head type: git 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 56c03e2358c..23b732dad22 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 @@ -7,6 +7,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} @@ -17,7 +18,7 @@ module Shelley.Spec.Ledger.BlockChain , BHBody(..) , BHeader(..) , Block(..) - , ProtVer(..) + , LaxBlock(..) , TxSeq(..) , bhHash , bbHash @@ -54,8 +55,8 @@ import GHC.Generics (Generic) import Numeric.Natural (Natural) import Shelley.Spec.Ledger.MetaData (MetaData) -import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR), decodeListLen, encodeListLen, - matchSize, serializeEncoding') +import Cardano.Binary (Decoder, FromCBOR (fromCBOR), ToCBOR (toCBOR), decodeListLen, + encodeListLen, matchSize, serializeEncoding') import Cardano.Crypto.Hash (SHA256) import qualified Cardano.Crypto.Hash.Class as Hash import qualified Cardano.Crypto.VRF.Class as VRF @@ -69,7 +70,8 @@ import Shelley.Spec.Ledger.EpochBoundary (BlocksMade (..)) import Shelley.Spec.Ledger.Keys (Hash, KESig, KeyHash, VKey, VRFValue (..), hash, hashKey, hashKeyVRF) import Shelley.Spec.Ledger.OCert (OCert (..)) -import Shelley.Spec.Ledger.PParams (ActiveSlotCoeff, activeSlotLog, activeSlotVal) +import Shelley.Spec.Ledger.PParams (ActiveSlotCoeff, ProtVer (..), activeSlotLog, + activeSlotVal) import Shelley.Spec.Ledger.Serialization (CBORGroup (..), CBORMap (..), CborSeq (..), FromCBORGroup (..), ToCBORGroup (..)) import Shelley.Spec.Ledger.Slot (BlockNo (..), SlotNo (..)) @@ -162,26 +164,6 @@ instance Crypto crypto sig <- fromCBOR pure $ BHeader bhb sig -data ProtVer = ProtVer Natural Natural Natural - deriving (Show, Eq, Generic, Ord) - deriving ToCBOR via (CBORGroup ProtVer) - -instance NoUnexpectedThunks ProtVer - -instance ToCBORGroup ProtVer where - toCBORGroup (ProtVer x y z) = - toCBOR x - <> toCBOR y - <> toCBOR z - listLen _ = 3 - -instance FromCBORGroup ProtVer where - fromCBORGroup = do - x <- fromCBOR - y <- fromCBOR - z <- fromCBOR - pure $ ProtVer x y z - data BHBody crypto = BHBody { -- | Hash of the previous block header bheaderPrev :: HashHeader crypto @@ -285,33 +267,46 @@ instance Crypto crypto <> toCBORGroup h <> toCBORGroup txns -instance Crypto crypto - => FromCBOR (Block crypto) - where - fromCBOR = do - n <- decodeListLen - header <- fromCBORGroup - matchSize "Block" ((fromIntegral . toInteger . listLen) header + 3) n - bodies <- unwrapCborSeq <$> fromCBOR - wits <- unwrapCborSeq <$> fromCBOR - let b = length bodies - w = length wits - - metadata <- constructMetaData b . unwrapCBORMap <$> fromCBOR - let m = length metadata - - unless (b == w) +blockDecoder :: Crypto crypto => Bool -> forall s. Decoder s (Block crypto) +blockDecoder lax = do + n <- decodeListLen + header <- fromCBORGroup + matchSize "Block" ((fromIntegral . toInteger . listLen) header + 3) n + bodies <- unwrapCborSeq <$> fromCBOR + wits <- unwrapCborSeq <$> fromCBOR + let b = length bodies + w = length wits + + metadata <- constructMetaData b . unwrapCBORMap <$> fromCBOR + let m = length metadata + + unless (lax || b == w) (fail $ "different number of transaction bodies (" <> show b <> ") and witness sets (" <> show w <> ")" ) - unless (b == m) + unless (lax || b == m) (fail $ "mismatch between transaction bodies (" <> show b <> ") and metadata (" <> show w <> ")" ) - let txns = Seq.zipWith3 cborWitsToTx bodies wits metadata - pure $ Block header (TxSeq txns) + let txns = Seq.zipWith3 cborWitsToTx bodies wits metadata + pure $ Block header (TxSeq txns) + +instance Crypto crypto + => FromCBOR (Block crypto) + where + fromCBOR = blockDecoder False + +newtype LaxBlock crypto + = LaxBlock (Block crypto) + deriving (Show, Eq) + deriving ToCBOR via (Block crypto) + +instance Crypto crypto + => FromCBOR (LaxBlock crypto) + where + fromCBOR = LaxBlock <$> blockDecoder True bHeaderSize :: forall crypto. (Crypto crypto) diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/PParams.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/PParams.hs index ae4db04d30e..151b6772ff9 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/PParams.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/PParams.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -32,6 +34,7 @@ module Shelley.Spec.Ledger.PParams , mkActiveSlotCoeff , activeSlotVal , activeSlotLog + , ProtVer(..) ) where import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, enforceSize) @@ -42,6 +45,8 @@ import Numeric.Natural (Natural) import Shelley.Spec.Ledger.BaseTypes (FixedPoint, Nonce (NeutralNonce), UnitInterval, fpPrecision, interval0, intervalValue) import Shelley.Spec.Ledger.Coin (Coin (..)) +import Shelley.Spec.Ledger.Serialization (CBORGroup (..), FromCBORGroup (..), + ToCBORGroup (..)) import Shelley.Spec.Ledger.Slot (EpochNo (..)) import Shelley.Spec.NonIntegral (ln') @@ -89,7 +94,7 @@ data PParams = PParams -- | Extra entropy , _extraEntropy :: Nonce -- | Protocol version - , _protocolVersion :: (Natural, Natural) + , _protocolVersion :: ProtVer } deriving (Show, Eq, Generic) data ActiveSlotCoeff = @@ -133,6 +138,23 @@ activeSlotVal = unActiveSlotVal activeSlotLog :: ActiveSlotCoeff -> FixedPoint activeSlotLog f = (fromIntegral $ unActiveSlotLog f) / fpPrecision +data ProtVer = ProtVer Natural Natural + deriving (Show, Eq, Generic, Ord) + deriving ToCBOR via (CBORGroup ProtVer) + deriving FromCBOR via (CBORGroup ProtVer) + +instance NoUnexpectedThunks ProtVer + +instance ToCBORGroup ProtVer where + toCBORGroup (ProtVer x y) = toCBOR x <> toCBOR y + listLen _ = 2 + +instance FromCBORGroup ProtVer where + fromCBORGroup = do + x <- fromCBOR + y <- fromCBOR + pure $ ProtVer x y + instance NoUnexpectedThunks PParams instance ToCBOR PParams @@ -179,7 +201,7 @@ instance ToCBOR PParams <> toCBOR activeSlotCoeff' <> toCBOR d' <> toCBOR extraEntropy' - <> toCBOR protocolVersion' + <> toCBORGroup protocolVersion' instance FromCBOR PParams where @@ -205,7 +227,7 @@ instance FromCBOR PParams <*> fromCBOR <*> fromCBOR <*> fromCBOR - <*> fromCBOR + <*> fromCBORGroup makeLenses ''PParams @@ -232,5 +254,5 @@ emptyPParams = , _activeSlotCoeff = mkActiveSlotCoeff interval0 , _d = interval0 , _extraEntropy = NeutralNonce - , _protocolVersion = (0, 0) + , _protocolVersion = ProtVer 0 0 } diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Chain.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Chain.hs index f01c46827bc..d3770598792 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Chain.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Chain.hs @@ -32,7 +32,8 @@ import Shelley.Spec.Ledger.LedgerState (AccountState (..), DPState (.. EpochState (..), LedgerState (..), NewEpochState (..), PState (..), UTxOState (..), emptyDState, emptyPState, getGKeys, updateNES, _genDelegs) import Shelley.Spec.Ledger.OCert (KESPeriod) -import Shelley.Spec.Ledger.PParams (PParams, _maxBBSize, _maxBHSize, _protocolVersion) +import Shelley.Spec.Ledger.PParams (PParams, ProtVer (..), _maxBBSize, _maxBHSize, + _protocolVersion) import Shelley.Spec.Ledger.Slot (BlockNo, EpochNo, SlotNo) import Shelley.Spec.Ledger.Tx (TxBody) import Shelley.Spec.Ledger.Updates (AVUpdate (..), Applications, PPUpdate (..), @@ -157,7 +158,7 @@ chainTransition = do let NewEpochState _ _ _ (EpochState _ _ _ pp) _ _ _ = nes maxpv <- liftSTS $ asks maxMajorPV - let (m, _) = _protocolVersion pp + let (ProtVer m _) = _protocolVersion pp m <= maxpv ?! ObsoleteNodeCHAIN m maxpv let bhb = bhbody bh diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Ppup.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Ppup.hs index cc263387548..158aae0c127 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Ppup.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Ppup.hs @@ -24,7 +24,6 @@ import Data.Typeable (Typeable) import Data.Word (Word8) import GHC.Generics (Generic) import Ledger.Core (dom, (⊆), (⨃)) -import Numeric.Natural (Natural) import Shelley.Spec.Ledger.BaseTypes import Shelley.Spec.Ledger.Keys import Shelley.Spec.Ledger.PParams @@ -104,8 +103,8 @@ instance 5 -> matchSize "PVCannotFollowPPUP" 1 n >> pure PVCannotFollowPPUP k -> invalidKey k -pvCanFollow :: (Natural, Natural) -> Ppm -> Bool -pvCanFollow (m, n) (ProtocolVersion (m', n')) +pvCanFollow :: ProtVer -> Ppm -> Bool +pvCanFollow (ProtVer m n) (ProtocolVersion (ProtVer m' n')) = (m+1, 0) == (m', n') || (m, n+1) == (m', n') pvCanFollow _ _ = True diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Serialization.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Serialization.hs index 6960ec9bc00..1c335eec4e7 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Serialization.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Serialization.hs @@ -4,6 +4,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} module Shelley.Spec.Ledger.Serialization ( ToCBORGroup (..) @@ -14,13 +15,14 @@ module Shelley.Spec.Ledger.Serialization , decodeList , decodeMapContents , encodeFoldable + , groupRecord ) where import Cardano.Binary (Decoder, Encoding, FromCBOR (..), ToCBOR (..), decodeBreakOr, - decodeListLen, decodeListLenOrIndef, decodeMapLenOrIndef, encodeBreak, - encodeListLen, encodeListLenIndef, encodeMapLen, encodeMapLenIndef, matchSize) -import Control.Monad (replicateM) + decodeListLenOrIndef, decodeMapLenOrIndef, encodeBreak, encodeListLen, + encodeListLenIndef, encodeMapLen, encodeMapLenIndef, matchSize) +import Control.Monad (replicateM, void) import Data.Foldable (foldl') import Data.Map (Map) import qualified Data.Map as Map @@ -41,12 +43,19 @@ class Typeable a => FromCBORGroup a where fromCBORGroup :: Decoder s a instance (FromCBORGroup a, ToCBORGroup a) => FromCBOR (CBORGroup a) where - fromCBOR = do - n <- decodeListLen - x <- fromCBORGroup - matchSize "CBORGroup" ((fromIntegral . toInteger . listLen) x) n - pure $ CBORGroup x - + fromCBOR = CBORGroup <$> groupRecord + +decodeRecord :: (a -> Int) -> Decoder s a -> Decoder s a +decodeRecord getRecordSize decode = do + lenOrIndef <- decodeListLenOrIndef + x <- decode + case lenOrIndef of + Just n -> matchSize "CBORGroup" (getRecordSize x) n + Nothing -> void decodeBreakOr -- TODO: make this give better errors + pure x + +groupRecord :: forall a s. (ToCBORGroup a, FromCBORGroup a) => Decoder s a +groupRecord = decodeRecord (fromIntegral . toInteger . listLen) fromCBORGroup newtype CBORMap a b = CBORMap { unwrapCBORMap :: Map a b } diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Updates.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Updates.hs index 167e6c386b0..36091d15d2b 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Updates.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Updates.hs @@ -51,7 +51,7 @@ import GHC.Generics (Generic) import Shelley.Spec.Ledger.BaseTypes (Nonce, Text64, UnitInterval) import Shelley.Spec.Ledger.Coin (Coin) import Shelley.Spec.Ledger.Keys (GenDelegs, GenKeyHash) -import Shelley.Spec.Ledger.PParams (ActiveSlotCoeff, PParams (..)) +import Shelley.Spec.Ledger.PParams (ActiveSlotCoeff, PParams (..), ProtVer) import Shelley.Spec.Ledger.Serialization (CBORMap (..), decodeMapContents) import Shelley.Spec.Ledger.Slot (EpochNo (..), SlotNo) @@ -155,7 +155,7 @@ data Ppm = MinFeeA Integer | ActiveSlotCoefficient ActiveSlotCoeff | D UnitInterval | ExtraEntropy Nonce - | ProtocolVersion (Natural, Natural) + | ProtocolVersion ProtVer deriving (Show, Ord, Eq, Generic) instance NoUnexpectedThunks Ppm diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs index 94235ce4d68..d32d0d59383 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs @@ -109,6 +109,8 @@ type UTxO = UTxO.UTxO ConcreteCrypto type Block = BlockChain.Block ConcreteCrypto +type LaxBlock = BlockChain.LaxBlock ConcreteCrypto + type BHBody = BlockChain.BHBody ConcreteCrypto type SKeyES = Keys.SKeyES ConcreteCrypto diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/CDDL.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/CDDL.hs index ac4fe1a6adc..9b4991ad34a 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/CDDL.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/CDDL.hs @@ -20,19 +20,27 @@ import qualified Data.ByteString.Lazy as BSL import Data.ByteString.Lazy.Char8 as Char8 (lines, unpack) import System.Process.ByteString.Lazy + + import Test.Tasty import Test.Tasty.HUnit import Shelley.Spec.Ledger.MetaData (MetaData) +import Shelley.Spec.Ledger.Serialization import Shelley.Spec.Ledger.Updates (PParamsUpdate) -import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (AVUpdate, DCert, MultiSig, PPUpdate, - Tx, TxBody, TxIn, TxOut, Update) +import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (AVUpdate, Addr, BHBody, BHeader, + DCert, LaxBlock, MultiSig, OCert, PPUpdate, Tx, TxBody, TxIn, TxOut, Update) cddlTests :: TestTree cddlTests = withResource combinedCDDL (const (pure ())) $ \cddl -> testGroup "CDDL roundtrip tests" $ - [ cddlTest @TxBody 30 "transaction_body" + [ + cddlGroupTest @BHeader 30 "header" + , cddlGroupTest @BHBody 30 "header_body" + , cddlGroupTest @OCert 30 "operational_cert" + , cddlGroupTest @Addr 20 "address" + , cddlTest @TxBody 30 "transaction_body" , cddlTest @TxOut 30 "transaction_output" , cddlTest @DCert 30 "delegation_certificate" , cddlTest @TxIn 30 "transaction_input" @@ -44,19 +52,14 @@ cddlTests = withResource combinedCDDL (const (pure ())) $ \cddl -> , cddlTest @PParamsUpdate 30 "protocol_param_update" , cddlTest @PParamsUpdate 30 "protocol_param_update" , cddlTest @Tx 30 "transaction" - -- TODO reenable tests below - --, cddlTest @Block 30 "block" - --, cddlTest @BHeader 30 "header" - --, cddlTest @BHBody 30 "header_body" - --, cddlTest @OCert 30 "operational_cert" - --, cddlTest @Addr 20 "address" + , cddlTest @LaxBlock 30 "block" ] <*> pure cddl combinedCDDL :: IO BSL.ByteString combinedCDDL = do - base <- BSL.readFile "../cddl-spec/shelley.cddl" - crypto <- BSL.readFile "../cddl-spec/mock/crypto.cddl" - finset <- BSL.readFile "../cddl-spec/mock/finset.cddl" + base <- BSL.readFile "cddl-files/shelley.cddl" + crypto <- BSL.readFile "cddl-files/mock/crypto.cddl" + finset <- BSL.readFile "cddl-files/mock/finset.cddl" pure $ base <> crypto <> finset cddlTest @@ -84,6 +87,33 @@ cddlTest n entryName cddlRes = testCase let reencoded = serialize decoded verifyConforming reencoded cddl +cddlGroupTest + :: forall a. (ToCBORGroup a, FromCBORGroup a) + => Int + -> BSL.ByteString + -> IO BSL.ByteString + -> TestTree +cddlGroupTest n entryName cddlRes = testCase + ("cddl roundtrip " <> show (typeRep (Proxy @a))) + $ do + basecddl <- cddlRes + let cddl = "output = [" <> entryName <> "]\n" <> basecddl + examples <- Char8.lines <$> generateCBORDiagStdIn n cddl :: IO [BSL.ByteString] + let decoder = groupRecord :: forall s. Decoder s a + forM_ examples $ \exampleDiag -> do + exampleBytes <- diagToBytes exampleDiag + decoded <- case decodeFullDecoder "CBORGroup" decoder exampleBytes of + Right x -> pure x + Left e -> + assertFailure $ Prelude.unlines + [ "Failed to deserialize" + , "Error: " <> show e + , "Data: " <> Char8.unpack exampleDiag + ] + let reencoded = serializeEncoding $ encodeListLen 1 <> toCBORGroup decoded + verifyConforming reencoded cddl + + data StdErr = StdErr Prelude.String BSL.ByteString instance Show StdErr where diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/Serialization.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/Serialization.hs index c2e42066113..65dc24d2663 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/Serialization.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/Serialization.hs @@ -25,9 +25,9 @@ import Data.Ratio ((%)) import Numeric.Natural (Natural) import Shelley.Spec.Ledger.BaseTypes (Nonce (..), UnitInterval (..), mkNonce, text64) import Shelley.Spec.Ledger.BlockChain (pattern BHBody, pattern BHeader, Block (..), - pattern HashHeader, ProtVer (..), TxSeq (..), bbHash, bhash, bheaderBlockNo, - bheaderEta, bheaderL, bheaderOCert, bheaderPrev, bheaderSlotNo, bheaderVk, - bheaderVrfVk, bprotvert, bsize, mkSeed, seedEta, seedL) + pattern HashHeader, TxSeq (..), bbHash, bhash, bheaderBlockNo, bheaderEta, + bheaderL, bheaderOCert, bheaderPrev, bheaderSlotNo, bheaderVk, bheaderVrfVk, + bprotvert, bsize, mkSeed, seedEta, seedL) import Shelley.Spec.Ledger.Coin (Coin (..)) import Shelley.Spec.Ledger.Delegation.Certificates (pattern DeRegKey, pattern Delegate, pattern GenesisDelegate, pattern MIRCert, pattern PoolDistr, pattern RegKey, @@ -39,7 +39,7 @@ import Shelley.Spec.Ledger.Keys (DiscVKey (..), pattern GenKeyHash, Ha import Shelley.Spec.Ledger.LedgerState (AccountState (..), EpochState (..), NewEpochState (..), pattern RewardUpdate, deltaF, deltaR, deltaT, emptyLedgerState, genesisId, rs) -import Shelley.Spec.Ledger.PParams (emptyPParams, mkActiveSlotCoeff) +import Shelley.Spec.Ledger.PParams (ProtVer (..), emptyPParams, mkActiveSlotCoeff) import Shelley.Spec.Ledger.Serialization (FromCBORGroup (..), ToCBORGroup (..)) import Shelley.Spec.Ledger.Slot (BlockNo (..), EpochNo (..), SlotNo (..)) import Shelley.Spec.Ledger.Tx (Tx (..), hashScript) @@ -223,7 +223,7 @@ testBHB = BHBody , bhash = bbHash $ TxSeq Seq.empty , bheaderOCert = OCert (snd testKESKeys) (vKey testKey1) 0 (KESPeriod 0) (sign (sKey testKey1) (snd testKESKeys, 0, KESPeriod 0)) - , bprotvert = ProtVer 0 0 0 + , bprotvert = ProtVer 0 0 } data ToTokens where @@ -503,7 +503,7 @@ serializationTests = testGroup "Serialization Tests" activeSlotCoefficient = mkActiveSlotCoeff $ UnsafeUnitInterval $ 1 % 8 d = UnsafeUnitInterval $ 1 % 9 extraEntropy = NeutralNonce - protocolVersion = (0,1) + protocolVersion = ProtVer 0 1 in checkEncodingCBOR "pparams_update_all" (PParamsUpdate $ Set.fromList @@ -800,7 +800,7 @@ serializationTests = testGroup "Serialization Tests" 0 (KESPeriod 0) (sign (sKey testKey1) (snd testKESKeys, 0, KESPeriod 0)) - protover = ProtVer 0 0 0 + protover = ProtVer 0 0 in checkEncodingCBOR "block_header_body" ( BHBody @@ -817,7 +817,7 @@ serializationTests = testGroup "Serialization Tests" , bprotvert = protover } ) - ( T (TkListLen $ 9 + 5 + 3) + ( T (TkListLen $ 9 + 5 + 2) <> S prevhash <> S issuerVkey <> S vrfVkey @@ -852,7 +852,7 @@ serializationTests = testGroup "Serialization Tests" in checkEncodingCBOR "block_header" (BHeader testBHB sig) - ( (T $ TkListLen 18) + ( (T $ TkListLen 17) <> G testBHB <> S sig ) @@ -864,7 +864,7 @@ serializationTests = testGroup "Serialization Tests" in checkEncodingCBOR "empty_block" (Block bh txns) - ( (T $ TkListLen 21) + ( (T $ TkListLen 20) <> G bh <> T (TkListLen 0 . TkListLen 0 . TkMapLen 0) ) @@ -895,7 +895,7 @@ serializationTests = testGroup "Serialization Tests" in checkEncodingCBOR "rich_block" (Block bh txns) - ( (T $ TkListLen 21) + ( (T $ TkListLen 20) -- header <> G bh 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 000ca1919d8..eb18b71023a 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 @@ -68,12 +68,13 @@ import Shelley.Spec.Ledger.Address (scriptsToAddr, toAddr, toCred) import Shelley.Spec.Ledger.BaseTypes (Nonce (..), UnitInterval, epochInfo, intervalValue, slotsPrior) import Shelley.Spec.Ledger.BlockChain (pattern BHBody, pattern BHeader, pattern Block, - ProtVer (..), TxSeq (..), bBodySize, bbHash, mkSeed, seedEta, seedL) + TxSeq (..), bBodySize, bbHash, mkSeed, seedEta, seedL) import Shelley.Spec.Ledger.Coin (Coin (..)) import Shelley.Spec.Ledger.Keys (pattern KeyPair, hashAnyKey, hashKey, sKey, sign, signKES, undiscriminateKeyHash, vKey) import Shelley.Spec.Ledger.LedgerState (AccountState (..), genesisCoins) import Shelley.Spec.Ledger.OCert (KESPeriod (..), pattern OCert) +import Shelley.Spec.Ledger.PParams (ProtVer (..)) import Shelley.Spec.Ledger.Slot (BlockNo (..), Duration (..), SlotNo (..), epochInfoFirst, (*-)) import Shelley.Spec.Ledger.Tx (pattern TxOut, hashScript) @@ -394,7 +395,7 @@ mkBlock prev pkeys txns s blockNo enonce (NatNonce bnonce) l kesPeriod c0 oCert (fromIntegral $ bBodySize $ (TxSeq . fromList) txns) (bbHash $ TxSeq $ fromList txns) oCert - (ProtVer 0 0 0) + (ProtVer 0 0) kpDiff = kesPeriod - c0 hotKey = case evolveKESUntil sHot (KESPeriod kpDiff) of Nothing -> diff --git a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Update.hs b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Update.hs index 700b1d00e0a..296a677c4a8 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Update.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Generator/Update.hs @@ -30,7 +30,8 @@ import Shelley.Spec.Ledger.BaseTypes (Nonce (NeutralNonce), UnitInterv import Shelley.Spec.Ledger.Coin (Coin (..)) import Shelley.Spec.Ledger.Keys (GenDelegs (..), hash, hashKey, vKey) import Shelley.Spec.Ledger.LedgerState (_dstate, _genDelegs, _ups) -import Shelley.Spec.Ledger.PParams (ActiveSlotCoeff, PParams (..), mkActiveSlotCoeff) +import Shelley.Spec.Ledger.PParams (ActiveSlotCoeff, PParams (..), ProtVer (..), + mkActiveSlotCoeff) import Shelley.Spec.Ledger.Slot (EpochNo (EpochNo), SlotNo) import Shelley.Spec.Ledger.Updates (pattern AVUpdate, ApName (..), pattern ApVer, pattern Applications, InstallerHash (..), pattern Mdt, pattern PPUpdate, @@ -174,20 +175,20 @@ genDecentralisationParam = unsafeMkUnitInterval <$> QC.elements [0.1, 0.2 .. 1] -- ^^ TODO jc - generating d=0 takes some care, if there are no registered -- stake pools then d=0 deadlocks the system. -genProtocolVersion :: Gen (Natural, Natural) -genProtocolVersion = ((,) <$> genNatural 1 10 <*> genNatural 1 50) +genProtocolVersion :: Gen ProtVer +genProtocolVersion = ProtVer <$> genNatural 1 10 <*> genNatural 1 50 -- | Generate a possible next Protocol version based on the previous version. -- Increments the Major or Minor versions and possibly the Alt version. genNextProtocolVersion :: PParams - -> Gen (Natural, Natural) + -> Gen ProtVer genNextProtocolVersion pp = do QC.elements - [ (m + 1, 0 ) - , (m , n + 1)] + [ ProtVer (m + 1) 0 + , ProtVer m (n + 1)] where - (m, n) = _protocolVersion pp + ProtVer m n = _protocolVersion pp -- | Given the current protocol params generates a subset of protocol parameter assignments. genSetOfPpm diff --git a/shelley/chain-and-ledger/executable-spec/test/Tests.hs b/shelley/chain-and-ledger/executable-spec/test/Tests.hs index 8f36d970d1e..9b0178fa339 100644 --- a/shelley/chain-and-ledger/executable-spec/test/Tests.hs +++ b/shelley/chain-and-ledger/executable-spec/test/Tests.hs @@ -4,12 +4,12 @@ import Test.Shelley.Spec.Ledger.Examples.Serialization (serializationT import Test.Shelley.Spec.Ledger.Examples.STSTests (stsTests) import Test.Shelley.Spec.Ledger.Examples.UnitTests (unitTests) import Test.Shelley.Spec.Ledger.PropertyTests (minimalPropertyTests) ---import Test.Shelley.Spec.Ledger.Examples.CDDL (cddlTests) +import Test.Shelley.Spec.Ledger.Examples.CDDL (cddlTests) tests :: TestTree tests = testGroup "Ledger with Delegation" - --[ cddlTests -- TODO get cddl tests working in CI - [ minimalPropertyTests + [ cddlTests + , minimalPropertyTests , serializationTests , stsTests , unitTests