Update code to match rc3 changes

- 'evaluateTransactionExecutionUnits' has a new error type, update ErrAssignRedeemers accordingly. - 'SimpleScriptWitness' now takes a 'SimpleScriptOrReferenceInput' instead of a 'SimpleScript', update generators accordingly.
cardano-foundation · Jun 17, 2022 · 468807c · 468807c
1 parent c434449
commit 468807c
Show file tree

Hide file tree

Showing 5 changed files with 37 additions and 52 deletions.
diff --git a/lib/core/src/Cardano/Api/Gen.hs b/lib/core/src/Cardano/Api/Gen.hs
@@ -116,6 +116,7 @@ import Cardano.Api.Shelley
     , PoolId
     , ProtocolParameters (..)
     , ReferenceScript (..)
+    , SimpleScriptOrReferenceInput (..)
     , StakeCredential (..)
     , StakePoolMetadata (..)
     , StakePoolMetadataReference (..)
@@ -453,6 +454,17 @@ genSimpleScript lang =
         (Positive m) <- arbitrary
         genTerm (n `div` (m + 3))
 
+genReferenceInput :: Gen TxIn
+genReferenceInput = genTxIn
+
+genSimpleScriptOrReferenceInput
+    :: SimpleScriptVersion lang
+    -> Gen (SimpleScriptOrReferenceInput lang)
+genSimpleScriptOrReferenceInput lang =
+    oneof [ SScript <$> genSimpleScript lang
+          , SReferenceScript <$> genReferenceInput
+          ]
+
 genScript :: ScriptLanguage lang -> Gen (Script lang)
 genScript (SimpleScriptLanguage lang) =
     SimpleScript lang <$> genSimpleScript lang
@@ -690,7 +702,7 @@ genScriptWitnessMint
 genScriptWitnessMint langEra =
     case languageOfScriptLanguageInEra langEra of
         (SimpleScriptLanguage ver) ->
-            SimpleScriptWitness langEra ver <$> genSimpleScript ver
+            SimpleScriptWitness langEra ver <$> genSimpleScriptOrReferenceInput ver
         (PlutusScriptLanguage ver) ->
             PlutusScriptWitness langEra ver
             <$> genPlutusScriptOrReferenceInput ver
@@ -704,7 +716,7 @@ genScriptWitnessStake
 genScriptWitnessStake langEra =
     case languageOfScriptLanguageInEra langEra of
         (SimpleScriptLanguage ver) ->
-            SimpleScriptWitness langEra ver <$> genSimpleScript ver
+            SimpleScriptWitness langEra ver <$> genSimpleScriptOrReferenceInput ver
         (PlutusScriptLanguage ver) ->
             PlutusScriptWitness langEra ver
             <$> genPlutusScriptOrReferenceInput ver
@@ -718,7 +730,7 @@ genScriptWitnessSpend
 genScriptWitnessSpend langEra =
     case languageOfScriptLanguageInEra langEra of
         (SimpleScriptLanguage ver) ->
-            SimpleScriptWitness langEra ver <$> genSimpleScript ver
+            SimpleScriptWitness langEra ver <$> genSimpleScriptOrReferenceInput ver
         (PlutusScriptLanguage ver) ->
             PlutusScriptWitness langEra ver
             <$> genPlutusScriptOrReferenceInput ver

diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -5041,17 +5041,6 @@ instance IsServerError ErrAssignRedeemers where
                 , "for one of your redeemers since I am unable to decode it"
                 , "into a valid Plutus data:", pretty r <> "."
                 ]
