Merge branch 'master' into feature/csl522-pay-us

cardano-sl.cabal

@@ -102,7 +102,8 @@ library
 
                         -- Update system
                         Pos.Update
-                        Pos.Update.Types
+                        Pos.Update.Arbitrary
+                        Pos.Update.Core
 
                         -- Utilities/helpers
                         Pos.Util
@@ -288,20 +289,23 @@ library
                         Pos.Worker.Stats
 
                         -- Update System
+                        Pos.Update.Arbitrary.Core
+                        Pos.Update.Arbitrary.Network
+                        Pos.Update.Core.Types
                         Pos.Update.Download
                         Pos.Update.Error
-                        Pos.Update.Listeners
                         Pos.Update.Logic
                         Pos.Update.Lrc
                         Pos.Update.MemState
                         Pos.Update.MemState.Class
                         Pos.Update.MemState.Holder
                         Pos.Update.MemState.MemState
                         Pos.Update.MemState.Types
+                        Pos.Update.Network
+                        Pos.Update.Network.Listeners
+                        Pos.Update.Network.Types
                         Pos.Update.Poll
                         Pos.Update.Poll.Class
-                        Pos.Update.Types.Communication
-                        Pos.Update.Types.Types
                         Pos.Update.Worker
 
                         -- Utilities/helpers

src/Pos/Binary/Communication.hs

@@ -3,22 +3,22 @@
 
 module Pos.Binary.Communication () where
 
-import           Data.Binary.Get         (getInt32be, getWord8, label)
-import           Data.Binary.Put         (putInt32be, putWord8)
-import           Node.Message            (MessageName (..))
+import           Data.Binary.Get          (getInt32be, getWord8, label)
+import           Data.Binary.Put          (putInt32be, putWord8)
+import           Node.Message             (MessageName (..))
 import           Universum
 
-import           Pos.Binary.Class        (Bi (..))
-import           Pos.Block.Network.Types (MsgBlock (..), MsgGetBlocks (..),
-                                          MsgGetHeaders (..), MsgHeaders (..))
-import           Pos.Communication.Types (SysStartRequest (..), SysStartResponse (..),
-                                          VersionReq (..), VersionResp (..))
-import           Pos.Delegation.Types    (CheckProxySKConfirmed (..),
-                                          CheckProxySKConfirmedRes (..),
-                                          ConfirmProxySK (..), SendProxySK (..))
-import           Pos.Ssc.Class.Types     (Ssc (..))
-import           Pos.Txp.Types           (TxMsgTag (..))
-import           Pos.Update.Types        (ProposalMsgTag (..), VoteMsgTag (..))
+import           Pos.Binary.Class         (Bi (..))
+import           Pos.Block.Network.Types  (MsgBlock (..), MsgGetBlocks (..),
+                                           MsgGetHeaders (..), MsgHeaders (..))
+import           Pos.Communication.Types  (SysStartRequest (..), SysStartResponse (..),
+                                           VersionReq (..), VersionResp (..))
+import           Pos.Delegation.Types     (CheckProxySKConfirmed (..),
+                                           CheckProxySKConfirmedRes (..),
+                                           ConfirmProxySK (..), SendProxySK (..))
+import           Pos.Ssc.Class.Types      (Ssc (..))
+import           Pos.Txp.Types            (TxMsgTag (..))
+import           Pos.Update.Network.Types (ProposalMsgTag (..), VoteMsgTag (..))
 
 deriving instance Bi MessageName
 

src/Pos/Binary/Relay.hs

@@ -12,7 +12,7 @@ import           Pos.Ssc.GodTossing.Types.Message (GtMsgContents (..))
 import           Pos.Txp.Types.Communication      (TxMsgContents (..))
 import           Pos.Types                        (TxId)
 import           Pos.Types.Address                (StakeholderId, addressHash)
-import           Pos.Update.Types                 (UpId, UpdateProposal)
+import           Pos.Update.Core                  (UpId, UpdateProposal)
 import           Pos.Util.Relay                   (DataMsg (..), DataMsgGodTossing (..),
                                                    InvMsg (..), ReqMsg (..))
 

src/Pos/Binary/Update.hs

@@ -4,17 +4,17 @@
 
 module Pos.Binary.Update () where
 
-import           Data.Binary         (Binary)
-import           Data.Binary.Get     (label)
-import qualified Data.HashMap.Strict as HM
-import qualified Data.Text           as T
+import           Data.Binary           (Binary)
+import           Data.Binary.Get       (label)
+import qualified Data.HashMap.Strict   as HM
+import qualified Data.Text             as T
 import           Universum
 
