staging->main

mlabs/app/Main.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import Prelude
+import Prelude (IO, putStrLn)
 
 main :: IO ()
 main = putStrLn "Hello, Haskell!"

mlabs/cabal.project

@@ -1,23 +1,29 @@
--- in-line with: e3e220f5434d5cc01d613e656dc661acbadd55a5
+-- in-line with: b29106559f97cdea24bfd91cbd362a476d2156c4
+-- 2021/09/20
 -- Keep this input-output-hk/plutus pinned with the one from plutus.
-index-state: 2021-07-07T00:00:00Z
+index-state: 2021-08-14T00:00:00Z
 
 packages: ./.
 
+source-repository-package
+  type: git
+  location: https://github.com/Liqwid-Labs/plutus-extra.git
+  tag: 8d6f921069e93853284920d39e539ecc15bf2cde
+  subdir: plutus-extra
+
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/plutus.git
-  tag: daf9d475398bd08b088baf35efea4bf5abea1569
+  tag: f653067a6a1b0e579f13df306dd5b345af040145
   subdir: doc
           fake-pab
           freer-extras
           marlowe
           marlowe-actus
-          marlowe-dashboard-server
           marlowe-playground-server
+          marlowe-dashboard-server
           marlowe-symbolic
           playground-common
-          playground-common
           plutus-benchmark
           plutus-chain-index
           plutus-contract
@@ -35,6 +41,7 @@ source-repository-package
           quickcheck-dynamic
           web-ghc
           word-array
+          stubs/plutus-ghc-stub
 
 
 -- The following sections are copied from the 'plutus' repository cabal.project at the revision
@@ -55,19 +62,9 @@ benchmarks: true
 -- The only sensible test display option
 test-show-details: streaming
 
--- This is also needed so evenful-sql-common will build with a
--- newer version of persistent. See stack.yaml for the mirrored
--- configuration.
-package eventful-sql-common
-  ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances -XMultiParamTypeClasses
-
 allow-newer:
            -- Pins to an old version of Template Haskell, unclear if/when it will be updated
            size-based:template-haskell
-
-           -- The following two dependencies are needed by plutus.
-           , eventful-sql-common:persistent
-           , eventful-sql-common:persistent-template
            , ouroboros-consensus-byron:formatting
            , beam-core:aeson
            , beam-sqlite:aeson
@@ -77,8 +74,6 @@ allow-newer:
 constraints:
   -- big breaking change here, inline-r doens't have an upper bound
   singletons < 3.0
-  -- breaks eventful even more than it already was
-  , persistent-template < 2.12
   -- bizarre issue: in earlier versions they define their own 'GEq', in newer
   -- ones they reuse the one from 'some', but there isn't e.g. a proper version
   -- constraint from dependent-sum-template (which is the library we actually use).
@@ -88,11 +83,25 @@ constraints:
 -- (NOTE this will change to ieee754 in newer versions of nixpkgs).
 extra-packages: ieee, filemanip
 
--- Drops an instance breaking our code. Should be released to Hackage eventually.
+-- These packages appear in our dependency tree and are very slow to build.
+-- Empirically, turning off optimization shaves off ~50% build time.
+-- It also mildly improves recompilation avoidance.
+-- For deve work we don't care about performance so much, so this is okay.
+package cardano-ledger-alonzo
+  optimization: False
+package ouroboros-consensus-shelley
+  optimization: False
+package ouroboros-consensus-cardano
+  optimization: False
+package cardano-api
+  optimization: False
+
+-- https://github.com/Quid2/flat/pull/22 fixes a potential exception
+-- when decoding invalid (e.g. malicious) text literals.
 source-repository-package
   type: git
   location: https://github.com/Quid2/flat.git
-  tag: 95e5d7488451e43062ca84d5376b3adcc465f1cd
+  tag: ee59880f47ab835dbd73bea0847dab7869fc20d8
 
 -- Needs some patches, but upstream seems to be fairly dead (no activity in > 1 year)
 source-repository-package
@@ -108,19 +117,22 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-crypto.git
-  tag: ce8f1934e4b6252084710975bd9bbc0a4648ece4
+  tag: 07397f0e50da97eaa0575d93bee7ac4b2b2576ec
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: a715c7f420770b70bbe95ca51d3dec83866cb1bd
+  tag: 46502694f6a9f0498f822068008b232b3837a9e9
   subdir:
+    base-deriving-via
     binary
     binary/test
-    slotting
     cardano-crypto-class
     cardano-crypto-praos
     cardano-crypto-tests
+    measures
+    orphans-deriving-via
+    slotting
     strict-containers
 
 source-repository-package
@@ -134,7 +146,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: e338f2cf8e1078fbda9555dd2b169c6737ef6774
+  tag: 6d00ff77f9bcd769fb6d7fd02216cec4e837bfcf
   subdir:
     monoidal-synchronisation
     typed-protocols
