Update cardano-cli build and build-raw commands to allow creation of

simple reference scripts
IntersectMBO · Jun 10, 2022 · 48917aa · 48917aa
1 parent a72734c
commit 48917aa
Show file tree

Hide file tree

Showing 3 changed files with 72 additions and 33 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -229,52 +229,68 @@ pScriptFor name (Just deprecated) help =
         <> Opt.internal
         )
 
+pSimpleReferenceScriptWitnessFiles
+  :: Parser (ScriptWitnessFiles witctx)
+pSimpleReferenceScriptWitnessFiles =
+   toReferenceScriptWitnessFiles
+     <$> ((,) <$> pReferenceTxIn
+              <*> pSimpleScriptLang
+         )
+ where
+  toReferenceScriptWitnessFiles
+    :: (TxIn, AnyScriptLanguage)
+    -> ScriptWitnessFiles witctx
+  toReferenceScriptWitnessFiles (txin, sLang) = SimpleReferenceScriptWitnessFiles txin sLang
+
+  pSimpleScriptLang :: Parser AnyScriptLanguage
+  pSimpleScriptLang =
+    Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV1)
+      (  Opt.long "simple-script-v1"
+      <> Opt.help "Specify a simple script v1 reference script. \
+                  \See documentation at doc/reference/simple-scripts.md"
+      ) <|>
+    Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV2)
+      (  Opt.long "simple-script-v2"
+      <> Opt.help "Specify a simple script v2 reference script. \
+                  \See documentation at doc/reference/simple-scripts.md"
+      )
+
 pPlutusReferenceScriptWitnessFiles
   :: WitCtx witctx
   -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag.
   -> Parser (ScriptWitnessFiles witctx)
 pPlutusReferenceScriptWitnessFiles witctx autoBalanceExecUnits =
    toReferenceScriptWitnessFiles
      <$> ( (,,,,) <$> pReferenceTxIn
-                  <*> pAnyScriptLang
+                  <*> pPlutusScriptLanguage
                   <*> pScriptDatumOrFile "reference-tx-in" witctx
                   <*> pScriptRedeemerOrFile "reference-tx-in"
                   <*> (case autoBalanceExecUnits of
                         AutoBalance -> pure (ExecutionUnits 0 0)
                         ManualBalance -> pExecutionUnits "reference-tx-in")
          )
  where
-  pReferenceTxIn :: Parser TxIn
-  pReferenceTxIn =
-    Opt.option (readerFromParsecParser parseTxIn)
-      (  Opt.long "tx-in-reference"
-      <> Opt.metavar "TX-IN"
-      <> Opt.help "TxId#TxIx - Specify a reference input. The reference input may or may not have\
-                  \ a plutus reference script attached."
-      )
-  pAnyScriptLang :: Parser AnyScriptLanguage
-  pAnyScriptLang =
-    Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV1)
-      (  Opt.long "simple-script-v1"
-      <> Opt.help "Specify a simple script v1 reference script. \
-                  \See documentation at doc/reference/simple-scripts.md"
-      ) <|>
-    Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV2)
-      (  Opt.long "simple-script-v2"
-      <> Opt.help "Specify a simple script v2 reference script. \
-                  \See documentation at doc/reference/simple-scripts.md"
-      ) <|>
+  pPlutusScriptLanguage :: Parser AnyScriptLanguage
+  pPlutusScriptLanguage =
     Opt.flag' (AnyScriptLanguage $ PlutusScriptLanguage PlutusScriptV2)
       (  Opt.long "plutus-script-v2"
       <> Opt.help "Specify a plutus script v2 reference script."
       )
 
-
   toReferenceScriptWitnessFiles
     :: (TxIn, AnyScriptLanguage, ScriptDatumOrFile witctx, ScriptRedeemerOrFile, ExecutionUnits)
     -> ScriptWitnessFiles witctx
   toReferenceScriptWitnessFiles (txin, sLang, d,r, e) = PlutusReferenceScriptWitnessFiles txin sLang d r e
 
+pReferenceTxIn :: Parser TxIn
+pReferenceTxIn =
+  Opt.option (readerFromParsecParser parseTxIn)
+    (  Opt.long "tx-in-reference"
+    <> Opt.metavar "TX-IN"
+    <> Opt.help "TxId#TxIx - Specify a reference input. The reference input may or may not have\
+                \ a plutus reference script attached."
+    )
+
 pScriptWitnessFiles :: forall witctx.
                        WitCtx witctx
                     -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag.
