Add TxRequiredScriptSignatures to TxBodyContent for Plutus scripts that

require additional witnesses

cardano-api/src/Cardano/Api.hs

@@ -175,6 +175,7 @@ module Cardano.Api (
     TxMetadataInEra(..),
     TxAuxScripts(..),
     TxAuxScriptData(..),
+    TxRequiredScriptSignatures(..),
     TxWithdrawals(..),
     TxCertificates(..),
     TxUpdateProposal(..),
@@ -534,7 +535,7 @@ import           Cardano.Api.Modes
 import           Cardano.Api.NetworkId
 import           Cardano.Api.OperationalCertificate
 import           Cardano.Api.ProtocolParameters
-import           Cardano.Api.Query (SlotsInEpoch(..), SlotsToEpochEnd(..), slotToEpoch)
+import           Cardano.Api.Query (SlotsInEpoch (..), SlotsToEpochEnd (..), slotToEpoch)
 import           Cardano.Api.Script
 import           Cardano.Api.SerialiseBech32
 import           Cardano.Api.SerialiseCBOR

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

@@ -27,6 +27,7 @@ module Cardano.Api.KeysShelley (
     GenesisDelegateKey,
     GenesisDelegateExtendedKey,
     GenesisUTxOKey,
+    WitnessKey,
 
     -- * Data family instances
     AsType(..),
@@ -52,8 +53,8 @@ import qualified Cardano.Ledger.Crypto as Shelley (DSIGN)
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
 import qualified Shelley.Spec.Ledger.Keys as Shelley
 
-import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.Hash
 import           Cardano.Api.Key
 import           Cardano.Api.SerialiseBech32
 import           Cardano.Api.SerialiseCBOR
@@ -1094,6 +1095,93 @@ instance CastSigningKeyRole GenesisUTxOKey PaymentKey where
     castSigningKey (GenesisUTxOSigningKey skey) =
       PaymentSigningKey skey
 
+--
+-- Plutus script witness keys
+--
+
+data WitnessKey
+
+instance HasTypeProxy WitnessKey where
+    data AsType WitnessKey = AsWitnessKey
+    proxyToAsType _ = AsWitnessKey
+
+
+instance Key WitnessKey where
+
+    newtype VerificationKey WitnessKey =
+        WitnessVerificationKey (Shelley.VKey Shelley.Witness StandardCrypto)
+      deriving stock (Eq)
+      deriving (Show, IsString) via UsingRawBytesHex (VerificationKey WitnessKey)
+      deriving newtype (ToCBOR, FromCBOR)
+      deriving anyclass SerialiseAsCBOR
+
+    newtype SigningKey WitnessKey =
+        WitnessSigningKey (Shelley.SignKeyDSIGN StandardCrypto)
+      deriving (Show, IsString) via UsingRawBytesHex (SigningKey WitnessKey)
+      deriving newtype (ToCBOR, FromCBOR)
+      deriving anyclass SerialiseAsCBOR
+
+    deterministicSigningKey :: AsType WitnessKey -> Crypto.Seed -> SigningKey WitnessKey
+    deterministicSigningKey AsWitnessKey seed =
+        WitnessSigningKey (Crypto.genKeyDSIGN seed)
+
+    deterministicSigningKeySeedSize :: AsType WitnessKey -> Word
+    deterministicSigningKeySeedSize AsWitnessKey =
+        Crypto.seedSizeDSIGN proxy
+      where
+        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
+        proxy = Proxy
+
+    getVerificationKey :: SigningKey WitnessKey -> VerificationKey WitnessKey
+    getVerificationKey (WitnessSigningKey sk) =
+        WitnessVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk))
+
+    verificationKeyHash :: VerificationKey WitnessKey -> Hash WitnessKey
+    verificationKeyHash (WitnessVerificationKey vkey) =
+        WitnessKeyHash (Shelley.hashKey vkey)
+
+
+instance SerialiseAsRawBytes (VerificationKey WitnessKey) where
+    serialiseToRawBytes (WitnessVerificationKey (Shelley.VKey vk)) =
+      Crypto.rawSerialiseVerKeyDSIGN vk
+
+    deserialiseFromRawBytes (AsVerificationKey AsWitnessKey) bs =
+      WitnessVerificationKey . Shelley.VKey <$>
+        Crypto.rawDeserialiseVerKeyDSIGN bs
+
+instance SerialiseAsRawBytes (SigningKey WitnessKey) where
+    serialiseToRawBytes (WitnessSigningKey sk) =
+      Crypto.rawSerialiseSignKeyDSIGN sk
+
+    deserialiseFromRawBytes (AsSigningKey AsWitnessKey) bs =
+      WitnessSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs
+
+
+newtype instance Hash WitnessKey =
+    WitnessKeyHash (Shelley.KeyHash Shelley.Witness StandardCrypto)
+  deriving stock (Eq, Ord)
+  deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentKey)
+
+instance SerialiseAsRawBytes (Hash WitnessKey) where
+    serialiseToRawBytes (WitnessKeyHash (Shelley.KeyHash vkh)) =
+      Crypto.hashToBytes vkh
+
+    deserialiseFromRawBytes (AsHash AsWitnessKey) bs =
+      WitnessKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs
+
+instance HasTextEnvelope (VerificationKey WitnessKey) where
+    textEnvelopeType _ = "WitnessVerificationKey_"
+                      <> fromString (Crypto.algorithmNameDSIGN proxy)
+      where
+        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
+        proxy = Proxy
+
+instance HasTextEnvelope (SigningKey WitnessKey) where
+    textEnvelopeType _ = "WitnessSigningKey_"
+                      <> fromString (Crypto.algorithmNameDSIGN proxy)
+      where
+        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
+        proxy = Proxy
 
 --
 -- stake pool keys

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

