Add TxExtraKeyWitnesses to TxBodyContent

These specify that extra key witnesses are required, and this fact is
visible to Plutus scripts. It thereby provides a mechaism for Plutus
scripts to check that the transaction has been signed by a particular
key.

Co-authored-by: Duncan Coutts <duncan@well-typed.com>

cardano-api/src/Cardano/Api.hs

@@ -174,6 +174,7 @@ module Cardano.Api (
     TxMetadataInEra(..),
     TxAuxScripts(..),
     TxAuxScriptData(..),
+    TxExtraKeyWitnesses(..),
     TxWithdrawals(..),
     TxCertificates(..),
     TxUpdateProposal(..),
@@ -194,6 +195,7 @@ module Cardano.Api (
     ValidityLowerBoundSupportedInEra(..),
     TxMetadataSupportedInEra(..),
     AuxScriptsSupportedInEra(..),
+    TxExtraKeyWitnessesSupportedInEra(..),
     WithdrawalsSupportedInEra(..),
     CertificatesSupportedInEra(..),
     UpdateProposalSupportedInEra(..),
@@ -206,6 +208,7 @@ module Cardano.Api (
     validityLowerBoundSupportedInEra,
     txMetadataSupportedInEra,
     auxScriptsSupportedInEra,
+    extraKeyWitnessesSupportedInEra,
     withdrawalsSupportedInEra,
     certificatesSupportedInEra,
     updateProposalSupportedInEra,

cardano-api/src/Cardano/Api/TxBody.hs

@@ -50,6 +50,7 @@ module Cardano.Api.TxBody (
     TxMetadataInEra(..),
     TxAuxScripts(..),
     TxAuxScriptData(..),
+    TxExtraKeyWitnesses(..),
     TxWithdrawals(..),
     TxCertificates(..),
     TxUpdateProposal(..),
@@ -70,6 +71,7 @@ module Cardano.Api.TxBody (
     ValidityLowerBoundSupportedInEra(..),
     TxMetadataSupportedInEra(..),
     AuxScriptsSupportedInEra(..),
+    TxExtraKeyWitnessesSupportedInEra(..),
     ScriptDataSupportedInEra(..),
     WithdrawalsSupportedInEra(..),
     CertificatesSupportedInEra(..),
@@ -83,6 +85,7 @@ module Cardano.Api.TxBody (
     validityLowerBoundSupportedInEra,
     txMetadataSupportedInEra,
     auxScriptsSupportedInEra,
+    extraKeyWitnessesSupportedInEra,
     scriptDataSupportedInEra,
     withdrawalsSupportedInEra,
     certificatesSupportedInEra,
@@ -643,6 +646,30 @@ auxScriptsSupportedInEra MaryEra    = Just AuxScriptsInMaryEra
 auxScriptsSupportedInEra AlonzoEra  = Just AuxScriptsInAlonzoEra
 
 
+-- | A representation of whether the era supports transactions that specify
+-- in the body that they need extra key witnesses, and where this fact is
+-- visible to scripts.
+--
+-- Extra key witnesses visible to scripts are supported from the Alonzo era
+-- onwards.
+--
+data TxExtraKeyWitnessesSupportedInEra era where
+
+     ExtraKeyWitnessesInAlonzoEra :: TxExtraKeyWitnessesSupportedInEra AlonzoEra
+
+
+deriving instance Eq   (TxExtraKeyWitnessesSupportedInEra era)
+deriving instance Show (TxExtraKeyWitnessesSupportedInEra era)
+
+extraKeyWitnessesSupportedInEra :: CardanoEra era
+                                -> Maybe (TxExtraKeyWitnessesSupportedInEra era)
+extraKeyWitnessesSupportedInEra ByronEra   = Nothing
+extraKeyWitnessesSupportedInEra ShelleyEra = Nothing
+extraKeyWitnessesSupportedInEra AllegraEra = Nothing
+extraKeyWitnessesSupportedInEra MaryEra    = Nothing
+extraKeyWitnessesSupportedInEra AlonzoEra  = Just ExtraKeyWitnessesInAlonzoEra
+
+
 -- | A representation of whether the era supports multi-asset transactions.
 --
 -- The Mary and subsequent eras support multi-asset transactions.
@@ -869,6 +896,20 @@ data TxAuxScripts era where
 deriving instance Eq   (TxAuxScripts era)
 deriving instance Show (TxAuxScripts era)
 
+-- ----------------------------------------------------------------------------
+-- Optionally required signatures (era-dependent)
+--
+
+data TxExtraKeyWitnesses era where
+
+  TxExtraKeyWitnessesNone :: TxExtraKeyWitnesses era
+
+  TxExtraKeyWitnesses     :: TxExtraKeyWitnessesSupportedInEra era
+                          -> [Hash PaymentKey]
+                          -> TxExtraKeyWitnesses era
+
+deriving instance Eq   (TxExtraKeyWitnesses era)
+deriving instance Show (TxExtraKeyWitnesses era)
 
 -- ----------------------------------------------------------------------------
 -- Auxiliary script data (era-dependent)
@@ -967,6 +1008,7 @@ data TxBodyContent build era =
                             TxValidityUpperBound era),
        txMetadata       :: TxMetadataInEra era,
        txAuxScripts     :: TxAuxScripts era,
+       txExtraKeyWits   :: TxExtraKeyWitnesses era,
      --txAuxScriptData  :: TxAuxScriptData era, -- TODO alonzo
        txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters),
        txWithdrawals    :: TxWithdrawals  build era,
@@ -1323,6 +1365,7 @@ fromLedgerTxBody era body mAux =
       , txCertificates   = fromLedgerTxCertificates   era body
       , txUpdateProposal = fromLedgerTxUpdateProposal era body
       , txMintValue      = fromLedgerTxMintValue      era body
+      , txExtraKeyWits   = fromLedgerTxExtraKeyWitnesses era body
       , txProtocolParams = ViewTx
       , txMetadata
       , txAuxScripts
@@ -1486,6 +1529,20 @@ fromLedgerTxAuxiliaryData era (Just auxData) =
     (ms, ss) = fromLedgerAuxiliaryData era auxData
 
 
+fromLedgerTxExtraKeyWitnesses :: ShelleyBasedEra era
+                              -> Ledger.TxBody (ShelleyLedgerEra era)
+                              -> TxExtraKeyWitnesses era
+fromLedgerTxExtraKeyWitnesses sbe body =
+  case sbe of
+    ShelleyBasedEraShelley -> TxExtraKeyWitnessesNone
+    ShelleyBasedEraAllegra -> TxExtraKeyWitnessesNone
+    ShelleyBasedEraMary    -> TxExtraKeyWitnessesNone
+    ShelleyBasedEraAlonzo  -> TxExtraKeyWitnesses
+                                ExtraKeyWitnessesInAlonzoEra
+                                [ PaymentKeyHash (Shelley.coerceKeyRole keyhash)
+                                | let keyhashes = Alonzo.reqSignerHashes body
+                                , keyhash <- Set.toList keyhashes ]
+
 fromLedgerTxWithdrawals
   :: ShelleyBasedEra era
   -> Ledger.TxBody (ShelleyLedgerEra era)
@@ -1670,6 +1727,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) =
                             ValidityNoUpperBoundInByronEra),
       txMetadata       = TxMetadataNone,
       txAuxScripts     = TxAuxScriptsNone,
+      txExtraKeyWits   = TxExtraKeyWitnessesNone,
       txProtocolParams = ViewTx,
       txWithdrawals    = TxWithdrawalsNone,
       txCertificates   = TxCertificatesNone,
@@ -1895,6 +1953,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo
                              txValidityRange = (lowerBound, upperBound),
                              txMetadata,
                              txAuxScripts,
+                             txExtraKeyWits,
                              txProtocolParams,
                              txWithdrawals,
                              txCertificates,
@@ -1952,7 +2011,11 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo
           (case txUpdateProposal of
              TxUpdateProposalNone -> SNothing
              TxUpdateProposal _ p -> SJust (toAlonzoUpdate p))
-          (error "TODO alonzo: extra key hashes for required witnesses")
+          (case txExtraKeyWits of
+             TxExtraKeyWitnessesNone   -> Set.empty
+             TxExtraKeyWitnesses _ khs -> Set.fromList
+                                            [ Shelley.coerceKeyRole kh
+                                            | PaymentKeyHash kh <- khs ])
           (case txMintValue of
              TxMintNone        -> mempty
              TxMintValue _ v _ -> toMaryValue v)

cardano-api/test/Test/Cardano/Api/Typed/Gen.hs

@@ -527,6 +527,7 @@ genTxBodyContent era = do
     , txValidityRange = validityRange
     , txMetadata = txMd
     , txAuxScripts = auxScripts
+    , txExtraKeyWits = TxExtraKeyWitnessesNone --TODO: Alonzo era: Generate witness key hashes
     , txProtocolParams = BuildTxWith mpparams
     , txWithdrawals = withdrawals
     , txCertificates = certs

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

@@ -159,6 +159,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do
             )
             TxMetadataNone
             TxAuxScriptsNone
+            TxExtraKeyWitnessesNone
             (BuildTxWith Nothing)
             TxWithdrawalsNone
             TxCertificatesNone
@@ -195,6 +196,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do
                      )
                      TxMetadataNone
                      TxAuxScriptsNone
+                     TxExtraKeyWitnessesNone
                      (BuildTxWith Nothing)
                      TxWithdrawalsNone
                      TxCertificatesNone

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

@@ -260,6 +260,7 @@ runTxBuildRaw (AnyCardanoEra era) inputsAndScripts txouts mLowerBound
                  <*> validateTxValidityUpperBound era mUpperBound)
         <*> validateTxMetadataInEra  era metadataSchema metadataFiles
         <*> validateTxAuxScripts     era scriptFiles
+        <*> pure TxExtraKeyWitnessesNone --TODO alonzo: support this
         <*> pure (BuildTxWith Nothing) --TODO alonzo: support this
         <*> validateTxWithdrawals    era withdrawals
         <*> validateTxCertificates   era certFiles