From f4e88018e143dc06d9e61821ac524aa16123b00f Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 18 Dec 2018 11:01:56 +1100 Subject: [PATCH 1/5] Comments on SlotCount data type --- core/src/Pos/Core/Slotting/SlotCount.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/core/src/Pos/Core/Slotting/SlotCount.hs b/core/src/Pos/Core/Slotting/SlotCount.hs index fa79a6b352e..af1fd3a210e 100644 --- a/core/src/Pos/Core/Slotting/SlotCount.hs +++ b/core/src/Pos/Core/Slotting/SlotCount.hs @@ -10,6 +10,8 @@ import System.Random (Random (..)) import Pos.Binary.Class (Bi (..)) +-- | This type actually contains the number of slots per epoch, but the people +-- who wrote this code hate us! newtype SlotCount = SlotCount {getSlotCount :: Word64} deriving (Eq, Ord, Num, Real, Integral, Enum, Read, Show, Buildable, Generic, Typeable, NFData, Hashable, Random) From cf40ab35f7de0640b204013caefb9001bd90b5fa Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 8 Jan 2019 10:15:13 +1100 Subject: [PATCH 2/5] chain: Use medium hashes for improved debugging --- chain/src/Pos/Chain/Block/Error.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/chain/src/Pos/Chain/Block/Error.hs b/chain/src/Pos/Chain/Block/Error.hs index 689194715be..e601cab9b0e 100644 --- a/chain/src/Pos/Chain/Block/Error.hs +++ b/chain/src/Pos/Chain/Block/Error.hs @@ -17,7 +17,7 @@ import Formatting.Buildable (Buildable (..)) import GHC.Generics (Generic) import Pos.Chain.Block.Header (HeaderHash) -import Pos.Crypto (shortHashF) +import Pos.Crypto (mediumHashF) -- | This function can be used to create a message when tip mismatch @@ -27,7 +27,7 @@ tipMismatchMsg :: Text -> HeaderHash -> HeaderHash -> Builder tipMismatchMsg action storedTip attemptedTip = bprint ("Can't "%stext%" block because of tip mismatch (stored is " - %shortHashF%", attempted is "%shortHashF%")") + %mediumHashF%", attempted is "%mediumHashF%")") action storedTip attemptedTip data RollbackException = RollbackTipMismatch HeaderHash HeaderHash From 826e4b2700fdd1243de325a8b886bac3d8e53659 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 29 Jan 2019 18:20:45 +1100 Subject: [PATCH 3/5] generator: Only generate valid BlockScenarios The existing generator was generating 'BlockScenario's with two blocks with the same hash in a sequence of applys. This happened a number of times while I was debugging but now I can't reproduce it without this patch. Will leave this patch in just to make sure. --- .../test/Test/Pos/Block/Logic/VarSpec.hs | 60 ++++++++++++++++--- 1 file changed, 51 insertions(+), 9 deletions(-) diff --git a/generator/test/Test/Pos/Block/Logic/VarSpec.hs b/generator/test/Test/Pos/Block/Logic/VarSpec.hs index de8db5565d7..c85b770d11a 100644 --- a/generator/test/Test/Pos/Block/Logic/VarSpec.hs +++ b/generator/test/Test/Pos/Block/Logic/VarSpec.hs @@ -11,18 +11,21 @@ import Universum hiding ((<>)) import Control.Monad.Random.Strict (MonadRandom (..), RandomGen, evalRandT, uniform) -import Data.List (span) +import qualified Data.List as List import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE import qualified Data.Ratio as Ratio import Data.Semigroup ((<>)) +import Formatting (sformat, (%)) +import Serokell.Util (listJson) + import Test.Hspec (Spec, beforeAll_, describe) import Test.Hspec.QuickCheck (modifyMaxSuccess) import Test.QuickCheck.Gen (Gen (MkGen)) import Test.QuickCheck.Monadic (assert, pick, pre) import Test.QuickCheck.Random (QCGen) -import Pos.Chain.Block (Blund, headerHash) +import Pos.Chain.Block (Blund, HeaderHash, headerHash) import Pos.Chain.Genesis as Genesis (Config (..), configBootStakeholders, configEpochSlots) import Pos.Chain.Txp (TxpConfiguration) @@ -33,6 +36,10 @@ import Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..), import Pos.Core.Slotting (MonadSlots (getCurrentSlot)) import Pos.DB.Block (verifyAndApplyBlocks, verifyBlocksPrefix) import Pos.DB.Pure (dbPureDump) + +import Pos.Generator.BlockEvent (BlockEvent' (..), + BlockEventApply' (..), BlockEventRollback' (..), + BlockScenario' (..)) import Pos.Generator.BlockEvent.DSL (BlockApplyResult (..), BlockEventGenT, BlockRollbackFailure (..), BlockRollbackResult (..), BlockScenario, Path, byChance, @@ -127,7 +134,7 @@ verifyValidBlocks genesisConfig txpConfig = do -- impossible because of precondition (see 'pre' above) [] -> error "verifyValidBlocks: impossible" (block0:otherBlocks) -> - let (otherBlocks', _) = span isRight otherBlocks + let (otherBlocks', _) = List.span isRight otherBlocks in block0 :| otherBlocks' verRes <- lift $ satisfySlotCheck blocksToVerify $ verifyBlocksPrefix @@ -312,15 +319,50 @@ blockPropertyScenarioGen -> TxpConfiguration -> BlockEventGenT QCGen BlockTestMode () -> BlockProperty BlockScenario -blockPropertyScenarioGen genesisConfig txpConfig m = do - allSecrets <- getAllSecrets - let genStakeholders = configBootStakeholders genesisConfig - g <- pick $ MkGen $ \qc _ -> qc - lift $ flip evalRandT g $ runBlockEventGenT genesisConfig +blockPropertyScenarioGen genesisConfig txpConfig m = + generate =<< getAllSecrets + where + generate secrets = do + let genStakeholders = configBootStakeholders genesisConfig + g <- pick $ MkGen $ \qc _ -> qc + bs <- lift $ flip evalRandT g $ runBlockEventGenT genesisConfig txpConfig - allSecrets + secrets genStakeholders m + if not (uniqueBlockApply bs) + then generate secrets + else pure bs + + +-- | Return 'True' if the applied blocks (taking into account rollbacks) results +-- in a unique set of block hashes. The generator tests will fail if the +-- generated blocks (accounting for rollback) are not unique. +uniqueBlockApply :: BlockScenario -> Bool +uniqueBlockApply (BlockScenario bs) = + let ys = foldScenario [] bs in + ys == ordNub ys + where + foldScenario :: [HeaderHash] -> [BlockEvent' Blund] -> [HeaderHash] + foldScenario !acc [] = List.sort acc + foldScenario !acc (x:xs) = + case x of + BlkEvApply ea -> + foldScenario ((map headerHash . toList $ toNewestFirst (_beaInput ea)) ++ acc) xs + BlkEvRollback re -> + foldScenario (rollback (map headerHash . toList $ getNewestFirst (_berInput re)) acc) xs + BlkEvSnap _ -> + foldScenario acc xs + + rollback :: [HeaderHash] -> [HeaderHash] -> [HeaderHash] + rollback _ [] = [] + rollback [] acc = acc + rollback (r:rs) (x:xs) = + if (r == x) + then rollback rs xs + else error $ sformat + ("uniqueBlockApply: rollback failed " % listJson % " " % listJson) + (r:rs) (x:xs) prettyScenario :: BlockScenario -> Text prettyScenario scenario = pretty (fmap (headerHash . fst) scenario) From a91a7c300f0ed0272bdfccc9c365e17890730df0 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Wed, 30 Jan 2019 09:11:51 +1100 Subject: [PATCH 4/5] CBR-499: Extend LastBksSlots data type and storage for OBFT --- chain/cardano-sl-chain.cabal | 2 + chain/src/Pos/Chain/Block/Slog/Types.hs | 34 +++++- db/src/Pos/DB/Block/GState/BlockExtra.hs | 99 ++++++++++++++--- db/src/Pos/DB/Block/Logic/Internal.hs | 5 +- db/src/Pos/DB/Block/Logic/Util.hs | 12 +-- db/src/Pos/DB/Block/Slog/Context.hs | 31 +++++- db/src/Pos/DB/Block/Slog/Logic.hs | 125 +++++++++++++++------- generator/src/Pos/Generator/BlockEvent.hs | 5 +- lib/src/Pos/DB/DB.hs | 4 +- lib/src/Pos/GState/GState.hs | 34 +++--- lib/src/Pos/Worker/Block.hs | 13 +-- utxo/src/UTxO/Verify.hs | 23 ++-- 12 files changed, 290 insertions(+), 97 deletions(-) diff --git a/chain/cardano-sl-chain.cabal b/chain/cardano-sl-chain.cabal index 2c83ad98fdb..3b182f31d76 100644 --- a/chain/cardano-sl-chain.cabal +++ b/chain/cardano-sl-chain.cabal @@ -155,8 +155,10 @@ library , aeson , aeson-options , array + , base16-bytestring , bytestring , Cabal + , cardano-crypto , canonical-json , cardano-sl-binary , cardano-sl-core diff --git a/chain/src/Pos/Chain/Block/Slog/Types.hs b/chain/src/Pos/Chain/Block/Slog/Types.hs index 1cc538dadef..28af9375b5c 100644 --- a/chain/src/Pos/Chain/Block/Slog/Types.hs +++ b/chain/src/Pos/Chain/Block/Slog/Types.hs @@ -2,6 +2,7 @@ module Pos.Chain.Block.Slog.Types ( LastBlkSlots + , LastSlotInfo (..) , noLastBlkSlots , SlogGState (..) @@ -16,8 +17,13 @@ module Pos.Chain.Block.Slog.Types import Universum +import qualified Cardano.Crypto.Wallet as CC import Control.Lens (makeClassy) -import Formatting (Format, bprint, later) +import qualified Data.ByteString.Base16 as B16 +import qualified Data.ByteString.Char8 as BS +import Formatting (Format, bprint, int, later, string, (%)) +import qualified Formatting.Buildable as Buildable + import System.Metrics.Label (Label) import Pos.Binary.Class (Cons (..), Field (..), deriveSimpleBi) @@ -25,12 +31,29 @@ import Pos.Core (ChainDifficulty, EpochIndex, FlatSlotId, LocalSlotIndex, SlotCount, slotIdF, unflattenSlotId) import Pos.Core.Chrono (OldestFirst (..)) import Pos.Core.Reporting (MetricMonitorState) +import Pos.Crypto (PublicKey (..)) + + +data LastSlotInfo = LastSlotInfo + { lsiFlatSlotId :: !FlatSlotId + -- ^ The flattened SlotId of this block. + , lsiLeaderPubkeyHash :: !PublicKey + -- ^ The hash of the public key of the slot leader for this slot. + } deriving (Eq, Show, Generic) + +instance Buildable LastSlotInfo where + build (LastSlotInfo i (PublicKey pk)) = + bprint ( "LastSlotInfo "% int %" "% string) + i (take 16 . BS.unpack . B16.encode $ CC.xpubPublicKey pk) -- | This type contains 'FlatSlotId's of the blocks whose depth is -- less than 'blkSecurityParam'. 'FlatSlotId' is chosen in favor of -- 'SlotId', because the main use case is chain quality calculation, -- for which flat slot is more convenient. -type LastBlkSlots = OldestFirst [] FlatSlotId +-- Version 1 of this data type was: +-- type LastBlkSlots = OldestFirst [] FlatSlotId +type LastBlkSlots = OldestFirst [] LastSlotInfo + noLastBlkSlots :: LastBlkSlots noLastBlkSlots = OldestFirst [] @@ -102,3 +125,10 @@ deriveSimpleBi ''SlogUndo [ Cons 'SlogUndo [ Field [| getSlogUndo :: Maybe FlatSlotId |] ]] + +deriveSimpleBi ''LastSlotInfo [ + Cons 'LastSlotInfo [ + Field [| lsiFlatSlotId :: FlatSlotId |], + Field [| lsiLeaderPubkeyHash :: PublicKey |] + ] + ] diff --git a/db/src/Pos/DB/Block/GState/BlockExtra.hs b/db/src/Pos/DB/Block/GState/BlockExtra.hs index f3de38a3d90..43f0e8b00ad 100644 --- a/db/src/Pos/DB/Block/GState/BlockExtra.hs +++ b/db/src/Pos/DB/Block/GState/BlockExtra.hs @@ -8,6 +8,9 @@ module Pos.DB.Block.GState.BlockExtra ( resolveForwardLink , isBlockInMainChain , getLastSlots + , putLastSlots + , rollbackLastSlots + , upgradeLastSlotsVersion , getFirstGenesisBlockHash , BlockExtraOp (..) , buildBlockExtraOp @@ -22,22 +25,28 @@ module Pos.DB.Block.GState.BlockExtra import Universum hiding (init) import Data.Conduit (ConduitT, yield) + import qualified Database.RocksDB as Rocks import Formatting (Format, bprint, build, later, (%)) import Serokell.Util.Text (listJson) import Pos.Binary.Class (serialize') -import Pos.Chain.Block (Block, BlockHeader, HasHeaderHash, HeaderHash, - LastBlkSlots, headerHash, noLastBlkSlots) -import Pos.Chain.Genesis (GenesisHash (..)) -import Pos.Core (FlatSlotId, SlotCount, slotIdF, unflattenSlotId) +import Pos.Chain.Block (Block, BlockHeader (..), HasHeaderHash, + HeaderHash, LastBlkSlots, LastSlotInfo (..), headerHash, + mainHeaderLeaderKey, noLastBlkSlots, prevBlockL) +import Pos.Chain.Genesis (GenesisHash (..), configBlkSecurityParam, + configEpochSlots) +import qualified Pos.Chain.Genesis as Genesis +import Pos.Core (FlatSlotId, SlotCount, flattenEpochOrSlot, + getEpochOrSlot, slotIdF, unflattenSlotId) import Pos.Core.Chrono (OldestFirst (..)) -import Pos.Crypto (shortHashF) +import Pos.Crypto (PublicKey, shortHashF) import Pos.DB (DBError (..), MonadDB, MonadDBRead (..), - RocksBatchOp (..), getHeader) + RocksBatchOp (..), getHeader, getTipHeader, gsDelete) import Pos.DB.Class (MonadBlockDBRead, SerializedBlock, getBlock) import Pos.DB.GState.Common (gsGetBi, gsPutBi) import Pos.Util.Util (maybeThrow) +import Pos.Util.Wlog (CanLog) ---------------------------------------------------------------------------- -- Getters @@ -60,8 +69,69 @@ isBlockInMainChain h = -- less than 'blkSecurityParam'. getLastSlots :: forall m . MonadDBRead m => m LastBlkSlots getLastSlots = - maybeThrow (DBMalformed "Last slots not found in the global state DB") =<< - gsGetBi lastSlotsKey + gsGetBi lastSlotsKey2 >>= + maybeThrow (DBMalformed "Last slots v2 not found in the global state DB") + +putLastSlots :: forall m . MonadDB m => LastBlkSlots -> m () +putLastSlots = + gsPutBi lastSlotsKey2 + +-- | Roll back slots. +-- This assumes that the tip header (retrieved via `getTipHeader` has already +-- been rolled back. +rollbackLastSlots :: forall m . (CanLog m, MonadIO m, MonadDB m) => Genesis.Config -> m () +rollbackLastSlots genesisConfig = do + -- Simple is better. Find the 'FlatSlotId' of the tip header and then generate + -- the required 'LastBlkSlots' data from that. + gsPutBi lastSlotsKey2 =<< getLastSlotInfo genesisConfig + + +-- | This function acts as a one time conversion from version 1 to version 2 +-- of the `LastBlkSlots` data type. +upgradeLastSlotsVersion :: forall m . (MonadDB m, MonadIO m) => Genesis.Config -> m () +upgradeLastSlotsVersion genesisConfig = + gsGetBi oldLastSlotsKey >>= \case + Nothing -> pure () -- Assume it has already been converted. + Just (_ :: OldestFirst [] FlatSlotId) -> do + gsPutBi lastSlotsKey2 =<< getLastSlotInfo genesisConfig + gsDelete oldLastSlotsKey -- Delete the old key + where + -- This is the DB key for version 1 of the `LastBlksSlots` data type that only + -- contains a list of `FlatSlotId`s + oldLastSlotsKey :: ByteString + oldLastSlotsKey = "e/ls/" + + +-- Get the 'LastSlotInfo' data for the last 'k' (security paramenter) starting +-- at the current blockchain tip. +getLastSlotInfo :: (MonadDB m, MonadIO m) => Genesis.Config -> m LastBlkSlots +getLastSlotInfo genesisConfig = do + th <- getTipHeader + let thfsid = flattenEpochOrSlot (configEpochSlots genesisConfig) $ getEpochOrSlot th + lastfsid = + if thfsid <= fromIntegral (configBlkSecurityParam genesisConfig - 1) + then 0 + else thfsid - fromIntegral (configBlkSecurityParam genesisConfig - 1) + OldestFirst <$> convert th lastfsid [] + where + convert :: (MonadDB m, MonadIO m) => BlockHeader -> FlatSlotId -> [LastSlotInfo] -> m [LastSlotInfo] + convert bh lastFsid !acc = do + let bhFsid = flattenEpochOrSlot (configEpochSlots genesisConfig) $ getEpochOrSlot bh + if bhFsid < lastFsid + then pure acc + else do + let ys = case leaderKey bh of + Nothing -> acc + Just lk -> LastSlotInfo bhFsid lk : acc + mnbh <- getHeader $ view prevBlockL bh + case mnbh of + Nothing -> pure acc + Just nbh -> convert nbh lastFsid ys + + leaderKey :: BlockHeader -> Maybe PublicKey + leaderKey = \case + BlockHeaderGenesis _ -> Nothing + BlockHeaderMain bhm -> Just $ view mainHeaderLeaderKey bhm -- | Retrieves first genesis block hash. getFirstGenesisBlockHash :: MonadDBRead m => GenesisHash -> m HeaderHash @@ -82,7 +152,7 @@ data BlockExtraOp | SetInMainChain Bool HeaderHash -- ^ Enables or disables "in main chain" status of the block - | SetLastSlots (OldestFirst [] FlatSlotId) + | SetLastSlots LastBlkSlots -- ^ Updates list of slots for last blocks. deriving (Show) @@ -97,7 +167,7 @@ buildBlockExtraOp epochSlots = later build' bprint ("SetInMainChain for "%shortHashF%": "%build) h flag build' (SetLastSlots slots) = bprint ("SetLastSlots: "%listJson) - (map (bprint slotIdF . unflattenSlotId epochSlots) slots) + (map (bprint slotIdF . unflattenSlotId epochSlots . lsiFlatSlotId) slots) instance RocksBatchOp BlockExtraOp where toBatchOp (AddForwardLink from to) = @@ -109,7 +179,7 @@ instance RocksBatchOp BlockExtraOp where toBatchOp (SetInMainChain True h) = [Rocks.Put (mainChainKey h) (serialize' ()) ] toBatchOp (SetLastSlots slots) = - [Rocks.Put lastSlotsKey (serialize' slots)] + [Rocks.Put lastSlotsKey2 (serialize' slots)] ---------------------------------------------------------------------------- -- Loops on forward links @@ -211,7 +281,7 @@ initGStateBlockExtra :: MonadDB m => GenesisHash -> HeaderHash -> m () initGStateBlockExtra genesisHash firstGenesisHash = do gsPutBi (mainChainKey firstGenesisHash) () gsPutBi (forwardLinkKey $ getGenesisHash genesisHash) firstGenesisHash - gsPutBi lastSlotsKey noLastBlkSlots + gsPutBi lastSlotsKey2 noLastBlkSlots ---------------------------------------------------------------------------- -- Keys @@ -223,5 +293,6 @@ forwardLinkKey h = "e/fl/" <> serialize' h mainChainKey :: HeaderHash -> ByteString mainChainKey h = "e/mc/" <> serialize' h -lastSlotsKey :: ByteString -lastSlotsKey = "e/ls/" +-- This is the DB key for version 2 of the `LastBlksSlots`. +lastSlotsKey2 :: ByteString +lastSlotsKey2 = "e/ls2/" diff --git a/db/src/Pos/DB/Block/Logic/Internal.hs b/db/src/Pos/DB/Block/Logic/Internal.hs index b14710ee927..cc780ef243f 100644 --- a/db/src/Pos/DB/Block/Logic/Internal.hs +++ b/db/src/Pos/DB/Block/Logic/Internal.hs @@ -54,6 +54,7 @@ import Pos.Core.Slotting (epochOrSlotToEpochIndex, getEpochOrSlot) import Pos.DB (MonadDB, MonadDBRead, MonadGState, SomeBatchOp (..)) import Pos.DB.Block.BListener (MonadBListener) import Pos.DB.Block.GState.SanityCheck (sanityCheckDB) +import Pos.DB.Block.Slog.Context (slogRollbackLastSlots) import Pos.DB.Block.Slog.Logic (BypassSecurityCheck (..), MonadSlogApply, MonadSlogBase, ShouldCallBListener, slogApplyBlocks, slogRollbackBlocks) @@ -224,8 +225,7 @@ rollbackBlocksUnsafe -> NewestFirst NE Blund -> m () rollbackBlocksUnsafe genesisConfig bsc scb toRollback = do - slogRoll <- slogRollbackBlocks (makeNetworkMagic $ configProtocolMagic genesisConfig) - (configProtocolConstants genesisConfig) + slogRoll <- slogRollbackBlocks genesisConfig bsc scb toRollback @@ -244,6 +244,7 @@ rollbackBlocksUnsafe genesisConfig bsc scb toRollback = do , sscBatch , slogRoll ] + slogRollbackLastSlots genesisConfig -- After blocks are rolled back it makes sense to recreate the -- delegation mempool. -- We don't normalize other mempools, because they are normalized diff --git a/db/src/Pos/DB/Block/Logic/Util.hs b/db/src/Pos/DB/Block/Logic/Util.hs index 2ca2084ed82..9a38734bc8a 100644 --- a/db/src/Pos/DB/Block/Logic/Util.hs +++ b/db/src/Pos/DB/Block/Logic/Util.hs @@ -24,8 +24,8 @@ import qualified Data.List.NonEmpty as NE import Formatting (int, sformat, (%)) import Pos.Chain.Block (BlockHeader, HasBlockConfiguration, - HasSlogGState, HeaderHash, fixedTimeCQ, headerHash, - prevBlockL) + HasSlogGState, HeaderHash, LastSlotInfo (..), fixedTimeCQ, + headerHash, prevBlockL) import Pos.Core (BlockCount, FlatSlotId, SlotCount, Timestamp (..), difficultyL, flattenSlotId) import Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..)) @@ -35,7 +35,7 @@ import Pos.Core.Slotting (MonadSlots (..), getCurrentSlotFlat, import Pos.DB.Block.GState.BlockExtra (isBlockInMainChain) import Pos.DB.Block.Slog.Context (slogGetLastSlots) import qualified Pos.DB.BlockIndex as DB -import Pos.DB.Class (MonadBlockDBRead) +import Pos.DB.Class (MonadBlockDBRead, MonadDBRead) import Pos.Util (_neHead) import Pos.Util.Wlog (WithLogger) @@ -100,9 +100,9 @@ calcChainQuality blockCount deepSlot newSlot -- 'blkSecurityParam' blocks. calcChainQualityM :: ( MonadReader ctx m + , MonadDBRead m , HasSlogGState ctx , MonadIO m - , MonadThrow m , WithLogger m , Fractional res ) @@ -123,7 +123,7 @@ calcChainQualityM k newSlot = do return (calcChainQuality (fromIntegral len) - (NE.head slotsNE) + (lsiFlatSlotId $ NE.head slotsNE) newSlot) -- | Calculate overall chain quality, i. e. number of main blocks @@ -172,7 +172,7 @@ calcChainQualityFixedTime epochSlots = do (,) <$> slotFromTimestamp epochSlots olderTime <*> getCurrentSlotFlat epochSlots >>= \case (Just (flattenSlotId epochSlots -> olderSlotId), Just currentSlotId) -> calcChainQualityFixedTimeDo olderSlotId currentSlotId <$> - slogGetLastSlots + (lsiFlatSlotId <<$>> slogGetLastSlots) _ -> return Nothing where -- 'lastSlots' contains slots of last 'k' blocks. diff --git a/db/src/Pos/DB/Block/Slog/Context.hs b/db/src/Pos/DB/Block/Slog/Context.hs index f69d8ddbbf2..31f14da6ab8 100644 --- a/db/src/Pos/DB/Block/Slog/Context.hs +++ b/db/src/Pos/DB/Block/Slog/Context.hs @@ -8,6 +8,7 @@ module Pos.DB.Block.Slog.Context , cloneSlogGState , slogGetLastSlots , slogPutLastSlots + , slogRollbackLastSlots ) where import Universum @@ -18,11 +19,16 @@ import qualified System.Metrics as Ekg import Pos.Chain.Block (HasBlockConfiguration, HasSlogGState (..), LastBlkSlots, SlogContext (..), SlogGState (..), fixedTimeCQSec, sgsLastBlkSlots) +import Pos.Chain.Genesis as Genesis (Config (..)) import Pos.Core (BlockCount) import Pos.Core.Metrics.Constants (withCardanoNamespace) import Pos.Core.Reporting (MetricMonitorState, mkMetricMonitorState) -import Pos.DB.Block.GState.BlockExtra (getLastSlots) -import Pos.DB.Class (MonadDBRead) +import Pos.DB.Block.GState.BlockExtra (getLastSlots, putLastSlots, + rollbackLastSlots) +import Pos.DB.Class (MonadDB, MonadDBRead) + +import Pos.Util.Wlog (CanLog) + -- | Make new 'SlogGState' using data from DB. mkSlogGState :: (MonadIO m, MonadDBRead m) => m SlogGState @@ -70,12 +76,27 @@ cloneSlogGState SlogGState {..} = -- | Read 'LastBlkSlots' from in-memory state. slogGetLastSlots :: (MonadReader ctx m, HasSlogGState ctx, MonadIO m) => m LastBlkSlots -slogGetLastSlots = view (slogGState . sgsLastBlkSlots) >>= readIORef +slogGetLastSlots = + -- 'LastBlkSlots' is stored in two places, the DB and an 'IORef' so just + -- grab the copy in the 'IORef'. + readIORef =<< view (slogGState . sgsLastBlkSlots) -- | Update 'LastBlkSlots' in 'SlogContext'. slogPutLastSlots :: - (MonadReader ctx m, HasSlogGState ctx, MonadIO m) + (MonadReader ctx m, MonadDB m, HasSlogGState ctx, MonadIO m) => LastBlkSlots -> m () -slogPutLastSlots slots = +slogPutLastSlots slots = do + -- When we set 'LastBlkSlots' we set it in both the DB and the 'IORef'. + view (slogGState . sgsLastBlkSlots) >>= flip writeIORef slots + putLastSlots slots + +-- | Roll back the specified count of 'LastBlkSlots'. +slogRollbackLastSlots + :: (CanLog m, MonadReader ctx m, MonadDB m, HasSlogGState ctx, MonadIO m) + => Genesis.Config -> m () +slogRollbackLastSlots genesisConfig = do + -- Roll back in the DB, then read the DB and set the 'IORef'. + rollbackLastSlots genesisConfig + slots <- getLastSlots view (slogGState . sgsLastBlkSlots) >>= flip writeIORef slots diff --git a/db/src/Pos/DB/Block/Slog/Logic.hs b/db/src/Pos/DB/Block/Slog/Logic.hs index 3578aa51634..d0b79708ed0 100644 --- a/db/src/Pos/DB/Block/Slog/Logic.hs +++ b/db/src/Pos/DB/Block/Slog/Logic.hs @@ -27,27 +27,29 @@ import Universum import Control.Lens (_Wrapped) import Control.Monad.Except (MonadError (throwError)) import qualified Data.List.NonEmpty as NE -import Formatting (build, sformat, shown, (%)) +import Formatting import Serokell.Util (Color (Red), colorize) import Serokell.Util.Verify (formatAllErrors, verResToMonadError) -import Pos.Chain.Block (Block, Blund, HasSlogGState, SlogUndo (..), - Undo (..), genBlockLeaders, headerHash, headerHashG, - mainBlockSlot, prevBlockL, verifyBlocks) +import Pos.Chain.Block (Block, Blund, HasSlogGState, LastBlkSlots, + LastSlotInfo (..), MainBlock, SlogUndo (..), + genBlockLeaders, headerHash, headerHashG, + mainBlockLeaderKey, mainBlockSlot, prevBlockL, + verifyBlocks) import Pos.Chain.Genesis as Genesis (Config (..), configEpochSlots, configK) import Pos.Chain.Txp (mkLiveTxValidationRules) import Pos.Chain.Update (BlockVersion (..), UpdateConfiguration, lastKnownBlockVersion) -import Pos.Core (BlockCount, FlatSlotId, ProtocolConstants, - difficultyL, epochIndexL, flattenSlotId, kEpochSlots, +import Pos.Core (BlockCount, difficultyL, epochIndexL, + epochOrSlotToEpochIndex, flattenSlotId, kEpochSlots, pcBlkSecurityParam) import Pos.Core.Chrono (NE, NewestFirst (getNewestFirst), OldestFirst (..), toOldestFirst, _OldestFirst) import Pos.Core.Exception (assertionFailed, reportFatalError) -import Pos.Core.NetworkMagic (NetworkMagic (..)) -import Pos.Core.Slotting (MonadSlots, SlotId, epochOrSlotToEpochIndex, - getEpochOrSlot) +import Pos.Core.NetworkMagic (NetworkMagic (..), makeNetworkMagic) +import Pos.Core.Slotting (HasEpochIndex, MonadSlots, SlotCount, + SlotId, getEpochOrSlot) import Pos.DB (SomeBatchOp (..)) import Pos.DB.Block.BListener (MonadBListener (..)) import qualified Pos.DB.Block.GState.BlockExtra as GS @@ -178,18 +180,19 @@ slogVerifyBlocks genesisConfig curSlot blocks = runExceptT $ do -- we can remove one of the last slots stored in 'BlockExtra'. -- This removed slot must be put into 'SlogUndo'. lastSlots <- lift GS.getLastSlots - let toFlatSlot = - fmap (flattenSlotId (configEpochSlots genesisConfig) . view mainBlockSlot) . rightToMaybe -- these slots will be added if we apply all blocks - let newSlots = mapMaybe toFlatSlot (toList blocks) - let combinedSlots :: OldestFirst [] FlatSlotId + let newSlots :: [LastSlotInfo] + newSlots = + mapMaybe (toLastSlotInfo (configEpochSlots genesisConfig)) $ toList blocks + let combinedSlots :: LastBlkSlots combinedSlots = lastSlots & _Wrapped %~ (<> newSlots) -- these slots will be removed if we apply all blocks, because we store -- only limited number of slots - let removedSlots :: OldestFirst [] FlatSlotId + let removedSlots :: LastBlkSlots removedSlots = combinedSlots & _Wrapped %~ - (take $ length combinedSlots - configK genesisConfig) + (take $ length combinedSlots - configK genesisConfig) + -- Note: here we exploit the fact that genesis block can be only 'head'. -- If we have genesis block, then size of 'newSlots' will be less than -- number of blocks we verify. It means that there will definitely @@ -197,13 +200,23 @@ slogVerifyBlocks genesisConfig curSlot blocks = runExceptT $ do -- -- It also works fine if we store less than 'blkSecurityParam' slots. -- In this case we will use 'Nothing' for the oldest blocks. - let slogUndo :: OldestFirst [] (Maybe FlatSlotId) + let slogUndo :: OldestFirst [] (Maybe LastSlotInfo) slogUndo = map Just removedSlots & _Wrapped %~ (replicate (length blocks - length removedSlots) Nothing <>) -- NE.fromList is safe here, because it's obvious that the size of -- 'slogUndo' is the same as the size of 'blocks'. - return $ over _Wrapped NE.fromList $ map SlogUndo slogUndo + return $ over _Wrapped NE.fromList $ map (SlogUndo . fmap lsiFlatSlotId) slogUndo + +toLastSlotInfo :: SlotCount -> Block -> Maybe LastSlotInfo +toLastSlotInfo slotCount blk = + convert <$> rightToMaybe blk + where + convert :: MainBlock -> LastSlotInfo + convert b = + LastSlotInfo + (flattenSlotId slotCount $ view mainBlockSlot b) + (view mainBlockLeaderKey b) -- | Set of constraints necessary to apply/rollback blocks in Slog. type MonadSlogApply ctx m = @@ -256,7 +269,11 @@ slogApplyBlocks nm k (ShouldCallBListener callBListener) blunds = do newestDifficulty = newestBlock ^. difficultyL let putTip = SomeBatchOp $ GS.PutTip $ headerHash newestBlock lastSlots <- slogGetLastSlots - slogPutLastSlots (newLastSlots lastSlots) + -- Yes, doing this here duplicates the 'SomeBatchOp (blockExtraBatch lastSlots)' + -- operation below, but if we don't have both, either the generator tests or + -- syncing mainnet fails. + + slogPutLastSlots $ newLastSlots lastSlots putDifficulty <- GS.getMaxSeenDifficulty <&> \x -> SomeBatchOp [GS.PutMaxSeenDifficulty newestDifficulty | newestDifficulty > x] @@ -264,7 +281,8 @@ slogApplyBlocks nm k (ShouldCallBListener callBListener) blunds = do [ putTip , putDifficulty , bListenerBatch - , SomeBatchOp (blockExtraBatch lastSlots) ] + , SomeBatchOp (blockExtraBatch lastSlots) + ] where blocks = fmap fst blunds forwardLinks = map (view prevBlockL &&& view headerHashG) $ toList blocks @@ -272,21 +290,32 @@ slogApplyBlocks nm k (ShouldCallBListener callBListener) blunds = do inMainBatch = toList $ fmap (GS.SetInMainChain True . view headerHashG . fst) blunds - mainBlocks = rights $ toList blocks - newSlots = flattenSlotId (kEpochSlots k) . view mainBlockSlot <$> mainBlocks - newLastSlots lastSlots = lastSlots & _Wrapped %~ updateLastSlots + + newSlots :: [LastSlotInfo] + newSlots = mapMaybe (toLastSlotInfo (kEpochSlots k)) $ toList blocks + + newLastSlots :: LastBlkSlots -> LastBlkSlots + newLastSlots = OldestFirst . updateLastSlots . getOldestFirst + + knownSlotsBatch :: LastBlkSlots -> [GS.BlockExtraOp] knownSlotsBatch lastSlots | null newSlots = [] | otherwise = [GS.SetLastSlots $ newLastSlots lastSlots] + -- Slots are in 'OldestFirst' order. So we put new slots to the -- end and drop old slots from the beginning. + updateLastSlots :: [LastSlotInfo] -> [LastSlotInfo] updateLastSlots lastSlots = leaveAtMostN (fromIntegral k) (lastSlots ++ newSlots) + leaveAtMostN :: Int -> [a] -> [a] leaveAtMostN n lst = drop (length lst - n) lst + + blockExtraBatch :: LastBlkSlots -> [GS.BlockExtraOp] blockExtraBatch lastSlots = mconcat [knownSlotsBatch lastSlots, forwardLinksBatch, inMainBatch] + newtype BypassSecurityCheck = BypassSecurityCheck Bool -- | This function does everything that should be done when rollback @@ -304,13 +333,12 @@ newtype BypassSecurityCheck = BypassSecurityCheck Bool -- 5. Removing @inMainChain@ flags slogRollbackBlocks :: MonadSlogApply ctx m - => NetworkMagic - -> ProtocolConstants + => Genesis.Config -> BypassSecurityCheck -- ^ is rollback for more than k blocks allowed? -> ShouldCallBListener -> NewestFirst NE Blund -> m SomeBatchOp -slogRollbackBlocks nm pc (BypassSecurityCheck bypassSecurity) (ShouldCallBListener callBListener) blunds = do +slogRollbackBlocks genesisConfig (BypassSecurityCheck bypassSecurity) (ShouldCallBListener callBListener) blunds = do inAssertMode $ when (isGenesis0 (blocks ^. _Wrapped . _neLast)) $ assertionFailed $ colorize Red "FATAL: we are TRYING TO ROLLBACK 0-TH GENESIS block" @@ -325,18 +353,26 @@ slogRollbackBlocks nm pc (BypassSecurityCheck bypassSecurity) (ShouldCallBListen -- no underflow from subtraction maxSeenDifficulty >= resultingDifficulty && -- no rollback further than k blocks - maxSeenDifficulty - resultingDifficulty <= fromIntegral (pcBlkSecurityParam pc) + maxSeenDifficulty - resultingDifficulty <= fromIntegral (pcBlkSecurityParam $ configProtocolConstants genesisConfig) unless (bypassSecurity || secure) $ reportFatalError "slogRollbackBlocks: the attempted rollback would \ \lead to a more than 'k' distance between tip and \ \last seen block, which is a security risk. Aborting." - bListenerBatch <- if callBListener then onRollbackBlocks nm pc blunds - else pure mempty + bListenerBatch <- if callBListener + then onRollbackBlocks + (makeNetworkMagic $ configProtocolMagic genesisConfig) + (configProtocolConstants genesisConfig) + blunds + else pure mempty + let putTip = SomeBatchOp $ GS.PutTip $ (NE.last $ getNewestFirst blunds) ^. prevBlockL lastSlots <- slogGetLastSlots - slogPutLastSlots (newLastSlots lastSlots) + -- Yes, doing this here duplicates the 'SomeBatchOp (blockExtraBatch lastSlots)' + -- operation below, but if we don't have both, either the generator tests or + -- syncing mainnet fails. + slogPutLastSlots $ newLastSlots lastSlots return $ SomeBatchOp [putTip, bListenerBatch, SomeBatchOp (blockExtraBatch lastSlots)] @@ -346,14 +382,17 @@ slogRollbackBlocks nm pc (BypassSecurityCheck bypassSecurity) (ShouldCallBListen map (GS.SetInMainChain False . view headerHashG) $ toList blocks forwardLinksBatch = map (GS.RemoveForwardLink . view prevBlockL) $ toList blocks - isGenesis0 (Left genesisBlk) = genesisBlk ^. epochIndexL == 0 - isGenesis0 (Right _) = False - lastSlotsToPrepend = - mapMaybe (getSlogUndo . undoSlog . snd) $ toList (toOldestFirst blunds) - newLastSlots lastSlots = lastSlots & _Wrapped %~ updateLastSlots - dropEnd n xs = take (length xs - n) xs + + lastSlotsToAppend :: [LastSlotInfo] + lastSlotsToAppend = + mapMaybe (toLastSlotInfo (configEpochSlots genesisConfig) . fst) + $ toList (toOldestFirst blunds) + + newLastSlots :: LastBlkSlots -> LastBlkSlots + newLastSlots = OldestFirst . updateLastSlots . getOldestFirst + -- 'lastSlots' is what we currently store. It contains at most - -- 'blkSecurityParam' slots. 'lastSlotsToPrepend' are slots for + -- 'blkSecurityParam' slots. 'lastSlotsToAppend' are slots for -- main blocks which are 'blkSecurityParam' far from the blocks we -- want to rollback. Concatenation of these lists contains slots -- of some sequence of blocks. The last block in this sequence is @@ -362,10 +401,20 @@ slogRollbackBlocks nm pc (BypassSecurityCheck bypassSecurity) (ShouldCallBListen -- main blocks we want to rollback and 'total' is the total number -- of main blocks in our chain. So the final step is to drop last -- 'n' slots from this list. + + updateLastSlots :: [LastSlotInfo] -> [LastSlotInfo] updateLastSlots lastSlots = dropEnd (length $ filter isRight $ toList blocks) $ - lastSlotsToPrepend ++ - lastSlots + lastSlots ++ lastSlotsToAppend + + blockExtraBatch :: LastBlkSlots -> [GS.BlockExtraOp] blockExtraBatch lastSlots = GS.SetLastSlots (newLastSlots lastSlots) : mconcat [forwardLinksBatch, inMainBatch] + +dropEnd :: Int -> [a] -> [a] +dropEnd n xs = take (length xs - n) xs + +isGenesis0 :: HasEpochIndex s => Either s b -> Bool +isGenesis0 (Left genesisBlk) = genesisBlk ^. epochIndexL == 0 +isGenesis0 (Right _) = False diff --git a/generator/src/Pos/Generator/BlockEvent.hs b/generator/src/Pos/Generator/BlockEvent.hs index 7a886315f3b..d7e4e061818 100644 --- a/generator/src/Pos/Generator/BlockEvent.hs +++ b/generator/src/Pos/Generator/BlockEvent.hs @@ -306,7 +306,8 @@ instance Buildable blund => Buildable (BlockEvent' blund) where type BlockEvent = BlockEvent' Blund -newtype BlockScenario' blund = BlockScenario [BlockEvent' blund] +newtype BlockScenario' blund = + BlockScenario { unBlockScenario :: [BlockEvent' blund] } deriving (Show, Functor, Foldable) instance Buildable blund => Buildable (BlockScenario' blund) where @@ -333,7 +334,7 @@ newtype Chance = Chance {getChance :: Rational} byChance :: (Monad m, RandomGen g) => Chance -> RandT g m Bool byChance (Chance c) = weighted [(False, 1 - c), (True, c)] -newtype CheckCount = CheckCount Word +newtype CheckCount = CheckCount { unCheckCount :: Word } deriving (Eq, Ord, Show, Num) -- The tip after the block event. 'Nothing' when the event doesn't affect the tip. diff --git a/lib/src/Pos/DB/DB.hs b/lib/src/Pos/DB/DB.hs index d75a28f9e11..67d8af20c6d 100644 --- a/lib/src/Pos/DB/DB.hs +++ b/lib/src/Pos/DB/DB.hs @@ -19,8 +19,8 @@ import Pos.GState.GState (prepareGStateDB) -- | Initialize DBs if necessary. initNodeDBs - :: forall ctx m - . (MonadReader ctx m, MonadDB m) + :: forall m + . (MonadIO m, MonadDB m) => Genesis.Config -> m () initNodeDBs genesisConfig = do diff --git a/lib/src/Pos/GState/GState.hs b/lib/src/Pos/GState/GState.hs index 0808a3fbc91..248086f0610 100644 --- a/lib/src/Pos/GState/GState.hs +++ b/lib/src/Pos/GState/GState.hs @@ -9,7 +9,7 @@ import Universum import Pos.Chain.Block (HeaderHash) import Pos.Chain.Genesis as Genesis (Config (..), configHeavyDelegation, configVssCerts) -import Pos.DB.Block (initGStateBlockExtra) +import Pos.DB.Block (initGStateBlockExtra, upgradeLastSlotsVersion) import Pos.DB.Class (MonadDB) import Pos.DB.Delegation (initGStateDlg) import Pos.DB.GState.Common (initGStateCommon, isInitialized, @@ -20,24 +20,30 @@ import Pos.DB.Update (initGStateUS) -- | Put missing initial data into GState DB. prepareGStateDB :: - forall ctx m. - ( MonadReader ctx m + forall m. + ( MonadIO m , MonadDB m ) => Genesis.Config -> HeaderHash -> m () -prepareGStateDB genesisConfig initialTip = unlessM isInitialized $ do - initGStateCommon initialTip - initGStateUtxo genesisData - initSscDB $ configVssCerts genesisConfig - initGStateStakes genesisData - initGStateUS genesisConfig - initGStateDlg $ configHeavyDelegation genesisConfig - initGStateBlockExtra (configGenesisHash genesisConfig) initialTip - - setInitialized - where genesisData = configGenesisData genesisConfig +prepareGStateDB genesisConfig initialTip = + ifM isInitialized + (upgradeLastSlotsVersion genesisConfig) + initializeGStateDb + where + genesisData = configGenesisData genesisConfig + + initializeGStateDb = do + initGStateCommon initialTip + initGStateUtxo genesisData + initSscDB $ configVssCerts genesisConfig + initGStateStakes genesisData + initGStateUS genesisConfig + initGStateDlg $ configHeavyDelegation genesisConfig + initGStateBlockExtra (configGenesisHash genesisConfig) initialTip + + setInitialized -- The following is not used in the project yet. To be added back at a -- later stage when needed. diff --git a/lib/src/Pos/Worker/Block.hs b/lib/src/Pos/Worker/Block.hs index 0690b095832..f8b10eeb737 100644 --- a/lib/src/Pos/Worker/Block.hs +++ b/lib/src/Pos/Worker/Block.hs @@ -22,11 +22,12 @@ import System.Random (randomRIO) import Pos.Chain.Block (HasBlockConfiguration, criticalCQ, criticalCQBootstrap, fixedTimeCQSec, gbHeader, - networkDiameter, nonCriticalCQ, nonCriticalCQBootstrap, - scCQFixedMonitorState, scCQOverallMonitorState, - scCQkMonitorState, scCrucialValuesLabel, - scDifficultyMonitorState, scEpochMonitorState, - scGlobalSlotMonitorState, scLocalSlotMonitorState) + lsiFlatSlotId, networkDiameter, nonCriticalCQ, + nonCriticalCQBootstrap, scCQFixedMonitorState, + scCQOverallMonitorState, scCQkMonitorState, + scCrucialValuesLabel, scDifficultyMonitorState, + scEpochMonitorState, scGlobalSlotMonitorState, + scLocalSlotMonitorState) import Pos.Chain.Delegation (ProxySKBlockInfo) import Pos.Chain.Genesis as Genesis (Config (..), configBlkSecurityParam, configEpochSlots, @@ -329,7 +330,7 @@ metricWorker k curSlot = do Nothing -> pass Just slotsNE | length slotsNE < fromIntegral k -> pass - | otherwise -> chainQualityChecker k curSlot (NE.head slotsNE) + | otherwise -> chainQualityChecker k curSlot (lsiFlatSlotId $ NE.head slotsNE) ---------------------------------------------------------------------------- -- -- General metrics diff --git a/utxo/src/UTxO/Verify.hs b/utxo/src/UTxO/Verify.hs index 8a650c2b9a8..7081314602b 100644 --- a/utxo/src/UTxO/Verify.hs +++ b/utxo/src/UTxO/Verify.hs @@ -324,14 +324,13 @@ slogVerifyBlocks curSlot txValRules leaders lastSlots blocks = do -- Here we need to compute 'SlogUndo'. When we add apply a block, -- we can remove one of the last slots stored in -- 'BlockExtra'. This removed slot must be put into 'SlogUndo'. - let toFlatSlot = fmap (flattenSlotId dummyEpochSlots . view mainBlockSlot) . rightToMaybe -- these slots will be added if we apply all blocks - let newSlots = mapMaybe toFlatSlot (toList blocks) - let combinedSlots :: OldestFirst [] FlatSlotId + let newSlots = mapMaybe (toLastSlotInfo dummyEpochSlots) $ toList blocks + let combinedSlots :: LastBlkSlots combinedSlots = lastSlots & _Wrapped %~ (<> newSlots) -- these slots will be removed if we apply all blocks, because we store -- only limited number of slots - let removedSlots :: OldestFirst [] FlatSlotId + let removedSlots :: LastBlkSlots removedSlots = combinedSlots & _Wrapped %~ (take $ length combinedSlots - fromIntegral dummyK) @@ -342,13 +341,25 @@ slogVerifyBlocks curSlot txValRules leaders lastSlots blocks = do -- -- It also works fine if we store less than 'blkSecurityParam' slots. -- In this case we will use 'Nothing' for the oldest blocks. - let slogUndo :: OldestFirst [] (Maybe FlatSlotId) + let slogUndo :: OldestFirst [] (Maybe LastSlotInfo) slogUndo = map Just removedSlots & _Wrapped %~ (replicate (length blocks - length removedSlots) Nothing <>) -- NE.fromList is safe here, because it's obvious that the size of -- 'slogUndo' is the same as the size of 'blocks'. - return $ over _Wrapped NE.fromList $ map SlogUndo slogUndo + return $ over _Wrapped NE.fromList $ map (SlogUndo . fmap lsiFlatSlotId) slogUndo + + + +toLastSlotInfo :: SlotCount -> Block -> Maybe LastSlotInfo +toLastSlotInfo slotCount blk = + convert <$> rightToMaybe blk + where + convert :: MainBlock -> LastSlotInfo + convert b = + LastSlotInfo + (flattenSlotId slotCount $ view mainBlockSlot b) + (view mainBlockLeaderKey b) -- | Verify block transactions -- From 8352b33c1b4d9e093e028d3955b8180c3d9780dc Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Wed, 30 Jan 2019 17:52:36 +1100 Subject: [PATCH 5/5] More Nix rubbish --- nix/.stack.nix/cardano-sl-chain.nix | 2 ++ pkgs/default.nix | 2 ++ 2 files changed, 4 insertions(+) diff --git a/nix/.stack.nix/cardano-sl-chain.nix b/nix/.stack.nix/cardano-sl-chain.nix index 6327cad7238..b396dd00b3d 100644 --- a/nix/.stack.nix/cardano-sl-chain.nix +++ b/nix/.stack.nix/cardano-sl-chain.nix @@ -30,8 +30,10 @@ (hsPkgs.aeson) (hsPkgs.aeson-options) (hsPkgs.array) + (hsPkgs.base16-bytestring) (hsPkgs.bytestring) (hsPkgs.Cabal) + (hsPkgs.cardano-crypto) (hsPkgs.canonical-json) (hsPkgs.cardano-sl-binary) (hsPkgs.cardano-sl-core) diff --git a/pkgs/default.nix b/pkgs/default.nix index de3f12dcc29..b745eb9e6e0 100644 --- a/pkgs/default.nix +++ b/pkgs/default.nix @@ -14191,9 +14191,11 @@ aeson aeson-options array base +base16-bytestring bytestring Cabal canonical-json +cardano-crypto cardano-sl-binary cardano-sl-core cardano-sl-crypto