@@ -52,6 +52,7 @@ module Cardano.Api.TxBody (
     TxMetadataInEra(..),
     TxAuxScripts(..),
     TxAuxScriptData(..),
+    TxRequiredScriptSignatures(..),
     TxWithdrawals(..),
     TxCertificates(..),
     TxUpdateProposal(..),
@@ -643,6 +644,19 @@ auxScriptsSupportedInEra MaryEra    = Just AuxScriptsInMaryEra
 auxScriptsSupportedInEra AlonzoEra  = Just AuxScriptsInAlonzoEra
 
 
+-- | A representation of whether the era supports Plutus
+-- scripts optionally requiring signatures.
+--
+-- Required script signatures are supported from the Alonzo era onwards.
+--
+data TxRequiredScriptSignaturesSupportedInEra era where
+
+     RequiredScriptSignaturesInAlonzoEra :: TxRequiredScriptSignaturesSupportedInEra AlonzoEra
+
+
+deriving instance Eq   (TxRequiredScriptSignaturesSupportedInEra era)
+deriving instance Show (TxRequiredScriptSignaturesSupportedInEra era)
+
 -- | A representation of whether the era supports multi-asset transactions.
 --
 -- The Mary and subsequent eras support multi-asset transactions.
@@ -869,6 +883,20 @@ data TxAuxScripts era where
 deriving instance Eq   (TxAuxScripts era)
 deriving instance Show (TxAuxScripts era)
 
+-- ----------------------------------------------------------------------------
+-- Optionally required signatures (era-dependent)
+--
+
+data TxRequiredScriptSignatures era where
+
+  TxRequiredScriptSignaturesNone :: TxRequiredScriptSignatures era
+
+  TxRequiredScriptSignatures     :: TxRequiredScriptSignaturesSupportedInEra era
+                                 -> [Hash WitnessKey]
+                                 -> TxRequiredScriptSignatures era
+
+deriving instance Eq   (TxRequiredScriptSignatures era)
+deriving instance Show (TxRequiredScriptSignatures era)
 
 -- ----------------------------------------------------------------------------
 -- Auxiliary script data (era-dependent)
@@ -967,6 +995,7 @@ data TxBodyContent build era =
                             TxValidityUpperBound era),
        txMetadata       :: TxMetadataInEra era,
        txAuxScripts     :: TxAuxScripts era,
+       txReqScriptSigs  :: TxRequiredScriptSignatures era,
      --txAuxScriptData  :: TxAuxScriptData era, -- TODO alonzo
        txWithdrawals    :: TxWithdrawals  build era,
        txCertificates   :: TxCertificates build era,
@@ -1276,6 +1305,7 @@ fromLedgerTxBody era body mAux = do
       , txUpdateProposal = fromLedgerTxUpdateProposal era body
       , txMintValue
       , txMetadata
+      , txReqScriptSigs  = fromRequiredScriptSignatures era body
       , txAuxScripts
       }
   where
@@ -1461,6 +1491,19 @@ fromLedgerTxAuxiliaryData era (Just auxData) =
     (ms, ss) = fromLedgerAuxiliaryData era auxData
 
 
+fromRequiredScriptSignatures
+  :: ShelleyBasedEra era
+  -> Ledger.TxBody (ShelleyLedgerEra era)
+  -> TxRequiredScriptSignatures era
+fromRequiredScriptSignatures sbe body =
+  case sbe of
+    ShelleyBasedEraShelley -> TxRequiredScriptSignaturesNone
+    ShelleyBasedEraAllegra -> TxRequiredScriptSignaturesNone
+    ShelleyBasedEraMary -> TxRequiredScriptSignaturesNone
+    ShelleyBasedEraAlonzo ->
+      TxRequiredScriptSignatures RequiredScriptSignaturesInAlonzoEra
+        . map WitnessKeyHash . Set.toList $ Alonzo.reqSignerHashes body
+
 fromLedgerTxWithdrawals
   :: ShelleyBasedEra era
   -> Ledger.TxBody (ShelleyLedgerEra era)
@@ -2280,6 +2323,7 @@ makeByronTransactionBodyContent txIns txOuts =
                         TxValidityNoUpperBound
                           ValidityNoUpperBoundInByronEra),
     txMetadata       = TxMetadataNone,
+    txReqScriptSigs  = TxRequiredScriptSignaturesNone,
     txAuxScripts     = TxAuxScriptsNone,
     txWithdrawals    = TxWithdrawalsNone,
     txCertificates   = TxCertificatesNone,

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

@@ -526,6 +526,7 @@ genTxBodyContent era = do
     , txValidityRange = validityRange
     , txMetadata = txMd
     , txAuxScripts = auxScripts
+    , txReqScriptSigs = TxRequiredScriptSignaturesNone --TODO: Alonzo era: Generate witness key hashes
     , txWithdrawals = withdrawals
     , txCertificates = certs
     , txUpdateProposal = updateProposal