[DEVOPS-1131] automated proposal scripting

.gitignore

@@ -73,6 +73,9 @@ scripts/haskell/dependencies.hi
 scripts/haskell/dependencies.o
 scripts/haskell/dependencies
 
+# script-runner state
+script-runner/states/
+
 # Cache for pkgs/generate.sh
 /pkgs/.cabal/
 /pkgs/.stack/

cabal.project.freeze

@@ -27,6 +27,7 @@ constraints: Cabal ==2.2.0.1,
              beam-migrate ==0.3.2.1,
              beam-sqlite ==0.3.2.3,
              bifunctors ==5.5.3,
+             brick ==0.37.2,
              canonical-json ==0.5.0.1,
              case-insensitive ==1.2.0.11,
              cassava ==0.5.1.0,
@@ -99,7 +100,6 @@ constraints: Cabal ==2.2.0.1,
              mmorph ==1.1.2,
              monad-control ==1.0.2.3,
              mono-traversable ==1.0.9.0,
-             mtl ==2.2.2,
              mwc-random ==0.13.6.0,
              neat-interpolation ==0.3.2.2,
              network ==2.6.3.6,
@@ -110,7 +110,6 @@ constraints: Cabal ==2.2.0.1,
              normaldistribution ==1.1.0.3,
              optparse-applicative ==0.14.3.0,
              optparse-simple ==0.1.0,
-             parsec ==3.1.13.0,
              parser-combinators ==1.0.0,
              parsers ==0.12.9,
              pipes ==4.3.9,
@@ -147,7 +146,6 @@ constraints: Cabal ==2.2.0.1,
              split ==0.2.3.3,
              sqlite-simple ==0.4.16.0,
              sqlite-simple-errors ==0.6.1.0,
-             stm ==2.4.5.1,
              stm-chans ==3.0.0.4,
              streaming-commons ==0.2.1.0,
              strict ==0.3.2,
@@ -159,14 +157,14 @@ constraints: Cabal ==2.2.0.1,
              tagged ==0.8.5,
              tar ==0.5.1.0,
              temporary ==1.3,
-             text ==1.2.3.1,
              th-utilities ==0.2.0.1,
              these ==0.7.5,
              time-units ==1.0.0,
              tls ==1.4.1,
              transformers-base ==0.4.5.2,
              transformers-lift ==0.2.0.1,
              trifecta ==2,
+             turtle ==1.5.12,
              universum ==1.2.0,
              unix-compat ==0.5.1,
              unliftio ==0.2.8.1,
@@ -175,6 +173,7 @@ constraints: Cabal ==2.2.0.1,
              uuid ==1.3.13,
              validation ==1,
              vector ==0.12.0.1,
+             vty ==5.21,
              wai ==3.2.1.2,
              wai-app-static ==3.1.6.2,
              wai-cors ==0.2.6,

chain/src/Pos/Chain/Update/BlockVersion.hs

@@ -9,9 +9,7 @@ import           Universum
 
 import           Data.Aeson.TH (defaultOptions, deriveJSON)
 import           Data.SafeCopy (base, deriveSafeCopySimple)
-import           Formatting (bprint, shown)
 import qualified Formatting.Buildable as Buildable
-import qualified Prelude
 
 import           Pos.Binary.Class (Cons (..), Field (..), deriveSimpleBi)
 import           Pos.Util.Some (Some, liftLensSome)
@@ -21,14 +19,10 @@ data BlockVersion = BlockVersion
     { bvMajor :: !Word16
     , bvMinor :: !Word16
     , bvAlt   :: !Word8
-    } deriving (Eq, Generic, Ord, Typeable)
-
-instance Show BlockVersion where
-    show BlockVersion {..} =
-        intercalate "." [show bvMajor, show bvMinor, show bvAlt]
+    } deriving (Eq, Generic, Ord, Typeable, Show)
 
 instance Buildable BlockVersion where
-    build = bprint shown
+    build BlockVersion{..} = fromString $ intercalate "." [show bvMajor, show bvMinor, show bvAlt]
 
 instance Hashable BlockVersion
 

chain/src/Pos/Chain/Update/Configuration.hs

@@ -15,22 +15,29 @@ module Pos.Chain.Update.Configuration
        , curSoftwareVersion
 
        , currentSystemTag
+
+       , ccApplicationName_L
+       , ccLastKnownBlockVersion_L
+       , ccApplicationVersion_L
+       , ccSystemTag_L
        ) where
 
 import           Universum
 
