Make plutus-use-cases-scripts output unwrapped Flat (#2752)

IntersectMBO · Feb 19, 2021 · 9abe095 · 9abe095
1 parent b845ddc
commit 9abe095
Show file tree

Hide file tree

Showing 4 changed files with 23 additions and 6 deletions.
diff --git a/nix/pkgs/haskell/materialized-musl/.plan.nix/plutus-use-cases.nix b/nix/pkgs/haskell/materialized-musl/.plan.nix/plutus-use-cases.nix
@@ -89,6 +89,7 @@
             (hsPkgs."aeson" or (errorHandler.buildDepError "aeson"))
             (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring"))
             (hsPkgs."containers" or (errorHandler.buildDepError "containers"))
+            (hsPkgs."flat" or (errorHandler.buildDepError "flat"))
             (hsPkgs."freer-extras" or (errorHandler.buildDepError "freer-extras"))
             (hsPkgs."hedgehog" or (errorHandler.buildDepError "hedgehog"))
             (hsPkgs."prettyprinter" or (errorHandler.buildDepError "prettyprinter"))
@@ -103,9 +104,11 @@
             (hsPkgs."freer-simple" or (errorHandler.buildDepError "freer-simple"))
             (hsPkgs."foldl" or (errorHandler.buildDepError "foldl"))
             (hsPkgs."streaming" or (errorHandler.buildDepError "streaming"))
+            (hsPkgs."directory" or (errorHandler.buildDepError "directory"))
             (hsPkgs."filepath" or (errorHandler.buildDepError "filepath"))
             (hsPkgs."serialise" or (errorHandler.buildDepError "serialise"))
             (hsPkgs."plutus-core" or (errorHandler.buildDepError "plutus-core"))
+            (hsPkgs."plutus-ledger-api" or (errorHandler.buildDepError "plutus-ledger-api"))
             (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx"))
             (hsPkgs."plutus-contract" or (errorHandler.buildDepError "plutus-contract"))
             (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger"))

diff --git a/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-use-cases.nix b/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-use-cases.nix
@@ -89,6 +89,7 @@
             (hsPkgs."aeson" or (errorHandler.buildDepError "aeson"))
             (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring"))
             (hsPkgs."containers" or (errorHandler.buildDepError "containers"))
+            (hsPkgs."flat" or (errorHandler.buildDepError "flat"))
             (hsPkgs."freer-extras" or (errorHandler.buildDepError "freer-extras"))
             (hsPkgs."hedgehog" or (errorHandler.buildDepError "hedgehog"))
             (hsPkgs."prettyprinter" or (errorHandler.buildDepError "prettyprinter"))
@@ -103,9 +104,11 @@
             (hsPkgs."freer-simple" or (errorHandler.buildDepError "freer-simple"))
             (hsPkgs."foldl" or (errorHandler.buildDepError "foldl"))
             (hsPkgs."streaming" or (errorHandler.buildDepError "streaming"))
+            (hsPkgs."directory" or (errorHandler.buildDepError "directory"))
             (hsPkgs."filepath" or (errorHandler.buildDepError "filepath"))
             (hsPkgs."serialise" or (errorHandler.buildDepError "serialise"))
             (hsPkgs."plutus-core" or (errorHandler.buildDepError "plutus-core"))
+            (hsPkgs."plutus-ledger-api" or (errorHandler.buildDepError "plutus-ledger-api"))
             (hsPkgs."plutus-tx" or (errorHandler.buildDepError "plutus-tx"))
             (hsPkgs."plutus-contract" or (errorHandler.buildDepError "plutus-contract"))
             (hsPkgs."plutus-ledger" or (errorHandler.buildDepError "plutus-ledger"))

diff --git a/plutus-use-cases/plutus-use-cases.cabal b/plutus-use-cases/plutus-use-cases.cabal
@@ -184,6 +184,7 @@ executable plutus-use-cases-scripts
         aeson -any,
         bytestring -any,
         containers -any,
+        flat -any,
         freer-extras -any,
         hedgehog -any,
         prettyprinter -any,
@@ -198,9 +199,11 @@ executable plutus-use-cases-scripts
         freer-simple -any,
         foldl -any,
         streaming -any,
+        directory -any,
         filepath -any,
         serialise -any,
         plutus-core -any,
+        plutus-ledger-api -any,
         plutus-tx -any,
         plutus-contract -any,
         plutus-ledger -any,

diff --git a/plutus-use-cases/scripts/Main.hs b/plutus-use-cases/scripts/Main.hs
@@ -1,13 +1,16 @@
 module Main(main) where
 
-import           Codec.Serialise                                       (writeFileSerialise)
 import qualified Control.Foldl                                         as L
 import           Control.Monad.Freer                                   (run)
+import qualified Data.ByteString.Lazy                                  as BSL
 import           Data.Foldable                                         (traverse_)
+import           Flat                                                  (flat)
 import           Ledger.Index                                          (ScriptValidationEvent (sveScript))
 import           Plutus.Trace.Emulator                                 (EmulatorTrace)
 import qualified Plutus.Trace.Emulator                                 as Trace
+import           Plutus.V1.Ledger.Scripts                              (Script (..))
 import qualified Streaming.Prelude                                     as S
+import           System.Directory                                      (createDirectoryIfMissing)
 import           System.Environment                                    (getArgs)
 import           System.FilePath                                       ((</>))
 import qualified Wallet.Emulator.Folds                                 as Folds
@@ -70,8 +73,13 @@ writeScripts fp = do
         , ("auction_2", Auction.auctionTrace2)
         ]
 
--- | Run an emulator trace and write the applied scripts to a file
---   using the name as a prefix
+{-| Run an emulator trace and write the applied scripts to a file in Flat format
+    using the name as a prefix.  There's an instance of Codec.Serialise for
+    Script in Scripts.hs (see Note [Using Flat inside CBOR instance of Script]),
+    which wraps Flat-encoded bytestings in CBOR, but that's not used here: we
+    just use unwrapped Flat because that's more convenient for use with the
+    `plc` command, for example.
+-}
 writeScriptsTo :: FilePath -> String -> EmulatorTrace a -> IO ()
 writeScriptsTo fp prefix trace = do
     let events =
@@ -80,8 +88,8 @@ writeScriptsTo fp prefix trace = do
             $ foldEmulatorStreamM (L.generalize Folds.scriptEvents)
             $ Trace.runEmulatorStream defaultEmulatorConfig trace
         writeScript idx script = do
-            let filename = fp </> prefix <> "-" <> show idx
+            let filename = fp </> prefix <> "-" <> show idx <> ".flat"
             putStrLn $ "Writing script: " <> filename
-            writeFileSerialise filename script
-
+            BSL.writeFile filename (BSL.fromStrict . flat . unScript $ script)
+    createDirectoryIfMissing True fp
     traverse_ (uncurry writeScript) (zip [1::Int ..] (sveScript <$> events))