-        ErrAssignRedeemersUnresolvedTxIns ins ->
-            -- Note that although this error is thrown from
-            -- '_assignScriptRedeemers', it's more related to balanceTransaction
-            -- in general than to assigning redeemers. Hence we don't mention
-            -- redeemers in the message.
-            apiError err400 UnresolvedInputs $ T.unwords
-                [ "The transaction I was given contains inputs I don't know"
-                , "about. Please ensure all foreign inputs are specified as "
-                , "part of the API request. The unknown inputs are:\n\n"
-                , pretty ins
-                ]
         ErrAssignRedeemersTranslationError e ->
             apiError err400 TranslationError $ T.unwords
                 [ "The transaction I was given contains bits that cannot be"

diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs
@@ -59,6 +59,8 @@ import Cardano.Api
     ( AnyCardanoEra )
 import Cardano.Ledger.Alonzo.TxInfo
     ( TranslationError )
+import Cardano.Ledger.Crypto
+    ( StandardCrypto )
 import Cardano.Wallet.CoinSelection
     ( SelectionCollateralRequirement (..)
     , SelectionLimit
@@ -508,9 +510,7 @@ data ErrAssignRedeemers
     -- ^ The given redeemer target couldn't be located in the transaction.
     | ErrAssignRedeemersInvalidData Redeemer String
     -- ^ Redeemer's data isn't a valid Plutus' data.
-    | ErrAssignRedeemersUnresolvedTxIns [TxIn]
-    -- ^ The transaction contains inputs which couldn't be resolved.
-    | ErrAssignRedeemersTranslationError TranslationError
+    | ErrAssignRedeemersTranslationError (TranslationError StandardCrypto)
     -- ^ Mistranslating of hashes, credentials, certificates etc.
     deriving (Generic, Eq, Show)
 

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs
@@ -83,9 +83,7 @@ import Cardano.Binary
 import Cardano.Crypto.Wallet
     ( XPub )
 import Cardano.Ledger.Alonzo.Tools
-    ( BasicFailure (BadTranslation, UnknownTxIns)
-    , evaluateTransactionExecutionUnits
-    )
+    ( evaluateTransactionExecutionUnits )
 import Cardano.Ledger.Crypto
     ( DSIGN )
 import Cardano.Ledger.Era
@@ -1311,10 +1309,7 @@ _assignScriptRedeemers pparams ti resolveInput redeemers tx =
                 systemStart
                 costs
         case res of
-            Left (UnknownTxIns ins) ->
-                Left $ ErrAssignRedeemersUnresolvedTxIns $
-                    map fromShelleyTxIn (F.toList ins)
-            Left (BadTranslation translationError) ->
+            Left translationError ->
                 Left $ ErrAssignRedeemersTranslationError translationError
             Right report ->
                 Right $ hoistScriptFailure indexedRedeemers report
@@ -1339,10 +1334,7 @@ _assignScriptRedeemers pparams ti resolveInput redeemers tx =
                 systemStart
                 costs
         case res of
-            Left (UnknownTxIns ins) ->
-                Left $ ErrAssignRedeemersUnresolvedTxIns $
-                    map fromShelleyTxIn (F.toList ins)
-            Left (BadTranslation translationError) -> do
+            Left translationError ->
                 Left $ ErrAssignRedeemersTranslationError translationError
             Right report ->
                 Right $ hoistScriptFailure indexedRedeemers report
@@ -2339,8 +2331,10 @@ mkUnsignedTx era ttl cs md wdrls certs fees mintData burnData allScripts =
                         Cardano.negateValue $
                         toCardanoValue (TokenBundle (Coin 0) burnData)
                     toScriptWitness script =
-                        Cardano.SimpleScriptWitness scriptWitsSupported
-                        Cardano.SimpleScriptV2 (toCardanoSimpleScript script)
+                        Cardano.SimpleScriptWitness
+                          scriptWitsSupported
+                          Cardano.SimpleScriptV2
+                          (Cardano.SScript $ toCardanoSimpleScript script)
                     witMap =
                         Map.map toScriptWitness $
                         Map.mapKeys (toCardanoPolicyId . TokenMap.tokenPolicyId)

diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs
@@ -237,7 +237,6 @@ import Cardano.Wallet.Shelley.Transaction
     )
 import Cardano.Wallet.Transaction
     ( DelegationAction (RegisterKeyAndJoin)
-    , ErrAssignRedeemers (..)
     , ErrMoreSurplusNeeded (..)
     , TransactionCtx (..)
     , TransactionLayer (..)
@@ -2990,28 +2989,19 @@ prop_balanceTransactionUnresolvedInputs wallet (ShowBuildable partialTx') seed =
     checkCoverage
         $ forAll (dropResolvedInputs partialTx') $ \(partialTx, dropped) -> do
             let res = balanceTransaction' wallet seed partialTx
-            cover 1 (isUnresolvedTxInsErr res) "unknown txins" $
-                case res of
-                    Right _
-                        | null dropped
-                            -> label "nothing dropped"
-                                $ property True
-                        | otherwise
-                            -> label "succeeded despite unresolved input"
-                                $ property True
-                            -- Balancing can succeed if the dropped inputs
-                            -- happen to be a part of the wallet UTxO.
-                    Left (ErrBalanceTxAssignRedeemers
-                        (ErrAssignRedeemersUnresolvedTxIns _))
-                        -> property True
-                    Left _
-                        -> label "other error" $ property True
+            case res of
+                Right _
+                    | null dropped
+                        -> label "nothing dropped"
+                            $ property True
+                    | otherwise
+                        -> label "succeeded despite unresolved input"
+                            $ property True
+                        -- Balancing can succeed if the dropped inputs
+                        -- happen to be a part of the wallet UTxO.
+                Left _
+                    -> label "other error" $ property True
   where
-    isUnresolvedTxInsErr
-        (Left (ErrBalanceTxAssignRedeemers
-            (ErrAssignRedeemersUnresolvedTxIns _))) = True
-    isUnresolvedTxInsErr _ = False
-
     dropResolvedInputs (PartialTx tx inputs redeemers) = do
         shouldKeep <- vectorOf (length inputs) $ frequency
             [ (8, pure False)