Skip to content

Commit

Permalink
WIP
Browse files Browse the repository at this point in the history
  • Loading branch information
@intricate
intricate committed Nov 24, 2020
1 parent 4313ce4 commit c54cbfd
Show file tree
Hide file tree
Showing 2 changed files with 182 additions and 79 deletions.
59 changes: 58 additions & 1 deletion cardano-api/src/Cardano/Api/Tx.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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 }) =
Expand Down Expand Up @@ -576,4 +634,3 @@ signShelleyTransaction txbody sks =
makeSignedTransaction witnesses txbody
where
witnesses = map (makeShelleyKeyWitness txbody) sks

202 changes: 124 additions & 78 deletions cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ data ShelleyTxCmdError
| ShelleyTxCmdTxSubmitErrorAllegra !(ApplyTxErr (ShelleyBlock StandardAllegra))
| ShelleyTxCmdTxSubmitErrorMary !(ApplyTxErr (ShelleyBlock StandardMary))
| ShelleyTxCmdTxSubmitErrorEraMismatch !EraMismatch
| ShelleyTxCmdWitnessCategorisationError !WitnessCategorisationError
deriving Show

renderShelleyTxCmdError :: ShelleyTxCmdError -> Text
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit c54cbfd

Please sign in to comment.