-import           Pos.Binary.Class    (Bi (..))
-import           Pos.Binary.Util     (getAsciiString1b, putAsciiString1b)
-import           Pos.Binary.Version  ()
-import           Pos.Crypto          (checkSig)
-import qualified Pos.Update.Types    as U
+import           Pos.Binary.Class      (Bi (..))
+import           Pos.Binary.Util       (getAsciiString1b, putAsciiString1b)
+import           Pos.Binary.Version    ()
+import           Pos.Crypto            (checkSig)
+import qualified Pos.Update.Core.Types as U
 
 instance Bi U.SystemTag where
     get =

src/Pos/Block/Arbitrary.hs

@@ -5,25 +5,26 @@ module Pos.Block.Arbitrary
        )
        where
 
-import           Test.QuickCheck     (Arbitrary (..), Gen, choose, listOf, oneof,
-                                      vectorOf)
+import           Control.Lens         (view, _1)
+import           Data.Ix              (range)
+import           Data.Text.Buildable  (Buildable)
+import qualified Data.Text.Buildable  as Buildable
+import           Formatting           (bprint, build, formatToString, (%))
+import           Test.QuickCheck      (Arbitrary (..), Gen, choose, listOf, oneof,
+                                       vectorOf)
 import           Universum
 
-import           Control.Lens        (view, _1)
-import           Data.Ix             (range)
-import           Data.Text.Buildable (Buildable)
-import qualified Data.Text.Buildable as Buildable
-import           Formatting          (bprint, build, formatToString, (%))
-import           Pos.Binary          (Bi)
-import           Pos.Block.Network   as T
-import           Pos.Constants       (epochSlots)
-import           Pos.Crypto          (Hash, ProxySecretKey, PublicKey, SecretKey,
-                                      createProxySecretKey, toPublic)
-import           Pos.Data.Attributes (Attributes (..), mkAttributes)
-import           Pos.Merkle          (MerkleRoot (..), MerkleTree, mkMerkleTree)
-import           Pos.Ssc.Class.Types (Ssc (..))
-import qualified Pos.Types           as T
-import           Pos.Util            (Raw, makeSmall)
+import           Pos.Binary           (Bi)
+import           Pos.Block.Network    as T
+import           Pos.Constants        (epochSlots)
+import           Pos.Crypto           (Hash, ProxySecretKey, PublicKey, SecretKey,
+                                       createProxySecretKey, toPublic)
+import           Pos.Data.Attributes  (Attributes (..), mkAttributes)
+import           Pos.Merkle           (MerkleRoot (..), MerkleTree, mkMerkleTree)
+import           Pos.Ssc.Class.Types  (Ssc (..))
+import qualified Pos.Types            as T
+import           Pos.Update.Arbitrary ()
+import           Pos.Util             (Raw, makeSmall)
 import qualified Prelude
 
 ------------------------------------------------------------------------------------------

src/Pos/Block/Logic.hs

@@ -83,11 +83,10 @@ import           Pos.Types                 (Block, BlockHeader, Blund, EpochInde
                                             verifyHeader, verifyHeaders,
                                             vhpVerifyConsensus)
 import qualified Pos.Types                 as Types
-import           Pos.Update.Types          (UpdatePayload (..))
+import           Pos.Update.Core           (UpdatePayload (..))
 import           Pos.Util                  (inAssertMode, spanSafe, _neHead)
 import           Pos.WorkMode              (WorkMode)
 
-
 ----------------------------------------------------------------------------
 -- Common
 ----------------------------------------------------------------------------

src/Pos/Constants.hs

@@ -80,7 +80,7 @@ import           Pos.Types.Timestamp        (Timestamp (..))
 import           Pos.Types.Types            (CoinPortion, unsafeCoinPortion)
 import           Pos.Types.Version          (ApplicationName, ProtocolVersion (..),
                                              SoftwareVersion (..), mkApplicationName)
-import           Pos.Update.Types           (SystemTag, mkSystemTag)
+import           Pos.Update.Core            (SystemTag, mkSystemTag)
 import           Pos.Util                   ()
 import           Pos.Util.TimeWarp          (mcs)
 

src/Pos/DB/GState/Update.hs