@@ -153,7 +165,17 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/iohk-monitoring-framework
-  tag: 34abfb7f4f5610cabb45396e0496472446a0b2ca
+  -- Important Note: Read below, before changing this!
+  tag: 46f994e216a1f8b36fe4669b47b2a7011b0e153c
+  -- Are you thinking of updating this tag to some other commit?  Please
+  -- ensure that the commit you are about to use is the latest one from
+  -- the *develop* branch of this repo:
+  --   * <https://github.com/input-output-hk/iohk-monitoring-framework/commits/develop>
+  -- (not master!)
+  --
+  -- In particular we rely on the code from this PR:
+  --  * <https://github.com/input-output-hk/iohk-monitoring-framework/pull/622>
+  -- being merged.
   subdir:
     iohk-monitoring
     tracer-transformers
@@ -167,7 +189,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 6b0fca7a73c317f3af7c14dd4dc38178cc78a6c8
+  tag: 8efcfc755faae4db3a64ad45343235fce3ed5c47
   subdir:
     byron/chain/executable-spec
     byron/crypto
@@ -190,27 +212,29 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-node.git
-  tag: f3ef4ed72894499160f2330b91572a159005c148
+  tag: 8cf2b208c7708bd890c7e74d5b1d7c4167a3b40b
   subdir:
     cardano-api
     cardano-node
     cardano-cli
     cardano-config
 
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/optparse-applicative
+  tag: 7497a29cb998721a9068d5725d49461f2bba0e7a
+
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/Win32-network
-  tag: 94153b676617f8f33abe8d8182c37377d2784bd1
+  tag: 3825d3abf75f83f406c1f7161883c438dac7277d
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/hedgehog-extras
-  tag: 8bcd3c9dc22cc44f9fcfe161f4638a384fc7a187
+  tag: edf6945007177a638fbeb8802397f3a6f4e47c14
 
--- The following dependencies are not mirrored in the
--- stack.yaml file, but they are needed regardless by cabal.
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/goblins
   tag: cde90a2b27f79187ca8310b6549331e59595e7ba
-

mlabs/demo/Main.hs

@@ -5,7 +5,7 @@ module Main (main) where
 --------------------------------------------------------------------------------
 
 import GHC.Generics
-import Prelude
+import Prelude qualified as Hask
 
 --------------------------------------------------------------------------------
 

mlabs/deploy-app/Main.hs

@@ -0,0 +1,44 @@
+module Main where
+
+import PlutusTx.Prelude hiding (error)
+import System.Environment (getArgs)
+import System.Exit (die)
+import Prelude (IO, String, error, print, undefined)
+
+import Mlabs.Emulator.Types (UserId (..))
+import Mlabs.Nft.Contract.Forge as F
+import Mlabs.Nft.Contract.StateMachine as SM
+import Mlabs.Nft.Logic.Types (Act (..), Nft (..), NftId (..), UserAct (..), initNft, toNftId)
+
+import Cardano.Api
+import Cardano.Api.Shelley
+
+import Cardano.Ledger.Alonzo.Data qualified as Alonzo
+import Codec.Serialise
+import Ledger.Typed.Scripts.Validators as VS
+import Plutus.V1.Ledger.Api (MintingPolicy, TxOutRef, Validator)
+import Plutus.V1.Ledger.Api qualified as Plutus
+import PlutusTx
+
+import Data.Aeson as Json
+import Data.ByteString.Lazy qualified as LB
+import Data.ByteString.Short qualified as SBS
+
+import Data.ByteString as DB
+import Mlabs.Deploy.Governance
+import Mlabs.Deploy.Nft
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    ["Nft"] ->
+      serializeNft
+        "56b4d636bfea5cb0628ba202214a9cca42997545da87dfd436e6e3d8d7ba3b28"
+        0
+        "4cebc6f2a3d0111ddeb09ac48e2053b83b33b15f29182f9b528c6491"
+        "MonaLisa"
+        "./../.github/workflows/nft_delivery"
+    ["Governance"] -> serializeGovernance
+    _ ->
+      die "Unknown deployment task type"

mlabs/governance-demo/Main.hs