-import           Data.Aeson (FromJSON (..), ToJSON (..), genericToJSON,
-                     withObject, (.:), (.:?))
-import           Data.Aeson.Options (defaultOptions)
+import           Control.Lens (makeLensesWith)
+import           Data.Aeson (FromJSON (..), ToJSON (..), object, withObject,
+                     (.:), (.:?), (.=))
 import           Data.Maybe (fromMaybe)
 import           Data.Reflection (Given (..), give)
 import           Distribution.System (buildArch, buildOS)
 
-import           Pos.Chain.Update.ApplicationName (ApplicationName)
+import           Pos.Chain.Update.ApplicationName
+                     (ApplicationName (ApplicationName))
 import           Pos.Chain.Update.BlockVersion (BlockVersion (..))
 import           Pos.Chain.Update.SoftwareVersion (SoftwareVersion (..))
 import           Pos.Chain.Update.SystemTag (SystemTag (..), archHelper,
                      osHelper)
+import           Pos.Util (postfixLFields)
 
 ----------------------------------------------------------------------------
 -- Config itself
@@ -57,8 +64,15 @@ data UpdateConfiguration = UpdateConfiguration
     }
     deriving (Eq, Generic, Show)
 
+makeLensesWith postfixLFields ''UpdateConfiguration
+
 instance ToJSON UpdateConfiguration where
-    toJSON = genericToJSON defaultOptions
+    toJSON (UpdateConfiguration (ApplicationName appname) lkbv appver (SystemTag systag)) = object [
+        "applicationName" .= appname
+      , "lastKnownBlockVersion" .= lkbv
+      , "applicationVersion" .= appver
+      , "systemTag" .= systag
+      ]
 
 instance FromJSON UpdateConfiguration where
     parseJSON = withObject "UpdateConfiguration" $ \o -> do

chain/test/Test/Pos/Chain/Block/Gen.hs

@@ -1,5 +1,6 @@
 module Test.Pos.Chain.Block.Gen
