#299 Fix 'MissingRedeemers'

cardano-cli/cardano-cli.cabal

@@ -240,6 +240,7 @@ library
                       , parsec
                       , prettyprinter
                       , prettyprinter-ansi-terminal
+                      , pretty-simple
                       , random
                       , split
                       , strict-stm

cardano-cli/src/Cardano/CLI/Byron/Run.hs

@@ -34,9 +34,11 @@ import qualified Data.ByteString.Char8 as BS
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
+import qualified Data.Text.Lazy as T
 import qualified Data.Text.Lazy.Builder as Builder
 import qualified Data.Text.Lazy.IO as TL
 import qualified Formatting as F
+import           Text.Pretty.Simple (pShow)
 
 -- | Data type that encompasses all the possible errors of the
 -- Byron client.
@@ -60,7 +62,7 @@ renderByronClientCmdError err =
     ByronCmdKeyFailure e -> renderByronKeyFailure e
     ByronCmdTxError e -> renderByronTxError e
     ByronCmdTxSubmitError e ->
-      "Error while submitting Byron tx: " <> Text.pack (show e)
+      "Error while submitting Byron tx: " <> T.toStrict (pShow e)
     ByronCmdUpdateProposalError e -> renderByronUpdateProposalError e
     ByronCmdVoteError e -> renderByronVoteError e
 

cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs

@@ -67,9 +67,13 @@ import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
+import qualified Data.Text.Lazy as Text
 import           Data.Type.Equality (TestEquality (..))
 import           Lens.Micro ((^.))
 import qualified System.IO as IO
+import           Text.Pretty.Simple (pPrint, pShow)
+
+import           Debug.Trace
 
 runTransactionCmds :: TransactionCmds era -> ExceptT TxCmdError IO ()
 runTransactionCmds cmd =
@@ -161,7 +165,9 @@ runTxBuildCmd
                             }
 
   inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era txins
+  liftIO $ trace ">>>> 167" $ pPrint inputsAndMaybeScriptWits
   certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era certs
+  liftIO $ trace ">>>> 169" $ pPrint certFilesAndMaybeScriptWits
 
   -- TODO: Conway Era - How can we make this more composable?
   certsAndMaybeScriptWits <-
@@ -173,13 +179,14 @@ runTxBuildCmd
               readFileTextEnvelope AsCertificate (File certFile))
           | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
           ]
-  withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError
-                                     $ readScriptWitnessFilesThruple era wdrls
-  txMetadata <- firstExceptT TxCmdMetadataError
-                  . newExceptT $ readTxMetadata era metadataSchema metadataFiles
+  withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $
+    readScriptWitnessFilesThruple era wdrls
+  liftIO $ trace ">>>> 181" $ pPrint withdrawalsAndMaybeScriptWits
+  txMetadata <- firstExceptT TxCmdMetadataError . newExceptT $
+    readTxMetadata era metadataSchema metadataFiles
   valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe mempty mValue
   scripts <- firstExceptT TxCmdScriptFileError $
-                     mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles
+    mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles
   txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts
 
   mProp <- forM mUpProp $ \(UpdateProposalFile upFp) ->
@@ -210,10 +217,15 @@ runTxBuildCmd
       mUpperBound certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits
       requiredSigners txAuxScripts txMetadata mProp mOverrideWits votes proposals outputOptions
 
+
   mScriptWits <-
     case cardanoEraStyle era of
       LegacyByronEra -> return []
-      ShelleyBasedEra sbe -> return $ collectTxBodyScriptWitnesses sbe txBodycontent
+      ShelleyBasedEra sbe -> do
+        liftIO $ trace ">>>> 219 " $ pPrint txBodycontent
+        return $ collectTxBodyScriptWitnesses sbe txBodycontent
+
+  liftIO $ trace ">>>> 224 " $ pPrint mScriptWits
 
   let allReferenceInputs = getAllReferenceInputs
                              inputsAndMaybeScriptWits
@@ -222,6 +234,10 @@ runTxBuildCmd
                              withdrawalsAndMaybeScriptWits
                              readOnlyRefIns
 
+  liftIO $ trace ">>>> 236" $ pPrint allReferenceInputs
+  liftIO $ trace ">>>> 237" $ pPrint outputOptions
+  liftIO $ trace ">>>> 238" $ pPrint balancedTxBody
+
   let inputsThatRequireWitnessing = [input | (input,_) <- inputsAndMaybeScriptWits]
       allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ filteredTxinsc
 
@@ -519,12 +535,13 @@ runTxBuild
       dummyFee = Just $ Lovelace 0
       inputsThatRequireWitnessing = [input | (input,_) <- inputsAndMaybeScriptWits]
 
