Merge pull request #3179 from input-output-hk/intricate/CDEC-418

[CDEC-418] Reunite orphan Bi instances in txp
input-output-hk · Jul 5, 2018 · 5175273 · 5175273
2 parents ef8d1eb + 369bf54
commit 5175273
Show file tree

Hide file tree

Showing 44 changed files with 91 additions and 102 deletions.
diff --git a/block/src/Pos/Block/Network/Logic.hs b/block/src/Pos/Block/Network/Logic.hs
@@ -28,7 +28,6 @@ import           Serokell.Util.Text (listJson)
 import qualified System.Metrics.Gauge as Metrics
 import           System.Wlog (logDebug, logInfo, logWarning)
 
-import           Pos.Binary.Txp ()
 import           Pos.Block.BlockWorkMode (BlockWorkMode)
 import           Pos.Block.Error (ApplyBlocksException)
 import           Pos.Block.Logic (ClassifyHeaderRes (..), classifyNewHeader,

diff --git a/block/test/Test/Pos/Block/Arbitrary.hs b/block/test/Test/Pos/Block/Arbitrary.hs
@@ -44,9 +44,9 @@ import           Pos.Crypto (ProtocolMagic, PublicKey, SecretKey, createPsk,
 import           Pos.Data.Attributes (areAttributesKnown)
 
 import           Test.Pos.Core.Arbitrary (genSlotId)
+import           Test.Pos.Core.Arbitrary.Txp (genTxPayload)
 import           Test.Pos.Crypto.Dummy (dummyProtocolMagic)
 import           Test.Pos.Delegation.Arbitrary (genDlgPayload)
-import           Test.Pos.Txp.Arbitrary (genTxPayload)
 import           Test.Pos.Update.Arbitrary (genUpdatePayload)
 
 newtype BodyDependsOnSlot b = BodyDependsOnSlot

diff --git a/client/src/Pos/Client/Txp/Network.hs b/client/src/Pos/Client/Txp/Network.hs
@@ -27,14 +27,13 @@ import           Pos.Communication.Message ()
 import           Pos.Communication.Types (InvOrDataTK)
 import           Pos.Core (Address, Coin, makeRedeemAddress, mkCoin,
                      unsafeAddCoin)
-import           Pos.Core.Txp (TxAux (..), TxId, TxOut (..), TxOutAux (..),
-                     txaF)
+import           Pos.Core.Txp (TxAux (..), TxId, TxMsgContents (..), TxOut (..),
+                     TxOutAux (..), txaF)
 import           Pos.Crypto (ProtocolMagic, RedeemSecretKey, SafeSigner, hash,
                      redeemToPublic)
 import           Pos.Infra.Communication.Protocol (OutSpecs)
 import           Pos.Infra.Communication.Specs (createOutSpecs)
 import           Pos.Infra.Diffusion.Types (Diffusion (sendTx))
-import           Pos.Txp.Network.Types (TxMsgContents (..))
 import           Pos.Util.Util (eitherToThrow)
 import           Pos.WorkMode.Class (MinWorkMode)
 

diff --git a/core/cardano-sl-core.cabal b/core/cardano-sl-core.cabal
@@ -144,6 +144,7 @@ library
                        -- Txp
                        Pos.Core.Txp.Tx
                        Pos.Core.Txp.TxAux
+                       Pos.Core.Txp.TxMsg
                        Pos.Core.Txp.TxOutAux
                        Pos.Core.Txp.TxPayload
                        Pos.Core.Txp.TxProof

diff --git a/core/src/Pos/Core/Txp.hs b/core/src/Pos/Core/Txp.hs
@@ -1,6 +1,7 @@
 module Pos.Core.Txp
        ( module Pos.Core.Txp.Tx
        , module Pos.Core.Txp.TxAux
+       , module Pos.Core.Txp.TxMsg
        , module Pos.Core.Txp.TxOutAux
        , module Pos.Core.Txp.TxPayload
        , module Pos.Core.Txp.TxProof
@@ -10,6 +11,7 @@ module Pos.Core.Txp
 
 import           Pos.Core.Txp.Tx
 import           Pos.Core.Txp.TxAux
+import           Pos.Core.Txp.TxMsg
 import           Pos.Core.Txp.TxOutAux
 import           Pos.Core.Txp.TxPayload
 import           Pos.Core.Txp.TxProof

diff --git a/txp/src/Pos/Txp/Network/Types.hs → core/src/Pos/Core/Txp/TxMsg.hs b/txp/src/Pos/Txp/Network/Types.hs → core/src/Pos/Core/Txp/TxMsg.hs
@@ -1,14 +1,13 @@
--- | Types used for communication about transactions.
-
-module Pos.Txp.Network.Types
+module Pos.Core.Txp.TxMsg
        ( TxMsgContents (..)
        ) where
 
-import qualified Data.Text.Buildable as Buildable
-import           Formatting (bprint, (%))
 import           Universum
 
-import           Pos.Core.Txp (TxAux (..), txaF)
+import           Data.Text.Buildable (Buildable (..))
+import           Formatting (bprint, (%))
+
+import           Pos.Core.Txp.TxAux (TxAux (..), txaF)
 
 -- | Data message. Can be used to send one transaction per message.
 -- Transaction is sent with auxilary data.

diff --git a/txp/test/Test/Pos/Txp/Arbitrary.hs → core/test/Test/Pos/Core/Arbitrary/Txp.hs b/txp/test/Test/Pos/Txp/Arbitrary.hs → core/test/Test/Pos/Core/Arbitrary/Txp.hs
@@ -4,7 +4,7 @@
 
 -- | `Arbitrary` instances for Txp types
 
-module Test.Pos.Txp.Arbitrary
+module Test.Pos.Core.Arbitrary.Txp
        ( BadSigsTx (..)
        , DoubleInputTx (..)
        , GoodTx (..)

diff --git a/txp/test/Test/Pos/Txp/Arbitrary/Unsafe.hs → ...est/Test/Pos/Core/Arbitrary/Txp/Unsafe.hs b/txp/test/Test/Pos/Txp/Arbitrary/Unsafe.hs → ...est/Test/Pos/Core/Arbitrary/Txp/Unsafe.hs
@@ -2,7 +2,7 @@
 
 -- | 'Arbitrary' unsafe instances for some types from Txp types
 
-module Test.Pos.Txp.Arbitrary.Unsafe () where
+module Test.Pos.Core.Arbitrary.Txp.Unsafe () where
 
 import           Universum
 

diff --git a/core/test/cardano-sl-core-test.cabal b/core/test/cardano-sl-core-test.cabal
@@ -19,6 +19,8 @@ library
                        Test.Pos.Core.Gen
                        Test.Pos.Core.Arbitrary
                        Test.Pos.Core.Arbitrary.Unsafe
+                       Test.Pos.Core.Arbitrary.Txp
+                       Test.Pos.Core.Arbitrary.Txp.Unsafe
 
   build-depends:       QuickCheck
                      , base

diff --git a/explorer/bench/Bench/Pos/Explorer/ServerBench.hs b/explorer/bench/Bench/Pos/Explorer/ServerBench.hs
@@ -21,7 +21,7 @@ import           Pos.Explorer.Web.ClientTypes (CBlockEntry)
 import           Pos.Explorer.Web.Server (getBlocksPage, getBlocksTotal)
 
 import           Test.Pos.Configuration (withDefConfigurations)
-import           Test.Pos.Txp.Arbitrary.Unsafe ()
+import           Test.Pos.Core.Arbitrary.Txp.Unsafe ()
 
 ----------------------------------------------------------------
 -- Mocked functions

diff --git a/explorer/cardano-sl-explorer.cabal b/explorer/cardano-sl-explorer.cabal
@@ -413,6 +413,7 @@ benchmark cardano-explorer-bench
   build-depends:       QuickCheck
                      , base
                      , cardano-sl
+                     , cardano-sl-core-test
                      , cardano-sl-explorer
                      , cardano-sl-txp
                      , cardano-sl-txp-test

diff --git a/explorer/src/Pos/Arbitrary/Explorer.hs b/explorer/src/Pos/Arbitrary/Explorer.hs
@@ -11,7 +11,7 @@ import           Test.QuickCheck.Arbitrary.Generic (genericArbitrary,
 import           Pos.Explorer.Core.Types (TxExtra (..))
 
 import           Test.Pos.Core.Arbitrary ()
-import           Test.Pos.Txp.Arbitrary ()
+import           Test.Pos.Core.Arbitrary.Txp ()
 
 instance Arbitrary TxExtra where
     arbitrary = genericArbitrary

diff --git a/generator/cardano-sl-generator.cabal b/generator/cardano-sl-generator.cabal
@@ -129,6 +129,7 @@ test-suite cardano-generator-test
                      , cardano-sl-block
                      , cardano-sl-block-test
                      , cardano-sl-core
+                     , cardano-sl-core-test
                      , cardano-sl-crypto
                      , cardano-sl-crypto-test
                      , cardano-sl-db

diff --git a/generator/test/Test/Pos/Block/Logic/CreationSpec.hs b/generator/test/Test/Pos/Block/Logic/CreationSpec.hs
@@ -36,9 +36,9 @@ import           Pos.Update.Configuration (HasUpdateConfiguration)
 import           Test.Pos.Block.Arbitrary ()
 import           Test.Pos.Configuration (withDefConfiguration,
                      withDefUpdateConfiguration)
+import           Test.Pos.Core.Arbitrary.Txp (GoodTx, goodTxToTxAux)
 import           Test.Pos.Crypto.Dummy (dummyProtocolMagic)
 import           Test.Pos.Delegation.Arbitrary (genDlgPayload)
-import           Test.Pos.Txp.Arbitrary (GoodTx, goodTxToTxAux)
 import           Test.Pos.Util.QuickCheck (SmallGenerator (..), makeSmall)
 
 spec :: Spec

diff --git a/infra/src/Pos/Infra/Communication/Types/Relay.hs b/infra/src/Pos/Infra/Communication/Types/Relay.hs
@@ -24,6 +24,7 @@ import           Formatting (bprint, build, (%))
 import           Pos.Binary.Class (Bi (..))
 import qualified Pos.Core.Update as U
 import           Pos.Crypto (hash)
+import           Pos.Core.Txp (TxMsgContents (..))
 import           Pos.Util.Util (cborError)
 
 -- | Inventory message. Can be used to announce the fact that you have
@@ -67,6 +68,10 @@ data DataMsg contents = DataMsg
     { dmContents :: !contents
     } deriving (Generic, Show, Eq)
 
+instance Bi (DataMsg TxMsgContents) where
+    encode (DataMsg (TxMsgContents txAux)) = encode txAux
+    decode = DataMsg <$> (TxMsgContents <$> decode)
+
 instance Bi (DataMsg U.UpdateVote) where
     encode = encode . dmContents
     decode = DataMsg <$> decode

diff --git a/txp/test/Test/Pos/Txp/Arbitrary/Network.hs → ...Test/Pos/Infra/Arbitrary/Communication.hs b/txp/test/Test/Pos/Txp/Arbitrary/Network.hs → ...Test/Pos/Infra/Arbitrary/Communication.hs
@@ -1,25 +1,22 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
--- | 'Arbitrary' instances for 'Pos.Txp.Network' types defined in 'src'
+-- | 'Arbitrary' instances for 'Pos.Infra.Communication' types defined in 'src'
 
-module Test.Pos.Txp.Arbitrary.Network () where
+module Test.Pos.Infra.Arbitrary.Communication () where
 
 import           Universum
 
 import           Test.QuickCheck (Arbitrary (..))
 import           Test.QuickCheck.Arbitrary.Generic (genericArbitrary,
                      genericShrink)
 
+import           Pos.Core.Txp (TxMsgContents (..))
 import           Pos.Infra.Communication.Types.Relay (DataMsg (..))
-import           Pos.Txp.Network.Types (TxMsgContents (..))
 
-import           Test.Pos.Txp.Arbitrary ()
-
-instance Arbitrary TxMsgContents where
-    arbitrary = genericArbitrary
-    shrink = genericShrink
+import           Test.Pos.Infra.Arbitrary.Txp ()
 
 instance Arbitrary (DataMsg TxMsgContents) where
     arbitrary = DataMsg <$> arbitrary

diff --git a/infra/test/Test/Pos/Infra/Arbitrary/Txp.hs b/infra/test/Test/Pos/Infra/Arbitrary/Txp.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | 'Arbitrary' instances for 'Pos.Infra.Communication' types defined in 'src'
+
+module Test.Pos.Infra.Arbitrary.Txp () where
+
+import           Universum
+
+import           Test.QuickCheck (Arbitrary (..))
+import           Test.QuickCheck.Arbitrary.Generic (genericArbitrary,
+                     genericShrink)
+
+import           Pos.Core.Txp (TxMsgContents (..))
+
+import           Test.Pos.Core.Arbitrary.Txp ()
+
+instance Arbitrary TxMsgContents where
+    arbitrary = genericArbitrary
+    shrink = genericShrink
diff --git a/infra/test/cardano-sl-infra-test.cabal b/infra/test/cardano-sl-infra-test.cabal
@@ -14,7 +14,9 @@ cabal-version:       >=1.10
 library
   exposed-modules:
                        Test.Pos.Infra.Arbitrary
+                       Test.Pos.Infra.Arbitrary.Communication
                        Test.Pos.Infra.Arbitrary.Slotting
+                       Test.Pos.Infra.Arbitrary.Txp
                        Test.Pos.Infra.Gen
 
   build-depends:       QuickCheck

diff --git a/lib/bench/Bench/Pos/Criterion/TxSigningBench.hs b/lib/bench/Bench/Pos/Criterion/TxSigningBench.hs
@@ -12,7 +12,7 @@ import           Pos.Crypto (SecretKey, SignTag (SignTx), sign)
 import           Pos.Ssc ()
 import           Pos.Txp (TxId, TxSig, TxSigData (..))
 
-import           Test.Pos.Txp.Arbitrary.Unsafe ()
+import           Test.Pos.Core.Arbitrary.Txp.Unsafe ()
 import           Test.Pos.Util.QuickCheck.Arbitrary (arbitraryUnsafe)
 
 import           Bench.Configuration (benchProtocolMagic)

diff --git a/lib/src/Pos/Binary.hs b/lib/src/Pos/Binary.hs
@@ -8,4 +8,3 @@ module Pos.Binary
 import           Pos.Binary.Class
 import           Pos.Binary.Communication ()
 import           Pos.Binary.Delegation ()
-import           Pos.Binary.Txp ()
diff --git a/lib/src/Pos/Communication/Limits.hs b/lib/src/Pos/Communication/Limits.hs
@@ -69,13 +69,12 @@ import           Pos.Core.Block (Block, BlockHeader (..), GenesisBlock,
 import           Pos.Core.Delegation (HeavyDlgIndex (..), LightDlgIndices (..))
 import           Pos.Core.Ssc (Commitment (..), InnerSharesMap, Opening (..),
                      SignedCommitment)
-import           Pos.Core.Txp (TxAux)
+import           Pos.Core.Txp (TxAux, TxMsgContents (..))
 import           Pos.Core.Update (UpdateProposal (..), UpdateVote (..))
 import           Pos.Crypto (ProxyCert (..), ProxySecretKey (..),
                      SecretProof (..))
 import           Pos.Ssc.Message (MCCommitment (..), MCOpening (..),
                      MCShares (..), MCVssCertificate (..))
-import           Pos.Txp.Network.Types (TxMsgContents (..))
 
 import           Pos.Core.Chrono (NewestFirst (..))
 import           Pos.Crypto.Limits (mlAbstractHash, mlDecShare, mlEncShare,

diff --git a/lib/src/Pos/Communication/Message.hs b/lib/src/Pos/Communication/Message.hs
@@ -12,14 +12,14 @@ import           Node.Message.Class (Message (..))
 import           Pos.Block.Network (MsgBlock, MsgGetBlocks, MsgGetHeaders,
                      MsgHeaders, MsgStream, MsgStreamBlock)
 import           Pos.Core (ProxySKHeavy)
+import           Pos.Core.Txp (TxMsgContents)
 import           Pos.Core.Update (UpdateProposal, UpdateVote)
 import           Pos.Infra.Communication.Types.Protocol (MsgSubscribe,
                      MsgSubscribe1)
 import           Pos.Infra.Communication.Types.Relay (DataMsg, InvMsg,
                      InvOrData, MempoolMsg, ReqMsg, ReqOrRes)
 import           Pos.Ssc.Message (MCCommitment, MCOpening, MCShares,
                      MCVssCertificate)
-import           Pos.Txp.Network.Types (TxMsgContents)
 
 -- Why?
 instance Message Void where

diff --git a/lib/src/Pos/Communication/Types.hs b/lib/src/Pos/Communication/Types.hs
@@ -4,9 +4,7 @@ module Pos.Communication.Types
        ( -- * Messages and socket state
          module Pos.Infra.Communication.Types.Protocol
        , module Pos.Infra.Communication.Types.Relay
-       , module Pos.Txp.Network.Types
        ) where
 
 import           Pos.Infra.Communication.Types.Protocol
 import           Pos.Infra.Communication.Types.Relay
-import           Pos.Txp.Network.Types
diff --git a/lib/src/Pos/Diffusion/Full/Txp.hs b/lib/src/Pos/Diffusion/Full/Txp.hs
@@ -12,10 +12,9 @@ import qualified Network.Broadcast.OutboundQueue as OQ
 import           Universum
 
 import           Pos.Binary.Communication ()
-import           Pos.Binary.Txp ()
 import           Pos.Communication.Limits (mlTxMsgContents)
 import           Pos.Communication.Message ()
-import           Pos.Core.Txp (TxAux (..), TxId)
+import           Pos.Core.Txp (TxAux (..), TxId, TxMsgContents (..))
 import           Pos.Crypto (hash)
 import           Pos.Infra.Communication.Protocol (EnqueueMsg, MkListeners,
                      MsgType (..), NodeId, Origin (..), OutSpecs)
@@ -25,7 +24,6 @@ import           Pos.Infra.Communication.Relay (InvReqDataParams (..),
 import           Pos.Infra.Network.Types (Bucket)
 import           Pos.Logic.Types (Logic (..))
 import qualified Pos.Logic.Types as KV (KeyVal (..))
-import           Pos.Txp.Network.Types (TxMsgContents (..))
 import           Pos.Util.Trace (Severity, Trace)
 
 -- | Send Tx to given addresses.

diff --git a/lib/src/Pos/Logic/Full.hs b/lib/src/Pos/Logic/Full.hs
@@ -26,6 +26,7 @@ import           Pos.Core (Block, BlockHeader, BlockVersionData,
                      TxAux (..), addressHash, getCertId, lookupVss)
 import           Pos.Core.Chrono (NE, NewestFirst, OldestFirst)
 import           Pos.Core.Ssc (getCommitmentsMap)
+import           Pos.Core.Txp (TxMsgContents (..))
 import           Pos.Core.Update (UpdateProposal (..), UpdateVote (..))
 import           Pos.Crypto (ProtocolMagic, hash)
 import qualified Pos.DB.Block as DB (getTipBlock)
@@ -55,7 +56,6 @@ import           Pos.Txp (MemPool (..))
 import           Pos.Txp.MemState (getMemPool, withTxpLocalData)
 import           Pos.Txp.Network.Listeners (TxpMode)
 import qualified Pos.Txp.Network.Listeners as Txp (handleTxDo)
-import           Pos.Txp.Network.Types (TxMsgContents (..))
 import qualified Pos.Update.Logic.Local as Update (getLocalProposalNVotes,
                      getLocalVote, isProposalNeeded, isVoteNeeded)
 import           Pos.Update.Mode (UpdateMode)

diff --git a/lib/src/Pos/Logic/Types.hs b/lib/src/Pos/Logic/Types.hs
@@ -19,11 +19,11 @@ import           Pipes.Internal (unsafeHoist)
 
 import           Pos.Block.Logic (GetHashesRangeError,
                      GetHeadersFromManyToError)
-import           Pos.Communication (NodeId, TxMsgContents)
+import           Pos.Communication (NodeId)
 import           Pos.Core (HeaderHash, ProxySKHeavy, StakeholderId)
 import           Pos.Core.Block (Block, BlockHeader)
 import           Pos.Core.Chrono (NE, NewestFirst, OldestFirst (..))
-import           Pos.Core.Txp (TxId)
+import           Pos.Core.Txp (TxId, TxMsgContents)
 import           Pos.Core.Update (BlockVersionData, UpId, UpdateProposal,
                      UpdateVote, VoteId)
 import           Pos.DB.Class (SerializedBlock)

diff --git a/lib/test/Test/Pos/Cbor/CborSpec.hs b/lib/test/Test/Pos/Cbor/CborSpec.hs
@@ -28,6 +28,7 @@ import           Pos.Communication.Limits (mlOpening, mlUpdateVote,
                      mlVssCertificate)
 import           Pos.Core (ProxySKHeavy, StakeholderId, VssCertificate)
 import qualified Pos.Core.Ssc as Ssc
+import           Pos.Core.Txp (TxMsgContents (..))
 import           Pos.Crypto.Signing (EncryptedSecretKey)
 import           Pos.Delegation (DlgPayload, DlgUndo)
 import           Pos.Infra.Binary ()
@@ -49,8 +50,8 @@ import           Test.Pos.Core.Arbitrary ()
 import           Test.Pos.Crypto.Arbitrary ()
 import           Test.Pos.Delegation.Arbitrary ()
 import           Test.Pos.Infra.Arbitrary ()
+import           Test.Pos.Infra.Arbitrary.Communication ()
 import           Test.Pos.Infra.Arbitrary.Slotting ()
-import           Test.Pos.Txp.Arbitrary.Network ()
 import           Test.Pos.Update.Arbitrary ()
 import           Test.Pos.Util.QuickCheck (SmallGenerator)
 
@@ -148,17 +149,17 @@ spec = withDefConfiguration $ \_ -> do
                     binaryTest @(SmallGenerator T.TxPayload)
                     binaryTest @T.TxpUndo
                 describe "Network" $ do
-                    binaryTest @(R.InvMsg (Tagged T.TxMsgContents T.TxId))
-                    binaryTest @(R.ReqMsg (Tagged T.TxMsgContents T.TxId))
-                    binaryTest @(R.MempoolMsg T.TxMsgContents)
-                    binaryTest @(R.DataMsg T.TxMsgContents)
+                    binaryTest @(R.InvMsg (Tagged TxMsgContents T.TxId))
+                    binaryTest @(R.ReqMsg (Tagged TxMsgContents T.TxId))
+                    binaryTest @(R.MempoolMsg TxMsgContents)
+                    binaryTest @(R.DataMsg TxMsgContents)
             describe "Bi extension" $ do
                 prop "TxInWitness" (extensionProperty @T.TxInWitness)
             describe "Message length limit" $ do
-                msgLenLimitedTest @(R.InvMsg (Tagged T.TxMsgContents T.TxId)) mlInvMsg
-                msgLenLimitedTest @(R.ReqMsg (Tagged T.TxMsgContents T.TxId)) mlReqMsg
-                msgLenLimitedTest @(R.MempoolMsg T.TxMsgContents) mlMempoolMsg
-                -- No check for (DataMsg T.TxMsgContents) since overal message size
+                msgLenLimitedTest @(R.InvMsg (Tagged TxMsgContents T.TxId)) mlInvMsg
+                msgLenLimitedTest @(R.ReqMsg (Tagged TxMsgContents T.TxId)) mlReqMsg
+                msgLenLimitedTest @(R.MempoolMsg TxMsgContents) mlMempoolMsg
+                -- No check for (DataMsg TxMsgContents) since overal message size
                 -- is forcely limited
         describe "Update system" $ do
             describe "Bi instances" $ do

diff --git a/lib/test/Test/Pos/Types/Identity/SafeCopySpec.hs b/lib/test/Test/Pos/Types/Identity/SafeCopySpec.hs
@@ -13,8 +13,8 @@ import qualified Pos.Core.Txp as Txp
 
 import           Test.Pos.Binary.Helpers (safeCopyTest)
 import           Test.Pos.Configuration (withDefConfiguration)
-import           Test.Pos.Txp.Arbitrary ()
-import           Test.Pos.Txp.Arbitrary.Network ()
+import           Test.Pos.Core.Arbitrary.Txp ()
+import           Test.Pos.Infra.Arbitrary.Txp ()
 
 spec :: Spec
 spec = withDefConfiguration $ \_ -> describe "Types" $ do