-       ( genBlockBodyAttributes
+       ( genBlockConfiguration
+       , genBlockBodyAttributes
        , genBlockHeader
        , genBlockHeaderAttributes
        , genBlockSignature
@@ -23,10 +24,11 @@ import           Universum
 import           Data.Coerce (coerce)
 import           Hedgehog (Gen)
 import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
 
-import           Pos.Chain.Block (BlockBodyAttributes, BlockHeader (..),
-                     BlockHeaderAttributes, BlockSignature (..),
-                     GenesisBlockHeader, GenesisBody (..),
+import           Pos.Chain.Block (BlockBodyAttributes, BlockConfiguration (..),
+                     BlockHeader (..), BlockHeaderAttributes,
+                     BlockSignature (..), GenesisBlockHeader, GenesisBody (..),
                      GenesisConsensusData (..), GenesisProof (..), HeaderHash,
                      MainBlockHeader, MainBody (..), MainConsensusData (..),
                      MainExtraBodyData (..), MainExtraHeaderData (..),
@@ -45,6 +47,18 @@ import           Test.Pos.Core.Gen (genChainDifficulty, genEpochIndex,
 import           Test.Pos.Crypto.Gen (genAbstractHash, genProxySignature,
                      genPublicKey, genSecretKey, genSignature)
 
+
+genBlockConfiguration :: Gen BlockConfiguration
+genBlockConfiguration = BlockConfiguration <$> Gen.int Range.constantBounded
+                                           <*> Gen.int Range.constantBounded
+                                           <*> Gen.int Range.constantBounded
+                                           <*> Gen.double (Range.constant 0 1)
+                                           <*> Gen.double (Range.constant 0 1)
+                                           <*> Gen.double (Range.constant 0 1)
+                                           <*> Gen.double (Range.constant 0 1)
+                                           <*> Gen.int Range.constantBounded
+                                           <*> (fromIntegral <$> Gen.int Range.constantBounded)
+
 genBlockBodyAttributes :: Gen BlockBodyAttributes
 genBlockBodyAttributes = pure $ mkAttributes ()
 

chain/test/Test/Pos/Chain/Delegation/Gen.hs

@@ -1,5 +1,6 @@
 module Test.Pos.Chain.Delegation.Gen
-       ( genDlgPayload
+       ( genDlgConfiguration
+       , genDlgPayload
        , genHeavyDlgIndex
        , genLightDlgIndices
        , genProxySKBlockInfo
@@ -13,16 +14,18 @@ import           Hedgehog (Gen)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
-import           Pos.Chain.Delegation (DlgPayload (..), DlgUndo (..),
-                     HeavyDlgIndex (..), LightDlgIndices (..),
+import           Pos.Chain.Delegation (DlgConfiguration (..), DlgPayload (..),
+                     DlgUndo (..), HeavyDlgIndex (..), LightDlgIndices (..),
                      ProxySKBlockInfo, ProxySKHeavy)
 import           Pos.Crypto (ProtocolMagic, safeCreatePsk)
-
 import           Test.Pos.Core.Gen (genEpochIndex, genStakeholderId)
 import           Test.Pos.Crypto.Gen (genPublicKey, genSafeSigner)
 import           Test.Pos.Util.Gen (genHashSet)
 
 
+genDlgConfiguration :: Gen DlgConfiguration
+genDlgConfiguration = DlgConfiguration <$> (pure 500) <*> (pure 30)
+
 genDlgPayload :: ProtocolMagic -> Gen DlgPayload
 genDlgPayload pm =
     UnsafeDlgPayload <$> Gen.list (Range.linear 0 5) (genProxySKHeavy pm)

chain/test/Test/Pos/Chain/Ssc/Gen.hs

@@ -1,5 +1,6 @@
 module Test.Pos.Chain.Ssc.Gen
-       ( genAttackTarget
+       ( genSscConfiguration
+       , genAttackTarget
        , genCommitment
        , genCommitmentsMap
        , genCommitmentSignature
@@ -30,18 +31,21 @@ import           Pos.Binary.Class (asBinary)
 import           Pos.Chain.Security (AttackTarget (..))
 import           Pos.Chain.Ssc (Commitment, CommitmentSignature, CommitmentsMap,
                      InnerSharesMap, Opening, OpeningsMap, SharesDistribution,
-                     SharesMap, SignedCommitment, SscPayload (..), SscProof,
-                     VssCertificate (..), VssCertificatesHash,
-                     VssCertificatesMap (..), mkCommitmentsMap, mkSscProof,
-                     mkVssCertificate, mkVssCertificatesMap,
-                     randCommitmentAndOpening)
+                     SharesMap, SignedCommitment, SscConfiguration (..),
+                     SscPayload (..), SscProof, VssCertificate (..),
+                     VssCertificatesHash, VssCertificatesMap (..),
+                     mkCommitmentsMap, mkSscProof, mkVssCertificate,
+                     mkVssCertificatesMap, randCommitmentAndOpening)
 import           Pos.Crypto (ProtocolMagic, deterministic, hash)
 
 import           Test.Pos.Core.Gen (genEpochIndex, genStakeholderId, genWord16)
 import           Test.Pos.Crypto.Gen (genDecShare, genPublicKey, genSecretKey,
                      genSignature, genVssPublicKey)
 import           Test.Pos.Util.Gen (genHashMap)
 
+genSscConfiguration :: Gen SscConfiguration
+genSscConfiguration = SscConfiguration <$> (pure 10) <*> (pure 3) <*> (pure False)
+
 genCommitment :: Gen Commitment
 genCommitment = fst <$> genCommitmentOpening
 

chain/test/Test/Pos/Chain/Update/Gen.hs

@@ -1,5 +1,6 @@
 module Test.Pos.Chain.Update.Gen
-       ( genApplicationName
+       ( genUpdateConfiguration
+       , genApplicationName
        , genBlockVersion
        , genBlockVersionData
        , genBlockVersionDataByTxFP
@@ -38,10 +39,11 @@ import           Pos.Chain.Update (ApplicationName (..), BlockVersion (..),
                      ProposalState (..), SoftforkRule (..),
                      SoftwareVersion (..), SystemTag (..), USUndo (..),
                      UndecidedProposalState (..), UpAttributes, UpId,
-                     UpdateData (..), UpdatePayload (..), UpdateProof,
-                     UpdateProposal (..), UpdateProposalToSign (..),
-                     UpdateProposals, UpdateVote (..), UpsExtra (..), VoteId,
-                     VoteState (..), maybeToPrev, mkUpdateVote)
+                     UpdateConfiguration (..), UpdateData (..),
+                     UpdatePayload (..), UpdateProof, UpdateProposal (..),
+                     UpdateProposalToSign (..), UpdateProposals,
+                     UpdateVote (..), UpsExtra (..), VoteId, VoteState (..),
+                     maybeToPrev, mkUpdateVote)
 import           Pos.Core (SlotCount, TxFeePolicy)
 import           Pos.Core.Attributes (mkAttributes)
 import           Pos.Crypto (ProtocolMagic)
@@ -56,6 +58,9 @@ import           Test.Pos.Crypto.Gen (genAbstractHash, genPublicKey,
 import           Test.Pos.Util.Gen (genHashMap, genHashSet)
 
 
+genUpdateConfiguration :: Gen UpdateConfiguration
+genUpdateConfiguration = UpdateConfiguration <$> genApplicationName <*> genBlockVersion <*> (pure 1) <*> genSystemTag
+
 genApplicationName :: Gen ApplicationName
 genApplicationName =
     ApplicationName <$> Gen.text (Range.constant 0 10) Gen.alphaNum

chain/test/Test/Pos/Chain/Update/Json.hs

@@ -11,10 +11,11 @@ import qualified Hedgehog as H
 
 import           Test.Pos.Chain.Update.Gen (genApplicationName,
                      genBlockVersionData, genSoftforkRule, genSoftwareVersion,
-                     genSystemTag)
+                     genSystemTag, genUpdateConfiguration)
 import           Test.Pos.Util.Golden (eachOf)
 import           Test.Pos.Util.Tripping (discoverRoundTrip,
-                     roundTripsAesonYamlBuildable)
+                     roundTripsAesonYamlBuildable, roundTripsAesonYamlShow)
+
 
 --------------------------------------------------------------------------------
 -- BlockVersionData
@@ -55,6 +56,14 @@ roundTripSystemTag :: Property
 roundTripSystemTag =
     eachOf 1000 genSystemTag roundTripsAesonYamlBuildable
 
+--------------------------------------------------------------------------------
+-- UpdateConfiguration
+--------------------------------------------------------------------------------
+
+roundTripUpdateConfiguration :: Property
+roundTripUpdateConfiguration =
+    roundTripsAesonYamlShow 1000 genUpdateConfiguration
+
 --------------------------------------------------------------------------------
 -- Main Testing Function
 --------------------------------------------------------------------------------

client/src/Pos/Client/KeyStorage.hs

@@ -71,6 +71,7 @@ getSecretKeys = AllUserSecrets <$> getSecretKeysPlain
 getSecretKeysPlain :: MonadKeysRead m => m [EncryptedSecretKey]
 getSecretKeysPlain = view usKeys <$> getSecret
 
+{-# INLINE addSecretKey #-}
 addSecretKey :: MonadKeys m => EncryptedSecretKey -> m ()
 addSecretKey sk = modifySecret $ \us ->
     if view usKeys us `containsKey` sk

client/src/Pos/Client/Txp/Balances.hs

@@ -39,6 +39,7 @@ getBalanceFromUtxo :: MonadBalances m => GenesisData -> Address -> m Coin
 getBalanceFromUtxo genesisData addr =
     getTotalCoinsInUtxo <$> getOwnUtxo genesisData addr
 
+{-# INLINE getOwnUtxosGenesis #-}
 getOwnUtxosGenesis :: Applicative m => GenesisData -> [Address] -> m Utxo
 getOwnUtxosGenesis genesisData addrs =
     pure $ filterUtxoByAddrs addrs $ genesisUtxo genesisData

cluster/app/demo/Main.hs

@@ -80,6 +80,7 @@ main = void $ do
             putTextFromStart $ "..." <> nodeId <> " OK!"
             when (nodeType /= NodeEdge) $ putText
                 $  "\n......address:       " <> toText (env ! "LISTEN")
+            -- todo, dont mapm over chars
             putTextLn
                 $  "\n......api address:   " <> toText (env ! "NODE_API_ADDRESS")
                 <> "\n......doc address:   " <> toText (env ! "NODE_DOC_ADDRESS")

crypto/test/Test/Pos/Crypto/Gen.hs

@@ -3,6 +3,7 @@ module Test.Pos.Crypto.Gen
         -- Protocol Magic Generator
           genProtocolMagic
         , genProtocolMagicId
+        , genRequiresNetworkMagic
 
         -- Sign Tag Generator
         , genSignTag

db/src/Pos/DB/Block/Epoch.hs

@@ -237,7 +237,7 @@ renderConsolidateError = \case
     CEBlockLookupFailed fn lsi h ->
         fn <> sformat (": block lookup failed on (" % build % ", " % build % ")") lsi h
     CEBBlockNotFound fn lsi hh ->
-        fn <> sformat (": block mssing : " % build % " " % build) lsi hh
+        fn <> sformat (": block missing : " % build % " " % build) lsi hh
 
 -- -----------------------------------------------------------------------------
 

db/src/Pos/DB/Txp/Logic/Local.hs

@@ -64,6 +64,7 @@ type TxpProcessTransactionMode ctx m =
     , CanJsonLog m
     )
 
+{-# INLINE txProcessTransaction #-}
 -- | Process transaction. 'TxId' is expected to be the hash of
 -- transaction in 'TxAux'. Separation is supported for optimization
 -- only.
@@ -196,6 +197,7 @@ txProcessTransactionAbstract epochSlots genesisConfig buildEnv txAction itw@(txI
             (Left err@(ToilTipsMismatch {})) -> reportError (pretty err)
             _                                -> pass
 
+{-# INLINE txNormalize #-}
 -- | 1. Recompute UtxoView by current MemPool
 -- | 2. Remove invalid transactions from MemPool
 -- | 3. Set new tip to txp local data