@@ -2077,7 +2093,8 @@ pTxIn balance =
      pScriptWitnessFiles WitCtxTxIn balance
       "tx-in" (Just "txin")
       "the spending of the transaction input." <|>
-     pPlutusReferenceScriptWitnessFiles WitCtxTxIn balance
+     pPlutusReferenceScriptWitnessFiles WitCtxTxIn balance <|>
+     pSimpleReferenceScriptWitnessFiles
 
 pTxInCollateral :: Parser TxIn
 pTxInCollateral =

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
@@ -1063,8 +1063,8 @@ createScriptWitness era (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do
     ScriptInEra langInEra script'   <- validateScriptSupportedInEra era script
     case script' of
       SimpleScript version sscript ->
-        return $ SimpleScriptWitness
-                   langInEra version sscript
+        return . SimpleScriptWitness
+                   langInEra version $ SScript sscript
 
       -- If the supplied cli flags were for a simple script (i.e. the user did
       -- not supply the datum, redeemer or ex units), but the script file turns
@@ -1107,20 +1107,39 @@ createScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn
     Nothing -> left $ ShelleyTxCmdReferenceScriptsNotSupportedInEra
                     $ getIsCardanoEraConstraint era (AnyCardanoEra era)
     Just _ -> do
-      datum    <- readScriptDatumOrFile    datumOrFile
-      redeemer <- readScriptRedeemerOrFile redeemerOrFile
+
       case scriptLanguageSupportedInEra era anyScriptLanguage of
         Just sLangInEra ->
           case languageOfScriptLanguageInEra sLangInEra of
-            SimpleScriptLanguage _v -> panic "TODO: createScriptWitness: SimpleScriptLanguage"
-            PlutusScriptLanguage version ->
+            SimpleScriptLanguage _v ->
+              -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang
+              -- in order to make this branch unrepresentable.
+              panic "createScriptWitness: Should not be possible to specify a simple script"
+            PlutusScriptLanguage version -> do
+              datum    <- readScriptDatumOrFile    datumOrFile
+              redeemer <- readScriptRedeemerOrFile redeemerOrFile
               return $ PlutusScriptWitness
                          sLangInEra
                          version
                          (PReferenceScript refTxIn)
                          datum redeemer execUnits
         Nothing ->
           left $ ShelleyTxCmdScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era)
+createScriptWitness era (SimpleReferenceScriptWitnessFiles refTxIn
+                         anyScrLang@(AnyScriptLanguage anyScriptLanguage)) = do
+  case refInsScriptsAndInlineDatsSupportedInEra era of
+    Nothing -> left $ ShelleyTxCmdReferenceScriptsNotSupportedInEra
+                    $ getIsCardanoEraConstraint era (AnyCardanoEra era)
+    Just _ -> do
+      case scriptLanguageSupportedInEra era anyScriptLanguage of
+        Just sLangInEra ->
+          case languageOfScriptLanguageInEra sLangInEra of
+            SimpleScriptLanguage v ->
+              return . SimpleScriptWitness sLangInEra v $ SReferenceScript refTxIn
+            PlutusScriptLanguage{} ->
+              panic "createScriptWitness: Should not be possible to specify a plutus script"
+        Nothing ->
+          left $ ShelleyTxCmdScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era)
 
 getIsCardanoEraConstraint
   :: CardanoEra era -> (IsCardanoEra era => a) -> a

diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs
@@ -288,21 +288,24 @@ data ScriptWitnessFiles witctx where
                               -> ScriptWitnessFiles witctx
 
      PlutusScriptWitnessFiles :: ScriptFile
-                              -> ScriptDatumOrFile witctx -- TODO: Babbage Modify to allow specification of inline datums
+                              -> ScriptDatumOrFile witctx
                               -> ScriptRedeemerOrFile
                               -> ExecutionUnits
                               -> ScriptWitnessFiles witctx
 
-     -- TODO: SimpleReferenceScriptWitnessFiles :: ScriptWitnessFiles witctx
-
      PlutusReferenceScriptWitnessFiles
        :: TxIn
        -> AnyScriptLanguage
-       -> ScriptDatumOrFile witctx -- TODO: Babbage Modify to allow specification of inline datums
+       -> ScriptDatumOrFile witctx
        -> ScriptRedeemerOrFile
        -> ExecutionUnits
        -> ScriptWitnessFiles witctx
 
+     SimpleReferenceScriptWitnessFiles
+       :: TxIn
+       -> AnyScriptLanguage
+       -> ScriptWitnessFiles witctx
+
 
 deriving instance Show (ScriptWitnessFiles witctx)