Merge pull request #3351 from input-output-hk/ruhatch/CDEC-485

[CDEC-485] Move Block data types from core to chain package

Author: ruhatch

auxx/src/Command/Rollback.hs

@@ -13,10 +13,9 @@ import           Data.List (genericTake)
 import           Formatting (build, int, sformat, string, (%))
 import           System.Wlog (logInfo)
 
-import           Pos.Chain.Block (Blund)
+import           Pos.Chain.Block (Blund, mainBlockTxPayload)
 import           Pos.Chain.Txp (flattenTxPayload)
 import           Pos.Core (difficultyL, epochIndexL)
-import           Pos.Core.Block (mainBlockTxPayload)
 import           Pos.Core.Chrono (NewestFirst, _NewestFirst)
 import           Pos.Core.Txp (TxAux)
 import           Pos.Crypto (ProtocolMagic)

chain/bench/block-bench.hs

@@ -10,7 +10,7 @@ import qualified Data.ByteString.Lazy as LBS
 import           System.Environment (lookupEnv)
 
 import           Pos.Binary.Class (Bi, serialize, unsafeDeserialize)
-import           Pos.Core.Block (Body, BodyProof, ConsensusData, ExtraBodyData,
+import           Pos.Chain.Block (Body, BodyProof, ConsensusData, ExtraBodyData,
                      ExtraHeaderData, MainBlock, MainBlockHeader,
                      MainBlockchain, _gbBody, _gbExtra, _gbHeader,
                      _gbhBodyProof, _gbhConsensus, _gbhExtra, _mbDlgPayload,

chain/cardano-sl-chain.cabal

@@ -27,6 +27,18 @@ library
 
   other-modules:
 
+                       Pos.Chain.Block.Blockchain
+                       Pos.Chain.Block.Genesis
+                       Pos.Chain.Block.Genesis.Lens
+                       Pos.Chain.Block.Genesis.Instances
+                       Pos.Chain.Block.Genesis.Types
+                       Pos.Chain.Block.Main
+                       Pos.Chain.Block.Main.Instances
+                       Pos.Chain.Block.Main.Types
+                       Pos.Chain.Block.Union
+                       Pos.Chain.Block.Union.ComponentBlock
+                       Pos.Chain.Block.Union.Types
+                       Pos.Chain.Block.Constructors
                        Pos.Chain.Block.BHelpers
                        Pos.Chain.Block.Configuration
                        Pos.Chain.Block.Error
@@ -35,6 +47,7 @@ library
                        Pos.Chain.Block.Types
                        Pos.Chain.Block.Slog.Types
                        Pos.Chain.Block.Logic.Integrity
+                       Pos.Chain.Block.JsonLog
 
                        Pos.Chain.Delegation.Cede
                        Pos.Chain.Delegation.Cede.Class
@@ -108,6 +121,8 @@ library
                      , cardano-sl-core
                      , cardano-sl-crypto
                      , cardano-sl-util
+                     , cborg
+                     , cereal
                      , conduit
                      , containers
                      , cryptonite
@@ -130,6 +145,7 @@ library
                      , neat-interpolation
                      , parsec
                      , plutus-prototype
+                     , safecopy
                      , safe-exceptions
                      , serokell-util
                      , reflection
@@ -181,8 +197,10 @@ test-suite test
 
   other-modules:       Spec
                        Test.Pos.Chain.Block.Arbitrary
+                       Test.Pos.Chain.Block.Bi
                        Test.Pos.Chain.Block.BlockSpec
                        Test.Pos.Chain.Block.CborSpec
+                       Test.Pos.Chain.Block.Gen
                        Test.Pos.Chain.Block.SafeCopySpec
                        Test.Pos.Chain.Delegation.Arbitrary
                        Test.Pos.Chain.Lrc.FtsSpec

chain/src/Pos/Chain/Block.hs

@@ -2,8 +2,14 @@ module Pos.Chain.Block
        ( module X
        ) where
 
+import           Pos.Chain.Block.Blockchain as X
 import           Pos.Chain.Block.Configuration as X
+import           Pos.Chain.Block.Constructors as X
 import           Pos.Chain.Block.Error as X
+import           Pos.Chain.Block.Genesis as X
+import           Pos.Chain.Block.JsonLog as X
 import           Pos.Chain.Block.Logic as X
+import           Pos.Chain.Block.Main as X
 import           Pos.Chain.Block.Slog as X
 import           Pos.Chain.Block.Types as X
+import           Pos.Chain.Block.Union as X

chain/src/Pos/Chain/Block/BHelpers.hs

@@ -21,15 +21,15 @@ import           Universum
 import           Control.Monad.Except (MonadError (throwError))
 
 import           Pos.Binary.Class (Bi)
-import           Pos.Chain.Ssc (verifySscPayload)
-import           Pos.Core.Block (Block, GenesisBlockchain, MainBlockchain,
-                     MainConsensusData (..), MainToSign (..))
-import           Pos.Core.Block.Blockchain (Blockchain (..), GenericBlock (..),
+import           Pos.Chain.Block.Blockchain (Blockchain (..), GenericBlock (..),
                      GenericBlockHeader (..), gbExtra)
-import           Pos.Core.Block.Main (MainBody (..), MainExtraHeaderData (..),
+import           Pos.Chain.Block.Main (MainBody (..), MainExtraHeaderData (..),
                      MainProof)
-import           Pos.Core.Block.Union (BlockHeader (..), BlockSignature (..),
+import           Pos.Chain.Block.Union (Block, BlockHeader (..),
+                     BlockSignature (..), GenesisBlockchain, MainBlockchain,
+                     MainConsensusData (..), MainToSign (..),
                      mainBlockEBDataProof)
+import           Pos.Chain.Ssc (verifySscPayload)
 import           Pos.Core.Configuration (HasProtocolConstants)
 import           Pos.Core.Delegation (LightDlgIndices (..), checkDlgPayload)
 import           Pos.Core.Slotting (SlotId (..))

core/src/Pos/Core/Block/Blockchain.hs renamed to chain/src/Pos/Chain/Block/Blockchain.hs

@@ -1,10 +1,11 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE Rank2Types          #-}
+{-# LANGUAGE TypeFamilies        #-}
 
 -- | This module contains some general definitions related to blocks
 -- and headers. The heart of this module is 'Blockchain' type class.
 
-module Pos.Core.Block.Blockchain
+module Pos.Chain.Block.Blockchain
        ( Blockchain (..)
        , GenericBlockHeader (..)
        , GenericBlock (..)

core/src/Pos/Core/Block/Constructors.hs renamed to chain/src/Pos/Chain/Block/Constructors.hs

@@ -1,6 +1,6 @@
 -- | Block constructors and basic functions.
 
-module Pos.Core.Block.Constructors
+module Pos.Chain.Block.Constructors
        ( mkMainBlockExplicit
        , mkMainBlock
        , mkMainHeaderExplicit
@@ -13,21 +13,21 @@ module Pos.Core.Block.Constructors
 
 import           Universum
 
-import           Pos.Core.Attributes (mkAttributes)
-import           Pos.Core.Block.Blockchain (GenericBlock (..), mkGenericHeader)
-import           Pos.Core.Block.Genesis (GenesisBody (..),
+import           Pos.Chain.Block.Blockchain (GenericBlock (..), mkGenericHeader)
+import           Pos.Chain.Block.Genesis (GenesisBody (..),
                      GenesisConsensusData (..), GenesisExtraBodyData (..),
                      GenesisExtraHeaderData (..))
-import           Pos.Core.Block.Main (MainBody (..), MainExtraBodyData (..),
+import           Pos.Chain.Block.Main (MainBody (..), MainExtraBodyData (..),
                      MainExtraHeaderData (..))
-import           Pos.Core.Block.Union (BlockHeader, BlockSignature (..),
+import           Pos.Chain.Block.Union (BlockHeader, BlockSignature (..),
                      GenesisBlock, GenesisBlockHeader, HeaderHash, MainBlock,
                      MainBlockHeader, MainConsensusData (..), MainToSign (..),
                      headerHash)
+import           Pos.Core.Attributes (mkAttributes)
 import           Pos.Core.Common (ChainDifficulty, HasDifficulty (..),
                      SlotLeaders)
 import           Pos.Core.Configuration (GenesisHash (..))
-import           Pos.Core.Delegation.HeavyDlgIndex (ProxySKBlockInfo)
+import           Pos.Core.Delegation (ProxySKBlockInfo)
 import           Pos.Core.Slotting (EpochIndex, SlotId)
 import           Pos.Core.Update (BlockVersion, SoftwareVersion)
 import           Pos.Crypto (ProtocolMagic, SecretKey, SignTag (..), hash,

chain/src/Pos/Chain/Block/Error.hs

@@ -16,7 +16,7 @@ import           Formatting (bprint, stext, (%))
 import           Formatting.Buildable (Buildable (..))
 import           GHC.Generics (Generic)
 
-import           Pos.Core.Block (HeaderHash)
+import           Pos.Chain.Block.Union (HeaderHash)
 import           Pos.Crypto (shortHashF)
 
 

chain/src/Pos/Chain/Block/Genesis.hs

@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -Wno-unused-imports   #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports    #-}
+
+module Pos.Chain.Block.Genesis
+      ( module Pos.Chain.Block.Genesis.Instances
+      , module Pos.Chain.Block.Genesis.Lens
+      , module Pos.Chain.Block.Genesis.Types
+      ) where
+
+import           Pos.Chain.Block.Genesis.Instances
+import           Pos.Chain.Block.Genesis.Lens
+import           Pos.Chain.Block.Genesis.Types

core/src/Pos/Core/Block/Genesis/Instances.hs renamed to chain/src/Pos/Chain/Block/Genesis/Instances.hs

@@ -2,7 +2,7 @@
 
 -- | Miscellaneous instances, etc. Related to the genesis blockchain of course.
 
-module Pos.Core.Block.Genesis.Instances
+module Pos.Chain.Block.Genesis.Instances
        (
        ) where
 
@@ -12,11 +12,11 @@ import           Formatting (bprint, build, sformat, stext, (%))
 import qualified Formatting.Buildable as Buildable
 import           Serokell.Util (Color (Magenta), colorize)
 
-import           Pos.Core.Block.Blockchain (GenericBlock (..), gbHeader,
+import           Pos.Chain.Block.Blockchain (GenericBlock (..), gbHeader,
                      gbhConsensus)
-import           Pos.Core.Block.Genesis.Lens (gcdEpoch)
-import           Pos.Core.Block.Genesis.Types (GenesisBody (..))
-import           Pos.Core.Block.Union.Types (BlockHeader (..), GenesisBlock,
+import           Pos.Chain.Block.Genesis.Lens (gcdEpoch)
+import           Pos.Chain.Block.Genesis.Types (GenesisBody (..))
+import           Pos.Chain.Block.Union.Types (BlockHeader (..), GenesisBlock,
                      GenesisBlockHeader, HasHeaderHash (..), IsGenesisHeader,
                      IsHeader, blockHeaderHash)
 import           Pos.Core.Common (slotLeadersF)

core/src/Pos/Core/Block/Genesis/Lens.hs renamed to chain/src/Pos/Chain/Block/Genesis/Lens.hs

@@ -6,7 +6,7 @@
 -- small parts of it. It makes it clear what exactly is stored in
 -- 'GenesisBlock'. Similar fact is true for `genHeader' prefix.
 
-module Pos.Core.Block.Genesis.Lens
+module Pos.Chain.Block.Genesis.Lens
        (
          -- * Extra types
          gehAttributes
@@ -40,14 +40,14 @@ import           Universum
 
 import           Control.Lens (makeLenses)
 
-import           Pos.Core.Block.Blockchain (gbBody, gbExtra, gbHeader,
+import           Pos.Chain.Block.Blockchain (gbBody, gbExtra, gbHeader,
                      gbPrevBlock, gbhBodyProof, gbhConsensus, gbhExtra,
                      gbhPrevBlock)
-import           Pos.Core.Block.Genesis.Types (GenesisBody (..),
+import           Pos.Chain.Block.Genesis.Types (GenesisBody (..),
                      GenesisBodyAttributes, GenesisExtraBodyData (..),
                      GenesisExtraHeaderData (..), GenesisHeaderAttributes,
                      GenesisProof (..), gcdDifficulty, gcdEpoch)
-import           Pos.Core.Block.Union.Types (GenesisBlock, GenesisBlockHeader,
+import           Pos.Chain.Block.Union.Types (GenesisBlock, GenesisBlockHeader,
                      HeaderHash)
 import           Pos.Core.Common (ChainDifficulty, SlotLeaders)
 import           Pos.Core.Slotting (EpochIndex (..))

core/src/Pos/Core/Block/Genesis/Types.hs renamed to chain/src/Pos/Chain/Block/Genesis/Types.hs

@@ -1,6 +1,6 @@
 -- | Types defining the genesis blockchain.
 
-module Pos.Core.Block.Genesis.Types
+module Pos.Chain.Block.Genesis.Types
        ( GenesisProof (..)
        , GenesisConsensusData (..)
        , GenesisBody (..)

chain/src/Pos/Chain/Block/JsonLog.hs

@@ -0,0 +1,46 @@
+module Pos.Chain.Block.JsonLog
+       ( jlCreatedBlock
+       , jlAdoptedBlock
+       ) where
+
+import           Universum
+
+import           Formatting (sformat)
+
+import           Pos.Chain.Block.Blockchain (gbHeader, gbhPrevBlock)
+import           Pos.Chain.Block.Genesis (genBlockEpoch)
+import           Pos.Chain.Block.Union (Block, HeaderHash, headerHash,
+                     headerHashF, mainBlockSlot, mainBlockTxPayload)
+import           Pos.Core (HasConfiguration, SlotId (..), getEpochIndex,
+                     getSlotIndex, mkLocalSlotIndex)
+import           Pos.Core.JsonLog.LogEvents (JLBlock (..), JLEvent (..))
+import           Pos.Core.Txp (txpTxs)
+import           Pos.Crypto (hash, hashHexF)
+
+-- | Return event of created block.
+jlCreatedBlock :: HasConfiguration => Block -> JLEvent
+jlCreatedBlock block = JLCreatedBlock $ JLBlock {..}
+  where
+    jlHash = showHeaderHash $ headerHash block
+    jlPrevBlock = showHeaderHash $ case block of
+        Left  gB -> view gbhPrevBlock (gB ^. gbHeader)
+        Right mB -> view gbhPrevBlock (mB ^. gbHeader)
+    jlSlot = (getEpochIndex $ siEpoch slot, getSlotIndex $ siSlot slot)
+    jlTxs = case block of
+              Left _   -> []
+              Right mB -> map fromTx . toList $ mB ^. mainBlockTxPayload . txpTxs
+    slot :: SlotId
+    slot = case block of
+        Left  gB -> let slotZero = case mkLocalSlotIndex 0 of
+                                        Right sz -> sz
+                                        Left _   -> error "impossible branch"
+                    in SlotId (gB ^. genBlockEpoch) slotZero
+        Right mB -> mB ^. mainBlockSlot
+    fromTx = sformat hashHexF . hash
+
+-- | Returns event of created 'Block'.
+jlAdoptedBlock :: Block -> JLEvent
+jlAdoptedBlock = JLAdoptedBlock . showHeaderHash . headerHash
+
+showHeaderHash :: HeaderHash -> Text
+showHeaderHash = sformat headerHashF

chain/src/Pos/Chain/Block/Logic/Integrity.hs

@@ -26,16 +26,18 @@ import           Serokell.Util (VerificationRes (..), verifyGeneric)
 
 import qualified Pos.Binary.Class as Bi
 import qualified Pos.Chain.Block.BHelpers as BHelpers
+import           Pos.Chain.Block.Blockchain (gbExtra, gbhExtra)
+import           Pos.Chain.Block.Genesis (gebAttributes, gehAttributes,
+                     genBlockLeaders)
+import           Pos.Chain.Block.Union (Block, BlockHeader (..),
+                     HasHeaderHash (..), HeaderHash, blockHeaderProtocolMagic,
+                     getBlockHeader, headerSlotL, mainHeaderLeaderKey,
+                     mebAttributes, mehAttributes, prevBlockL)
 import           Pos.Core (ChainDifficulty, EpochOrSlot, HasDifficulty (..),
                      HasEpochIndex (..), HasEpochOrSlot (..),
                      HasProtocolConstants, SlotId (..), SlotLeaders,
                      addressHash, getSlotIndex)
 import           Pos.Core.Attributes (areAttributesKnown)
-import           Pos.Core.Block (Block, BlockHeader (..), HasHeaderHash (..),
-                     HeaderHash, blockHeaderProtocolMagic, gbExtra, gbhExtra,
-                     gebAttributes, gehAttributes, genBlockLeaders,
-                     getBlockHeader, headerSlotL, mainHeaderLeaderKey,
-                     mebAttributes, mehAttributes, prevBlockL)
 import           Pos.Core.Chrono (NewestFirst (..), OldestFirst)
 import           Pos.Core.Slotting (EpochIndex)
 import           Pos.Core.Update (BlockVersionData (..))

chain/src/Pos/Chain/Block/Main.hs

@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-unused-imports   #-}
+{-# OPTIONS_GHC -Wno-dodgy-exports    #-}
+
+module Pos.Chain.Block.Main
+      ( module Pos.Chain.Block.Main.Instances
+      , module Pos.Chain.Block.Main.Types
+      ) where
+
+import           Pos.Chain.Block.Main.Instances
+import           Pos.Chain.Block.Main.Types

core/src/Pos/Core/Block/Main/Instances.hs renamed to chain/src/Pos/Chain/Block/Main/Instances.hs

@@ -2,7 +2,7 @@
 
 -- | Miscellaneous instances, etc. Related to the main blockchain of course.
 
-module Pos.Core.Block.Main.Instances
+module Pos.Chain.Block.Main.Instances
        (
        ) where
 
@@ -12,10 +12,10 @@ import           Formatting (bprint, build, int, stext, (%))
 import qualified Formatting.Buildable as Buildable
 import           Serokell.Util (Color (Magenta), colorize, listJson)
 
-import           Pos.Core.Block.Blockchain (GenericBlock (..))
-import           Pos.Core.Block.Main.Types (MainBody (..),
+import           Pos.Chain.Block.Blockchain (GenericBlock (..))
+import           Pos.Chain.Block.Main.Types (MainBody (..),
                      MainExtraHeaderData (..))
-import           Pos.Core.Block.Union.Types (BlockHeader (..),
+import           Pos.Chain.Block.Union.Types (BlockHeader (..),
                      HasHeaderHash (..), IsHeader, IsMainHeader (..),
                      MainBlock, MainBlockHeader, MainConsensusData (..),
                      blockHeaderHash, mainBlockBlockVersion, mainBlockSlot,

core/src/Pos/Core/Block/Main/Types.hs renamed to chain/src/Pos/Chain/Block/Main/Types.hs

@@ -1,6 +1,6 @@
 -- | Types defining the main blockchain.
 
-module Pos.Core.Block.Main.Types
+module Pos.Chain.Block.Main.Types
        ( MainProof (..)
        , MainExtraHeaderData (..)
        , MainBody (..)
@@ -54,7 +54,7 @@ instance Bi MainProof where
                          decode <*>
                          decode
 
-instance SafeCopy SscProof => SafeCopy MainProof where
+instance SafeCopy MainProof where
     getCopy = contain $ do
         mpTxProof <- safeGet
         mpMpcProof      <- safeGet
@@ -128,8 +128,7 @@ instance Bi MainBody where
 
 instance NFData MainBody
 
-instance SafeCopy SscPayload =>
-         SafeCopy MainBody where
+instance SafeCopy MainBody where
     getCopy = contain $ do
         _mbTxPayload     <- safeGet
         _mbSscPayload    <- safeGet

chain/src/Pos/Chain/Block/Types.hs

@@ -18,10 +18,10 @@ import           Serokell.Util.Text (listJson)
 
 import           Pos.Binary.Class (Cons (..), Field (..), deriveSimpleBi)
 import           Pos.Chain.Block.Slog.Types (SlogUndo (..))
+import           Pos.Chain.Block.Union (Block, BlockHeader, HasHeaderHash (..))
 import           Pos.Chain.Delegation (DlgUndo)
 import           Pos.Chain.Update (USUndo)
 import           Pos.Core (HasConfiguration, HasDifficulty (..))
-import           Pos.Core.Block (Block, BlockHeader, HasHeaderHash (..))
 import           Pos.Core.Txp (TxpUndo)
 import           Pos.Util.Util (HasLens (..))
 

chain/src/Pos/Chain/Block/Union.hs

@@ -0,0 +1,7 @@
+module Pos.Chain.Block.Union
+       ( module Pos.Chain.Block.Union.ComponentBlock
+       , module Pos.Chain.Block.Union.Types
+       ) where
+
+import           Pos.Chain.Block.Union.ComponentBlock
+import           Pos.Chain.Block.Union.Types