@@ -40,7 +40,7 @@ import           Pos.Genesis               (genesisProtocolVersion, genesisScrip
 import           Pos.Script.Type           (ScriptVersion)
 import           Pos.Types                 (ApplicationName, ProtocolVersion,
                                             SoftwareVersion (..))
-import           Pos.Update.Types          (UpId, UpdateProposal (..))
+import           Pos.Update.Core           (UpId, UpdateProposal (..))
 import           Pos.Util                  (maybeThrow)
 
 ----------------------------------------------------------------------------

src/Pos/DB/Types.hs

@@ -37,7 +37,7 @@ import           Pos.Crypto          (PublicKey)
 import           Pos.Lrc.Types       (RichmenStake)
 import           Pos.Types           (Block, ChainDifficulty, Coin, EpochIndex, SlotId,
                                       SlotLeaders, mkCoin, unsafeAddCoin)
-import           Pos.Update.Types    (StakeholderVotes, UpdateProposal, combineVotes)
+import           Pos.Update.Core     (StakeholderVotes, UpdateProposal, combineVotes)
 
 ----------------------------------------------------------------------------
 -- General

src/Pos/Delegation/Logic.hs

@@ -139,8 +139,8 @@ data PskSimpleVerdict
     | PSAdded     -- ^ Successfully processed/added to psk mempool
     deriving (Show,Eq)
 
--- | Processes simple (hardweight) psk. Puts it into the mempool not
--- (TODO) depending on issuer's stake, overrides if exists, checks
+-- | Processes simple (hardweight) psk. Puts it into the mempool
+-- depending on issuer's stake, overrides if exists, checks
 -- validity and cachemsg state.
 processProxySKSimple
     :: (Ssc ssc, MonadDB ssc m, MonadDelegation m, WithNodeContext ssc m)
@@ -186,7 +186,7 @@ makeLenses ''DelVerState
 -- an returns non-empty list of proxySKs needed for undoing
 -- them. Predicate for correctness here is:
 -- * Issuer can post only one cert per epoch
--- * For every new certificate issuer had enough state at the
+-- * For every new certificate issuer had enough stake at the
 --   end of prev. epoch
 --
 -- Blocks are assumed to be oldest-first. It's assumed blocks are
@@ -196,7 +196,6 @@ delegationVerifyBlocks
     => NEBlocks ssc -> m (Either Text (NonEmpty [ProxySKSimple]))
 delegationVerifyBlocks blocks = do
     -- TODO CSL-502 create snapshot
-    -- TODO CSL-505 check that no two block have different epoch
     tip <- GS.getTip
     fromGenesisPsks <-
         concatMap (either (const []) (map pskIssuerPk . view blockProxySKs)) <$>

src/Pos/Types/Arbitrary.hs

@@ -17,24 +17,21 @@ import           Control.Lens               (set, view, _3, _4)
 import qualified Data.ByteString            as BS (pack)
 import           Data.Char                  (chr)
 import           Data.DeriveTH              (derive, makeArbitrary)
-import qualified Data.HashMap.Strict        as HM (fromList)
 import           Data.Text                  (pack)
 import           Data.Time.Units            (Microsecond, fromMicroseconds)
 import           System.Random              (Random)
 import           Test.QuickCheck            (Arbitrary (..), Gen, NonEmptyList (..),
                                              NonZero (..), choose, choose, elements,
-                                             listOf1, oneof)
+                                             oneof)
 import           Test.QuickCheck.Instances  ()
 import           Universum
 
 import           Pos.Binary.Class           (FixedSizeInt (..), SignedVarInt (..),
                                              UnsignedVarInt (..))
 import           Pos.Binary.Types           ()
-import           Pos.Binary.Update          ()
 import           Pos.Constants              (epochSlots, sharedSeedLength)
 import           Pos.Crypto                 (PublicKey, SecretKey, Share, hash, sign,
                                              toPublic)