-  -- Pure
+
   let allReferenceInputs = getAllReferenceInputs
                              inputsAndMaybeScriptWits
                              (snd valuesWithScriptWits)
                              certsAndMaybeScriptWits
-                             withdrawals readOnlyRefIns
+                             withdrawals
+                             readOnlyRefIns
 
   validatedCollateralTxIns <- hoistEither $ validateTxInsCollateral era txinsc
   validatedRefInputs <- hoistEither $ validateTxInsReference era allReferenceInputs
@@ -537,7 +554,9 @@ runTxBuild
                          <*> hoistEither (first TxCmdTxValidityUpperBoundValidationError $ validateTxValidityUpperBound era mUpperBound)
   validatedReqSigners <- hoistEither (first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners)
   validatedTxWtdrwls <- hoistEither (first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals)
+  liftIO $ trace ">>>> 557" $ pPrint validatedTxWtdrwls
   validatedTxCerts <- hoistEither (first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits)
+  liftIO $ trace ">>>> 559" $ pPrint validatedTxCerts
   validatedTxUpProp <- hoistEither (first TxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdatePropF)
   validatedMintValue <- hoistEither $ createTxMintValue era valuesWithScriptWits
   validatedTxScriptValidity <- hoistEither (first TxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity)
@@ -887,10 +906,11 @@ runTxSignCmd :: ()
   -> ExceptT TxCmdError IO ()
 runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do
   sks <-  mapM (firstExceptT TxCmdReadWitnessSigningDataError . newExceptT . readWitnessSigningData) witSigningData
+  -- liftIO $ trace ">>>> 905" $ pPrint sks
 
   let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks
 
-  case txOrTxBody of
+  trace "SIGNNN" $ traceShow txOrTxBody $ case txOrTxBody of
     InputTxFile (File inputTxFilePath) -> do
       inputTxFile <- liftIO $ fileOrPipe inputTxFilePath
       anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdCddlError)
@@ -930,6 +950,9 @@ runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do
 
          let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley
              tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody
+         -- liftIO $ trace ">>>> 949" $ pPrint byronWitnesses
+         -- liftIO $ trace ">>>> 950" $ pPrint shelleyKeyWitnesses
+         -- liftIO $ trace ">>>> 951" $ pPrint tx
 
          lift (writeTxFileTextEnvelopeCddl outTxFile tx)
             & onLeft (left . TxCmdWriteFileError)
@@ -980,7 +1003,7 @@ runTxSubmitCmd socketPath (AnyConsensusModeParams cModeParams) network txFilePat
       Net.Tx.SubmitSuccess -> liftIO $ Text.putStrLn "Transaction successfully submitted."
       Net.Tx.SubmitFail reason ->
         case reason of
-          TxValidationErrorInMode err _eraInMode -> left . TxCmdTxSubmitError . Text.pack $ show err
+          TxValidationErrorInMode err _eraInMode -> left . TxCmdTxSubmitError . Text.toStrict $ pShow err
           TxValidationEraMismatch mismatchErr -> left $ TxCmdTxSubmitErrorEraMismatch mismatchErr
 
 -- ----------------------------------------------------------------------------

cardano-cli/src/Cardano/CLI/Read.hs

@@ -139,6 +139,8 @@ import           GHC.IO.Handle.FD (openFileBlocking)
 import qualified Options.Applicative as Opt
 import           System.IO (IOMode (ReadMode))
 
+import           Debug.Trace
+
 -- Metadata
 
 data MetadataError
