Merge #3384

3384: tx-generator: add loop.plutus example r=MarcFontaine a=MarcFontaine Add a simple loop Plutus script. Co-authored-by: MarcFontaine <MarcFontaine@users.noreply.github.com>
IntersectMBO · Nov 24, 2021 · c58a0da · c58a0da
2 parents b91eb99 + 89f30e5
commit c58a0da
Show file tree

Hide file tree

Showing 3 changed files with 49 additions and 0 deletions.
diff --git a/plutus-example/plutus-example/app/plutus-example.hs b/plutus-example/plutus-example/app/plutus-example.hs
@@ -13,6 +13,7 @@ import           Cardano.PlutusExample.DatumRedeemerGuess (guessScript, guessScr
 import           Cardano.PlutusExample.MintingScript (apiExamplePlutusMintingScript)
 import           Cardano.PlutusExample.ScriptContextChecker
 import           Cardano.PlutusExample.Sum (sumScript)
+import           Cardano.PlutusExample.Loop (loopScript)
 
 main :: IO ()
 main = do
@@ -26,6 +27,7 @@ main = do
   _ <- writeFileTextEnvelope (dir </> "custom-guess-42-datum-42.plutus") Nothing customGuessScript
   _ <- writeFileTextEnvelope (dir </> "anyone-can-mint.plutus") Nothing apiExamplePlutusMintingScript
   _ <- writeFileTextEnvelope (dir </> "sum.plutus") Nothing sumScript
+  _ <- writeFileTextEnvelope (dir </> "loop.plutus") Nothing loopScript
   _ <- writeFileTextEnvelope (dir </> "context-equivalance-test.plutus") Nothing scriptContextCheckScript
   _ <- writeFileTextEnvelope (dir </> "minting-context-equivalance-test.plutus") Nothing customApiExamplePlutusMintingScript
   return ()
diff --git a/plutus-example/plutus-example/plutus-example.cabal b/plutus-example/plutus-example/plutus-example.cabal
@@ -60,6 +60,7 @@ library
                         Cardano.PlutusExample.MintingScript
                         Cardano.PlutusExample.ScriptContextChecker
                         Cardano.PlutusExample.Sum
+                        Cardano.PlutusExample.Loop
 
   build-depends:        aeson
                       , bytestring
@@ -72,6 +73,7 @@ library
                       , containers
                       , ouroboros-consensus
                       , ouroboros-network
+                      , plutus-core
                       , plutus-ledger
                       , plutus-ledger-api
                       , plutus-tx

diff --git a/plutus-example/plutus-example/src/Cardano/PlutusExample/Loop.hs b/plutus-example/plutus-example/src/Cardano/PlutusExample/Loop.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Cardano.PlutusExample.Loop
+  ( loopScript
+  , loopScriptShortBs
+  ) where
+
+import           Prelude hiding (($), (&&), (==), (<), pred)
+
+import           Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
+
+import           Codec.Serialise
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Short as SBS
+
+import qualified Plutus.V1.Ledger.Scripts as Plutus
+import           PlutusTx
+import           PlutusTx.Builtins (unsafeDataAsI)
+import           PlutusTx.Prelude hiding (Semigroup (..), unless, (.))
+
+{-# INLINABLE mkValidator #-}
+mkValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()
+mkValidator _datum redeemer _txContext
+  = if n < 1000000
+       then traceError "redeemer is < 1000000"
+       else loop n
+  where
+    n = unsafeDataAsI redeemer
+    loop i = if i == 1000000 then () else loop $ pred i
+
+validator :: Plutus.Validator
+validator = Plutus.mkValidatorScript $$(PlutusTx.compile [|| mkValidator ||])
+
+script :: Plutus.Script
+script = Plutus.unValidatorScript validator
+
+loopScriptShortBs :: SBS.ShortByteString
+loopScriptShortBs = SBS.toShort . LBS.toStrict $ serialise script
+
+loopScript :: PlutusScript PlutusScriptV1
+loopScript = PlutusScriptSerialised loopScriptShortBs