-import           Pos.Crypto.Arbitrary       (KeyPair (..))
 import           Pos.Data.Attributes        (mkAttributes)
 import           Pos.Script                 (Script)
 import           Pos.Script.Examples        (badIntRedeemer, goodIntRedeemer,
@@ -51,10 +48,6 @@ import           Pos.Types.Types            (Address (..), ChainDifficulty (..),
 import           Pos.Types.Version          (ApplicationName (..), ProtocolVersion (..),
                                              SoftwareVersion (..),
                                              applicationNameMaxLength)
-import           Pos.Update.Types           (ProposalMsgTag (..), SystemTag,
-                                             UpdateData (..), UpdatePayload (..),
-                                             UpdateProposal (..), UpdateVote (..),
-                                             VoteMsgTag (..), mkSystemTag)
 import           Pos.Util                   (AsBinary, makeSmall)
 
 ----------------------------------------------------------------------------
@@ -252,34 +245,3 @@ instance Arbitrary SmallHashMap where
 derive makeArbitrary ''UnsignedVarInt
 derive makeArbitrary ''SignedVarInt
 derive makeArbitrary ''FixedSizeInt
-
-----------------------------------------------------------------------------
--- Update
-----------------------------------------------------------------------------
-
-instance Arbitrary SystemTag where
-    arbitrary =
-        oneof $
-        map (pure . fromMaybe onFail) [mkSystemTag "win64", mkSystemTag "mac32"]
-      where
-        onFail = panic "instance Arbitrary SystemTag: disaster"
-
-instance Arbitrary UpdateVote where
-    arbitrary = do
-        KeyPair uvKey sk <- arbitrary
-        uvProposalId <- arbitrary
-        uvDecision <- arbitrary
-        let uvSignature = sign sk (uvProposalId, uvDecision)
-        return UpdateVote {..}
-
-instance Arbitrary UpdateProposal where
-    arbitrary = UpdateProposal
-        <$> arbitrary
-        <*> arbitrary
-        <*> arbitrary
-        <*> (HM.fromList <$> listOf1 arbitrary)
-
-derive makeArbitrary ''UpdateData
-derive makeArbitrary ''UpdatePayload
-derive makeArbitrary ''ProposalMsgTag
-derive makeArbitrary ''VoteMsgTag

src/Pos/Types/Block.hs

@@ -49,7 +49,7 @@ import           Pos.Types.Address     (addressHash)
 -- See: https://ghc.haskell.org/trac/ghc/ticket/12127
 import           Pos.Types.Tx          (verifyTxAlone)
 import           Pos.Types.Types
-import           Pos.Update.Types      (UpdatePayload)
+import           Pos.Update.Core       (UpdatePayload)
 
 -- | Difficulty of the BlockHeader. 0 for genesis block, 1 for main block.
 headerDifficulty :: BlockHeader ssc -> ChainDifficulty

src/Pos/Types/Types.hs

@@ -188,7 +188,7 @@ import           Pos.Types.Address      (Address (..), StakeholderId, addressF,
                                          decodeTextAddress, makePubKeyAddress,
                                          makeScriptAddress)
 import           Pos.Types.Version      (ProtocolVersion, SoftwareVersion)
-import           Pos.Update.Types.Types (UpdatePayload, UpdateProof)
+import           Pos.Update.Core.Types  (UpdatePayload, UpdateProof)
 import           Pos.Util               (Color (Magenta), colorize)
 
 ----------------------------------------------------------------------------

src/Pos/Update.hs

@@ -1,17 +1,22 @@
--- | Functions for updating the application.
+-- | Whole Update System in one module :)
 
 module Pos.Update
-       ( module Pos.Update.Download
+       ( module Pos.Update.Core
+       , module Pos.Update.Download
        , module Pos.Update.Logic
        , module Pos.Update.Lrc
        , module Pos.Update.MemState
+       , module Pos.Update.Network
        , module Pos.Update.Poll
        , module Pos.Update.Worker
        ) where
 
+import           Pos.Update.Arbitrary ()
+import           Pos.Update.Core
 import           Pos.Update.Download
 import           Pos.Update.Logic
 import           Pos.Update.Lrc
 import           Pos.Update.MemState
+import           Pos.Update.Network
 import           Pos.Update.Poll
 import           Pos.Update.Worker

src/Pos/Update/Arbitrary.hs

@@ -0,0 +1,8 @@
+-- | Arbitrary instances for Update System types.
+
+module Pos.Update.Arbitrary
+       (
+       ) where
+
+import           Pos.Update.Arbitrary.Core    ()
+import           Pos.Update.Arbitrary.Network ()

src/Pos/Update/Arbitrary/Core.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Arbitrary instances for Update System core types.
+
+module Pos.Update.Arbitrary.Core
+       (
+       ) where
+
+import           Data.DeriveTH                (derive, makeArbitrary)
+import qualified Data.HashMap.Strict          as HM
+import           Test.QuickCheck              (Arbitrary (..), listOf1, oneof)
+import           Universum
+
+import           Pos.Binary.Update            ()
+import           Pos.Crypto                   (sign)
+import           Pos.Crypto.Arbitrary         (KeyPair (..))
+import           Pos.Types.Arbitrary          ()
+import           Pos.Update.Arbitrary.Network ()
+import           Pos.Update.Core.Types        (SystemTag, UpdateData (..),
+                                               UpdatePayload (..), UpdateProposal (..),
+                                               UpdateVote (..), mkSystemTag)
+
+instance Arbitrary SystemTag where
+    arbitrary =
+        oneof $
+        map (pure . fromMaybe onFail) [mkSystemTag "win64", mkSystemTag "mac32"]
+      where
+        onFail = panic "instance Arbitrary SystemTag: disaster"
+
+instance Arbitrary UpdateVote where
+    arbitrary = do
+        KeyPair uvKey sk <- arbitrary
+        uvProposalId <- arbitrary
+        uvDecision <- arbitrary
+        let uvSignature = sign sk (uvProposalId, uvDecision)
+        return UpdateVote {..}
+
+instance Arbitrary UpdateProposal where
+    arbitrary = UpdateProposal
+        <$> arbitrary
+        <*> arbitrary
+        <*> arbitrary
+        <*> (HM.fromList <$> listOf1 arbitrary)
+
+derive makeArbitrary ''UpdateData
+derive makeArbitrary ''UpdatePayload