From c54cbfd4f3a89d200085334606cef9476429eee0 Mon Sep 17 00:00:00 2001 From: Luke Nadur <19835357+intricate@users.noreply.github.com> Date: Tue, 24 Nov 2020 00:02:11 -0500 Subject: [PATCH] WIP --- cardano-api/src/Cardano/Api/Tx.hs | 59 ++++- .../Cardano/CLI/Shelley/Run/Transaction.hs | 202 +++++++++++------- 2 files changed, 182 insertions(+), 79 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index 078f929559b..d3953a7f715 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -202,6 +202,14 @@ instance HasTypeProxy (Witness ShelleyEra) where data AsType (Witness ShelleyEra) = AsShelleyWitness proxyToAsType _ = AsShelleyWitness +instance HasTypeProxy (Witness AllegraEra) where + data AsType (Witness AllegraEra) = AsAllegraWitness + proxyToAsType _ = AsAllegraWitness + +instance HasTypeProxy (Witness MaryEra) where + data AsType (Witness MaryEra) = AsMaryWitness + proxyToAsType _ = AsMaryWitness + instance SerialiseAsCBOR (Witness ByronEra) where serialiseToCBOR (ByronKeyWitness wit) = CBOR.serialize' wit @@ -248,12 +256,62 @@ instance SerialiseAsCBOR (Witness ShelleyEra) where _ -> CBOR.cborError $ CBOR.DecoderErrorUnknownTag "Shelley Witness" (fromIntegral t) +instance SerialiseAsCBOR (Witness AllegraEra) where + serialiseToCBOR = CBOR.serializeEncoding' . encodeAllegraWitness + where + encodeAllegraWitness :: Witness AllegraEra -> CBOR.Encoding + encodeAllegraWitness (AllegraScriptwitness wit) = + CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> toCBOR wit + + deserialiseFromCBOR AsAllegraWitness bs = + CBOR.decodeAnnotator + "Allegra Witness" + decodeAllegraWitness (LBS.fromStrict bs) + where + decodeAllegraWitness + :: CBOR.Decoder s (CBOR.Annotator (Witness AllegraEra)) + decodeAllegraWitness = do + CBOR.decodeListLenOf 2 + t <- CBOR.decodeWord + case t of + 0 -> fmap (fmap AllegraScriptwitness) fromCBOR + _ -> CBOR.cborError $ CBOR.DecoderErrorUnknownTag + "Allegra Witness" (fromIntegral t) + +instance SerialiseAsCBOR (Witness MaryEra) where + serialiseToCBOR = CBOR.serializeEncoding' . encodeMaryWitness + where + encodeMaryWitness :: Witness MaryEra -> CBOR.Encoding + encodeMaryWitness (MaryScriptWitness wit) = + CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> toCBOR wit + + deserialiseFromCBOR AsMaryWitness bs = + CBOR.decodeAnnotator + "Mary Witness" + decodeMaryWitness (LBS.fromStrict bs) + where + decodeMaryWitness + :: CBOR.Decoder s (CBOR.Annotator (Witness MaryEra)) + decodeMaryWitness = do + CBOR.decodeListLenOf 2 + t <- CBOR.decodeWord + case t of + 0 -> fmap (fmap MaryScriptWitness) fromCBOR + _ -> CBOR.cborError $ CBOR.DecoderErrorUnknownTag + "Mary Witness" (fromIntegral t) + instance HasTextEnvelope (Witness ByronEra) where textEnvelopeType _ = "TxWitnessByron" instance HasTextEnvelope (Witness ShelleyEra) where textEnvelopeType _ = "TxWitnessShelley" +instance HasTextEnvelope (Witness AllegraEra) where + textEnvelopeType _ = "TxWitnessAllegra" + +instance HasTextEnvelope (Witness MaryEra) where + textEnvelopeType _ = "TxWitnessMary" + getTxBody :: Tx era -> TxBody era getTxBody (ByronTx Byron.ATxAux { Byron.aTaTx = txbody }) = @@ -576,4 +634,3 @@ signShelleyTransaction txbody sks = makeSignedTransaction witnesses txbody where witnesses = map (makeShelleyKeyWitness txbody) sks - diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index f31ede0271d..6291858420b 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -61,6 +61,7 @@ data ShelleyTxCmdError | ShelleyTxCmdTxSubmitErrorAllegra !(ApplyTxErr (ShelleyBlock StandardAllegra)) | ShelleyTxCmdTxSubmitErrorMary !(ApplyTxErr (ShelleyBlock StandardMary)) | ShelleyTxCmdTxSubmitErrorEraMismatch !EraMismatch + | ShelleyTxCmdWitnessCategorisationError !WitnessCategorisationError deriving Show renderShelleyTxCmdError :: ShelleyTxCmdError -> Text @@ -101,6 +102,8 @@ renderShelleyTxCmdError err = " era, but the transaction is for the " <> otherEraName <> " era." ShelleyTxCmdBootstrapWitnessError sbwErr -> renderShelleyBootstrapWitnessError sbwErr + ShelleyTxCmdWitnessCategorisationError wceErr -> + renderWitnessCategorisationError wceErr runTransactionCmd :: TransactionCmd -> ExceptT ShelleyTxCmdError IO () runTransactionCmd cmd = @@ -199,7 +202,10 @@ runTxSign useEra (TxBodyFile txbodyFile) witSigningData mnw (TxFile txFile) = do sks <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError $ mapM (readWitnessSigningData useEra) witSigningData - let (sksByron, sksShelley, scsShelley, _scWitAllegra, _scWitMary) = partitionSomeWitnesses $ map (categoriseSomeWitness UseShelleyEra) sks + (sksByron, sksShelley, scsShelley, _scWitAllegra, _scWitMary) <- + firstExceptT ShelleyTxCmdWitnessCategorisationError . hoistEither $ + partitionSomeWitnesses + <$> mapM (categoriseSomeWitness UseShelleyEra) sks withCardanoEra useEra $ \_era _eraStyle -> case useEra of @@ -337,6 +343,7 @@ data SomeWitness | AAllegraSimpleScript (Api.SimpleScript AllegraEra) | AMarySimpleScript (Api.SimpleScript MaryEra) | AShelleyMultiSigScript (Api.SimpleScript ShelleyEra) + deriving Show -- | Error deserialising a JSON-encoded script. newtype ScriptJsonDecodeError = ScriptJsonDecodeError String @@ -380,13 +387,13 @@ readWitnessSigningData useEra (ScriptWitnessSigningData (ScriptFile fp)) = do UseByronEra -> left $ ReadWitnessSigningDataNoByronScripts fp UseShelleyEra -> AShelleyMultiSigScript - <$> (firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) $ hoistEither $ decodeScript msJson) + <$> firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) (hoistEither $ decodeScript msJson) UseAllegraEra -> AAllegraSimpleScript - <$> (firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) $ hoistEither $ decodeScript msJson) + <$> firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) (hoistEither $ decodeScript msJson) UseMaryEra -> AMarySimpleScript - <$> (firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) $ hoistEither $ decodeScript msJson) + <$> firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) (hoistEither $ decodeScript msJson) where decodeScript :: HasScriptFeatures era => LBS.ByteString -> Either String (SimpleScript era) decodeScript bs = Aeson.eitherDecode bs @@ -478,60 +485,86 @@ data AnyEraWitness | AAllegraScriptWitness !(Api.SimpleScript AllegraEra) | AMaryScriptWitness !(Api.SimpleScript MaryEra) +-- | Witness categorisation error. +data WitnessCategorisationError + = InvalidWitnessForEra + -- ^ Witness is invalid for the specified era. + !SomeWitness + -- ^ Witness that is invalid for the specified era. + !UseCardanoEra + -- ^ Era for which the witness is invalid. + deriving Show + +-- | Render an error message for a 'WitnessCategorisationError'. +renderWitnessCategorisationError :: WitnessCategorisationError -> Text +renderWitnessCategorisationError err = + case err of + -- TODO: Render a proper error message. + InvalidWitnessForEra _ _ -> "Invalid witness provided for the specified era." -categoriseSomeWitness :: UseCardanoEra -> SomeWitness -> AnyEraWitness +-- | Categorise 'SomeWitness' for a specified era. +categoriseSomeWitness + :: UseCardanoEra + -> SomeWitness + -> Either WitnessCategorisationError AnyEraWitness categoriseSomeWitness useEra swsk = withCardanoEra useEra $ \_era _eraStyle -> - case useEra of - UseByronEra -> - case swsk of - AByronSigningKey sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) - _ -> panic "placeholder" - UseShelleyEra -> - case swsk of - AByronSigningKey sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) - APaymentSigningKey sk -> AShelleyKeyWitness (Api.WitnessPaymentKey sk) - APaymentExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessPaymentExtendedKey sk) - AStakeSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakeKey sk) - AStakeExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakeExtendedKey sk) - AStakePoolSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakePoolKey sk) - AGenesisSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisKey sk) - AGenesisExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisExtendedKey sk) - AGenesisDelegateSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisDelegateKey sk) - AGenesisDelegateExtendedSigningKey sk - -> AShelleyKeyWitness (Api.WitnessGenesisDelegateExtendedKey sk) - AGenesisUTxOSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisUTxOKey sk) - AShelleyMultiSigScript scr -> AShelleyScriptWitness scr - UseAllegraEra -> - case swsk of - AByronSigningKey sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) - APaymentSigningKey sk -> AShelleyKeyWitness (Api.WitnessPaymentKey sk) - APaymentExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessPaymentExtendedKey sk) - AStakeSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakeKey sk) - AStakeExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakeExtendedKey sk) - AStakePoolSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakePoolKey sk) - AGenesisSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisKey sk) - AGenesisExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisExtendedKey sk) - AGenesisDelegateSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisDelegateKey sk) - AGenesisDelegateExtendedSigningKey sk - -> AShelleyKeyWitness (Api.WitnessGenesisDelegateExtendedKey sk) - AGenesisUTxOSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisUTxOKey sk) - AAllegraSimpleScript scr -> AAllegraScriptWitness scr - UseMaryEra -> - case swsk of - AByronSigningKey sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) - APaymentSigningKey sk -> AShelleyKeyWitness (Api.WitnessPaymentKey sk) - APaymentExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessPaymentExtendedKey sk) - AStakeSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakeKey sk) - AStakeExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakeExtendedKey sk) - AStakePoolSigningKey sk -> AShelleyKeyWitness (Api.WitnessStakePoolKey sk) - AGenesisSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisKey sk) - AGenesisExtendedSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisExtendedKey sk) - AGenesisDelegateSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisDelegateKey sk) - AGenesisDelegateExtendedSigningKey sk - -> AShelleyKeyWitness (Api.WitnessGenesisDelegateExtendedKey sk) - AGenesisUTxOSigningKey sk -> AShelleyKeyWitness (Api.WitnessGenesisUTxOKey sk) - AMarySimpleScript scr -> AMaryScriptWitness scr + case useEra of + UseByronEra -> + case swsk of + AByronSigningKey sk addr -> Right $ AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) + _ -> Left (InvalidWitnessForEra swsk useEra) + UseShelleyEra -> + case swsk of + AByronSigningKey sk addr -> Right $ AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) + APaymentSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessPaymentKey sk) + APaymentExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessPaymentExtendedKey sk) + AStakeSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakeKey sk) + AStakeExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakeExtendedKey sk) + AStakePoolSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakePoolKey sk) + AGenesisSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisKey sk) + AGenesisExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisExtendedKey sk) + AGenesisDelegateSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisDelegateKey sk) + AGenesisDelegateExtendedSigningKey sk + -> Right $ AShelleyKeyWitness (Api.WitnessGenesisDelegateExtendedKey sk) + AGenesisUTxOSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisUTxOKey sk) + AShelleyMultiSigScript scr -> Right $ AShelleyScriptWitness scr + AAllegraSimpleScript _ -> Left (InvalidWitnessForEra swsk useEra) + AMarySimpleScript _ -> Left (InvalidWitnessForEra swsk useEra) + UseAllegraEra -> + case swsk of + AByronSigningKey sk addr -> Right $ AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) + APaymentSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessPaymentKey sk) + APaymentExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessPaymentExtendedKey sk) + AStakeSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakeKey sk) + AStakeExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakeExtendedKey sk) + AStakePoolSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakePoolKey sk) + AGenesisSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisKey sk) + AGenesisExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisExtendedKey sk) + AGenesisDelegateSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisDelegateKey sk) + AGenesisDelegateExtendedSigningKey sk + -> Right $ AShelleyKeyWitness (Api.WitnessGenesisDelegateExtendedKey sk) + AGenesisUTxOSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisUTxOKey sk) + AAllegraSimpleScript scr -> Right $ AAllegraScriptWitness scr + AShelleyMultiSigScript _ -> Left (InvalidWitnessForEra swsk useEra) + AMarySimpleScript _ -> Left (InvalidWitnessForEra swsk useEra) + UseMaryEra -> + case swsk of + AByronSigningKey sk addr -> Right $ AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) + APaymentSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessPaymentKey sk) + APaymentExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessPaymentExtendedKey sk) + AStakeSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakeKey sk) + AStakeExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakeExtendedKey sk) + AStakePoolSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessStakePoolKey sk) + AGenesisSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisKey sk) + AGenesisExtendedSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisExtendedKey sk) + AGenesisDelegateSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisDelegateKey sk) + AGenesisDelegateExtendedSigningKey sk + -> Right $ AShelleyKeyWitness (Api.WitnessGenesisDelegateExtendedKey sk) + AGenesisUTxOSigningKey sk -> Right $ AShelleyKeyWitness (Api.WitnessGenesisUTxOKey sk) + AMarySimpleScript scr -> Right $ AMaryScriptWitness scr + AShelleyMultiSigScript _ -> Left (InvalidWitnessForEra swsk useEra) + AAllegraSimpleScript _ -> Left (InvalidWitnessForEra swsk useEra) -- | Data required for constructing a Shelley bootstrap witness. data ShelleyBootstrapWitnessSigningKeyData @@ -605,29 +638,42 @@ runTxCreateWitness useEra (TxBodyFile txbodyFile) witSignData mbNw (OutputFile o someWit <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError $ readWitnessSigningData useEra witSignData - witness <- - case categoriseSomeWitness useEra someWit of - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - AByronWitness bootstrapWitData -> - firstExceptT ShelleyTxCmdBootstrapWitnessError - . hoistEither - $ mkShelleyBootstrapWitness mbNw txbody bootstrapWitData - AShelleyKeyWitness skShelley -> - pure $ makeShelleyKeyWitness txbody skShelley - AShelleyScriptWitness scShelley -> - pure $ makeScriptWitness (makeMultiSigScript scShelley) - - let writeWitness = firstExceptT ShelleyTxCmdWriteFileError - . newExceptT - $ Api.writeFileTextEnvelope oFile Nothing witness - - withCardanoEra useEra $ \_era _eraStyle -> - case useEra of - UseByronEra -> liftIO $ putTextLn "Not implemented yet" - UseShelleyEra -> writeWitness - UseAllegraEra -> writeWitness - UseMaryEra -> writeWitness + case categoriseSomeWitness useEra someWit of + -- Byron witnesses require the network ID. This can either be provided + -- directly or derived from a provided Byron address. + Right (AByronWitness bootstrapWitData) -> do + witness <- firstExceptT ShelleyTxCmdBootstrapWitnessError + . hoistEither + $ mkShelleyBootstrapWitness mbNw txbody bootstrapWitData + firstExceptT ShelleyTxCmdWriteFileError + . newExceptT + $ Api.writeFileTextEnvelope oFile Nothing witness + + Right (AShelleyKeyWitness skShelley) -> + firstExceptT ShelleyTxCmdWriteFileError + . newExceptT + . Api.writeFileTextEnvelope oFile Nothing + $ makeShelleyKeyWitness txbody skShelley + + Right (AShelleyScriptWitness scShelley) -> + firstExceptT ShelleyTxCmdWriteFileError + . newExceptT + . Api.writeFileTextEnvelope oFile Nothing + $ makeScriptWitness (makeMultiSigScript scShelley) + + Right (AAllegraScriptWitness scAllegra) -> + firstExceptT ShelleyTxCmdWriteFileError + . newExceptT + . Api.writeFileTextEnvelope oFile Nothing + $ makeScriptWitness (Api.SimpleScript scAllegra) + + Right (AMaryScriptWitness scMary) -> + firstExceptT ShelleyTxCmdWriteFileError + . newExceptT + . Api.writeFileTextEnvelope oFile Nothing + $ makeScriptWitness (Api.SimpleScript scMary) + + Left err -> left (ShelleyTxCmdWitnessCategorisationError err) runTxSignWitness :: TxBodyFile