@@ -0,0 +1,134 @@
+-- | Simulator demo for Governance
+module Main (
+  main,
+) where
+
+import PlutusTx.Prelude
+import Prelude (IO, getLine, show, undefined)
+
+import Control.Monad (forM, forM_, when)
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.Aeson (FromJSON, Result (Success), encode, fromJSON)
+import Data.Functor (void)
+import Data.Monoid (Last (..))
+
+import Mlabs.Governance.Contract.Api (Deposit (..), QueryBalance (..), Withdraw (..))
+import Mlabs.Governance.Contract.Simulator.Handler (BootstrapContract, GovernanceContracts (..))
+import Mlabs.Governance.Contract.Simulator.Handler qualified as Handler
+import Mlabs.Governance.Contract.Validation (AssetClassGov (..))
+
+import Ledger (CurrencySymbol, PubKeyHash, TokenName, pubKeyHash, txId)
+import Ledger.Constraints (mustPayToPubKey)
+import Plutus.V1.Ledger.Value qualified as Value
+
+import Plutus.PAB.Effects.Contract.Builtin (Builtin)
+import Plutus.PAB.Simulator (Simulation)
+import Plutus.PAB.Simulator qualified as Simulator
+import Plutus.PAB.Webserver.Server qualified as PWS
+import Wallet.Emulator.Types (Wallet (..), walletPubKey)
+import Wallet.Emulator.Wallet (walletAddress)
+
+import Mlabs.Plutus.PAB (call, waitForLast)
+import Mlabs.System.Console.PrettyLogger (logNewLine)
+import Mlabs.System.Console.Utils (logAction, logBalance, logMlabs)
+
+-- | Main function to run simulator
+main :: IO ()
+main = void $
+  Simulator.runSimulationWith Handler.handlers $ do
+    Simulator.logString @(Builtin GovernanceContracts) "Starting Governance PAB webserver"
+    shutdown <- PWS.startServerDebug
+    let simWallets = Handler.wallets
+        (wallet1 : wallet2 : wallet3 : _) = simWallets
+    (cids, gov) <-
+      subscript
+        "Initializing contracts\nWallet 1 mints and distributes initial GOV tokens"
+        simWallets
+        (itializeContracts wallet1)
+    let [wCid1, wCid2, wCid3] = cids
+
+    subscript_
+      "Wallet 2 deposits 55 GOV (xGOV tokens being minted as result) "
+      simWallets
+      $ deposit wCid2 55
+
+    subscript_
+      "Wallet 2 queries amount of GOV deposited"
+      simWallets
+      $ getBalance wCid2 wallet2
+
+    subscript_
+      "Wallet 2 deposits 10 more GOV"
+      simWallets
+      $ deposit wCid2 10
+
+    subscript_
+      "Wallet 2 queries amount of GOV deposited"
+      simWallets
+      $ getBalance wCid2 wallet2
+
+    subscript_
+      "Wallet 2 withdraws 60 GOV"
+      simWallets
+      $ withdraw wCid2 wallet2 60
+
+    subscript_
+      "Wallet 2 queries amount of GOV deposited"
+      simWallets
+      $ getBalance wCid2 wallet2
+
+    subscript_
+      "Finally, Wallet 3 queries amount of GOV deposited"
+      simWallets
+      $ getBalance wCid3 wallet3
+
+    Simulator.logString @(Builtin GovernanceContracts) "Scripted part is over\nPress Enter to stop and exit"
+    void $ liftIO getLine
+    shutdown
+  where
+    subscript_ msg wallets simulation = void $ subscript msg wallets simulation
+    subscript msg wallets simulation = do
+      logAction msg
+      next
+      res <- simulation
+      Simulator.waitNSlots 1
+      mapM_ printBalance wallets
+      next
+      return res
+
+    next = do
+      logNewLine
+      void $ Simulator.waitNSlots 5
+
+-- shortcut for Governance initialization
+itializeContracts admin = do
+  cidInit <- Simulator.activateContract admin Bootstrap
+  govCs <- waitForLast cidInit
+  void $ Simulator.waitUntilFinished cidInit
+  let gov = AssetClassGov govCs Handler.govTokenName
+  cids <- forM Handler.wallets $ \w -> Simulator.activateContract w (Governance gov)
+  return (cids, gov)
+
+-- shortcits for endpoint calls
+deposit cid amount = call cid $ Deposit amount
+
+withdraw cid wallet amount = call cid $ Withdraw [(walletPKH wallet, amount)]
+
+getBalance cid wallet = do
+  call cid $ QueryBalance $ walletPKH wallet
+  govBalance :: Integer <- waitForLast cid
+  logAction $ "Balance is " ++ show govBalance
+
+printBalance :: Wallet -> Simulation (Builtin schema) ()
+printBalance wallet = do
+  v <- Simulator.valueAt $ walletAddress wallet
+  logBalance ("WALLET " <> show wallet) v
+
+walletPKH = pubKeyHash . walletPubKey
+
+-- cfg =
+--   BootstrapCfg
+--     { wallets = Wallet <$> [1 .. 3] -- wallets participating, wallet #1 is admin
+--     , govTokenName = "GOVToken" -- name of GOV token to be paid in exchange of xGOV tokens
+--     , govAmount = 100 -- GOV amount each wallet gets on start
+--     }