@@ -295,9 +297,9 @@ readScriptWitness era (PlutusScriptWitnessFiles
     case script' of
       PlutusScript version pscript -> do
         datum <- firstExceptT ScriptWitnessErrorScriptData
-                   $ readScriptDatumOrFile    datumOrFile
-        redeemer <- firstExceptT ScriptWitnessErrorScriptData
-                      $ readScriptRedeemerOrFile redeemerOrFile
+                   $ readScriptDatumOrFile datumOrFile
+        redeemer <- trace "REDEEMER" $ traceShow redeemerOrFile $ fmap (traceShowId) $  firstExceptT ScriptWitnessErrorScriptData
+                   $ readScriptRedeemerOrFile redeemerOrFile
         return $ PlutusScriptWitness
                    langInEra version (PScript pscript)
                    datum
@@ -619,6 +621,7 @@ data SomeSigningWitness
   | AGenesisDelegateExtendedSigningWitness  (SigningKey GenesisDelegateExtendedKey)
   | AGenesisUTxOSigningWitness              (SigningKey GenesisUTxOKey)
   | ADRepSigningWitness                     (SigningKey DRepKey)
+  deriving Show
 
 
 -- | Data required for constructing a Shelley bootstrap witness.

cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs

@@ -15,8 +15,8 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
-import           Cardano.CLI.Types.Errors.ProtocolParamsError
 import           Cardano.CLI.Types.Errors.BootstrapWitnessError
+import           Cardano.CLI.Types.Errors.ProtocolParamsError
 import           Cardano.CLI.Types.Errors.TxValidationError
 import           Cardano.CLI.Types.Output
 import           Cardano.CLI.Types.TxFeature
@@ -102,7 +102,7 @@ renderTxCmdError err =
     TxCmdReadWitnessSigningDataError witSignDataErr ->
       renderReadWitnessSigningDataError witSignDataErr
     TxCmdWriteFileError fileErr -> Text.pack (displayError fileErr)
-    TxCmdTxSubmitError res -> "Error while submitting tx: " <> res
+    TxCmdTxSubmitError res -> "Error while submitting tx: " <> (res)
     TxCmdTxSubmitErrorEraMismatch EraMismatch{ledgerEraName, otherEraName} ->
       "The era of the node and the tx do not match. " <>
       "The node is running in the " <> ledgerEraName <>

cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.Types.Errors.TxValidationError
   ( TxAuxScriptsValidationError(..)
@@ -35,6 +36,7 @@ module Cardano.CLI.Types.Errors.TxValidationError
   ) where
 
 import           Cardano.Api
+import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
 
 import           Prelude
@@ -274,30 +276,39 @@ validateTxCertificates era certsAndScriptWitnesses =
           reqWits = Map.fromList $ mapMaybe convert certsAndScriptWitnesses
       return $ TxCertificates supported certs $ BuildTxWith reqWits
   where
-   -- We get the stake credential witness for a certificate that requires it.
-   -- NB: Only stake address deregistration and delegation requires
-   -- witnessing (witness can be script or key)
-   deriveStakeCredentialWitness
-     :: Certificate era
-     -> Maybe StakeCredential
-   deriveStakeCredentialWitness _cert = Nothing
-    --  case cert of
-    --    -- TODO: Conway era
-    --    -- StakeAddressDeregistrationCertificate sCred -> Just sCred
-    --    -- StakeAddressPoolDelegationCertificate sCred _ -> Just sCred
-    --    _ -> Nothing
-
-   convert
-     :: (Certificate era, Maybe (ScriptWitness WitCtxStake era))
-     -> Maybe (StakeCredential, Witness WitCtxStake era)
-   convert (cert, mScriptWitnessFiles) = do
-     sCred <- deriveStakeCredentialWitness cert
-     case mScriptWitnessFiles of
-       Just sWit -> do
-         Just ( sCred
-              , ScriptWitness ScriptWitnessForStakeAddr sWit
-              )
-       Nothing -> Just (sCred, KeyWitness KeyWitnessForStakeAddr)
+    -- We get the stake credential witness for a certificate that requires it.
+    -- NB: Only stake address deregistration and delegation requires
+    -- witnessing (witness can be script or key)
+    deriveStakeCredentialWitness
+      :: Certificate era
+      -> Maybe StakeCredential
+    deriveStakeCredentialWitness = fmap fromShelleyStakeCredential . \case
+      ShelleyRelatedCertificate stbEra shelleyCert -> shelleyToBabbageEraConstraints stbEra $
+        case shelleyCert of
+          L.RegTxCert _sCred         -> Nothing -- not required
+          L.UnRegTxCert sCred        -> Just sCred
+          L.DelegStakeTxCert sCred _ -> Just sCred
+          _                          -> Nothing
+
+      ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $
+        case conwayCert of
+          L.RegDepositTxCert _sCred _       -> Nothing -- not required
+          L.UnRegDepositTxCert sCred _      -> Just sCred
+          L.DelegTxCert sCred _             -> Just sCred
+          L.RegDepositDelegTxCert sCred _ _ -> Just sCred
+          _                                 -> Nothing
+
+    convert
+      :: (Certificate era, Maybe (ScriptWitness WitCtxStake era))
+      -> Maybe (StakeCredential, Witness WitCtxStake era)
+    convert (cert, mScriptWitnessFiles) = do
+      sCred <- deriveStakeCredentialWitness cert
+      case mScriptWitnessFiles of
+        Just sWit -> do
+          Just ( sCred
+               , ScriptWitness ScriptWitnessForStakeAddr sWit
+               )
+        Nothing -> Just (sCred, KeyWitness KeyWitnessForStakeAddr)
 
 newtype TxProtocolParametersValidationError
   = ProtocolParametersNotSupported AnyCardanoEra