Skip to content

Commit

Permalink
Update cardano-cli tx sign with withCardanoEra
Browse files Browse the repository at this point in the history
  • Loading branch information
@Jimbo4350 @intricate
Jimbo4350 authored and intricate committed Nov 23, 2020
1 parent d666c2b commit cf35676
Showing 1 changed file with 117 additions and 55 deletions.
172 changes: 117 additions & 55 deletions cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

Expand Down Expand Up @@ -196,30 +197,29 @@ runTxSign useEra (TxBodyFile txbodyFile) witSigningData mnw (TxFile txFile) = do
txbody <- firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $
Api.readFileTextEnvelope Api.AsShelleyTxBody txbodyFile
sks <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError $
mapM readWitnessSigningData witSigningData
mapM (readWitnessSigningData useEra) witSigningData

let (sksByron, sksShelley, scsShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks

-- Byron witnesses require the network ID. This can either be provided
-- directly or derived from a provided Byron address.
byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError
. hoistEither
$ mkShelleyBootstrapWitnesses mnw txbody sksByron

let shelleyKeyWitnesses = map (Api.makeShelleyKeyWitness txbody) sksShelley
shelleyScriptWitnesses = map (makeScriptWitness . makeMultiSigScript) scsShelley
shelleyWitnesses = shelleyKeyWitnesses ++ shelleyScriptWitnesses
tx = Api.makeSignedTransaction (byronWitnesses ++ shelleyWitnesses) txbody

writeTx = firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
Api.writeFileTextEnvelope txFile Nothing tx
let (sksByron, sksShelley, scsShelley, _scWitAllegra, _scWitMary) = partitionSomeWitnesses $ map (categoriseSomeWitness UseShelleyEra) sks

withCardanoEra useEra $ \_era _eraStyle ->
case useEra of
UseByronEra -> liftIO $ putTextLn "Not implemented yet"
UseShelleyEra -> writeTx
UseAllegraEra -> writeTx
UseMaryEra -> writeTx
UseShelleyEra -> do

-- Byron witnesses require the network ID. This can either be provided
-- directly or derived from a provided Byron address.
byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError
. hoistEither
$ mkShelleyBootstrapWitnesses mnw txbody sksByron
let shelleyKeyWitnesses = map (Api.makeShelleyKeyWitness txbody) sksShelley
shelleyScriptWitnesses = map (makeScriptWitness . makeMultiSigScript) scsShelley
shelleyWitnesses = shelleyKeyWitnesses ++ shelleyScriptWitnesses
tx = Api.makeSignedTransaction (byronWitnesses ++ shelleyWitnesses) txbody

firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
Api.writeFileTextEnvelope txFile Nothing tx
UseAllegraEra -> liftIO $ putTextLn "Not implemented yet"
UseMaryEra -> liftIO $ putTextLn "Not implemented yet"


runTxSubmit :: Protocol -> NetworkId -> FilePath
Expand Down Expand Up @@ -334,7 +334,9 @@ data SomeWitness
| AGenesisDelegateExtendedSigningKey
(Api.SigningKey Api.GenesisDelegateExtendedKey)
| AGenesisUTxOSigningKey (Api.SigningKey Api.GenesisUTxOKey)
| AShelleyMultiSigScript (Api.MultiSigScript ShelleyEra)
| AAllegraSimpleScript (Api.SimpleScript AllegraEra)
| AMarySimpleScript (Api.SimpleScript MaryEra)
| AShelleyMultiSigScript (Api.SimpleScript ShelleyEra)

-- | Error deserialising a JSON-encoded script.
newtype ScriptJsonDecodeError = ScriptJsonDecodeError String
Expand All @@ -349,6 +351,8 @@ data ReadWitnessSigningDataError
| ReadWitnessSigningDataScriptError !(FileError ScriptJsonDecodeError)
| ReadWitnessSigningDataSigningKeyAndAddressMismatch
-- ^ A Byron address was specified alongside a non-Byron signing key.
| ReadWitnessSigningDataNoByronScripts !FilePath
-- ^ A Byron script was specified (there are no scripts in the Byron era)
deriving Show

-- | Render an error message for a 'ReadWitnessSigningDataError'.
Expand All @@ -361,20 +365,33 @@ renderReadWitnessSigningDataError err =
"Error reading script: " <> Text.pack (displayError fileErr)
ReadWitnessSigningDataSigningKeyAndAddressMismatch ->
"Only a Byron signing key may be accompanied by a Byron address."
ReadWitnessSigningDataNoByronScripts fp ->
"Scripts do not exist in the Byron era: " <> Text.pack fp

readWitnessSigningData
:: WitnessSigningData
:: UseCardanoEra
-> WitnessSigningData
-> ExceptT ReadWitnessSigningDataError IO SomeWitness
readWitnessSigningData (ScriptWitnessSigningData (ScriptFile fp)) = do
readWitnessSigningData useEra (ScriptWitnessSigningData (ScriptFile fp)) = do
msJson <- handleIOExceptT (ReadWitnessSigningDataScriptError . FileIOError fp)
$ LBS.readFile fp

hoistEither $ bimap
(ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError)
AShelleyMultiSigScript
(Aeson.eitherDecode' msJson)

readWitnessSigningData (KeyWitnessSigningData skFile mbByronAddr) = do
withCardanoEra useEra $ \_era _eraStyle ->
case useEra of
UseByronEra -> left $ ReadWitnessSigningDataNoByronScripts fp
UseShelleyEra ->
AShelleyMultiSigScript
<$> (firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) $ hoistEither $ decodeScript msJson)
UseAllegraEra ->
AAllegraSimpleScript
<$> (firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) $ hoistEither $ decodeScript msJson)
UseMaryEra ->
AMarySimpleScript
<$> (firstExceptT (ReadWitnessSigningDataScriptError . FileError fp . ScriptJsonDecodeError) $ hoistEither $ decodeScript msJson)
where
decodeScript :: HasScriptFeatures era => LBS.ByteString -> Either String (SimpleScript era)
decodeScript bs = Aeson.eitherDecode bs

readWitnessSigningData _ (KeyWitnessSigningData skFile mbByronAddr) = do
res <- firstExceptT ReadWitnessSigningDataSigningKeyDecodeError
. newExceptT
$ readSigningKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile
Expand Down Expand Up @@ -427,48 +444,93 @@ readWitnessSigningData (KeyWitnessSigningData skFile mbByronAddr) = do
]

partitionSomeWitnesses
:: [ByronOrShelleyWitness]
:: [AnyEraWitness]
-> ( [ShelleyBootstrapWitnessSigningKeyData]
, [Api.ShelleyWitnessSigningKey]
, [Api.MultiSigScript ShelleyEra]
, [Api.SimpleScript AllegraEra]
, [Api.SimpleScript MaryEra]
)
partitionSomeWitnesses = reversePartitionedWits . foldl' go mempty
where
reversePartitionedWits (bw, skw, ssw) =
(reverse bw, reverse skw, reverse ssw)
reversePartitionedWits (bw, skw, ssw, asw, msw) =
(reverse bw, reverse skw, reverse ssw, reverse asw, reverse msw)

go (byronAcc, shelleyKeyAcc, shelleyScriptAcc) byronOrShelleyWit =
go (byronAcc, shelleyKeyAcc, shelleyScriptAcc, allegraScriptAcc, maryScriptAcc) byronOrShelleyWit =
case byronOrShelleyWit of
AByronWitness byronWit ->
(byronWit:byronAcc, shelleyKeyAcc, shelleyScriptAcc)
(byronWit:byronAcc, shelleyKeyAcc, shelleyScriptAcc, allegraScriptAcc, maryScriptAcc)
AShelleyKeyWitness shelleyKeyWit ->
(byronAcc, shelleyKeyWit:shelleyKeyAcc, shelleyScriptAcc)
(byronAcc, shelleyKeyWit:shelleyKeyAcc, shelleyScriptAcc, allegraScriptAcc, maryScriptAcc)
AShelleyScriptWitness shelleyScriptWit ->
(byronAcc, shelleyKeyAcc, shelleyScriptWit:shelleyScriptAcc)
(byronAcc, shelleyKeyAcc, shelleyScriptWit:shelleyScriptAcc, allegraScriptAcc, maryScriptAcc)
AAllegraScriptWitness allegraScriptWit ->
(byronAcc, shelleyKeyAcc, shelleyScriptAcc, allegraScriptWit : allegraScriptAcc, maryScriptAcc)
AMaryScriptWitness maryScriptWit ->
(byronAcc, shelleyKeyAcc, shelleyScriptAcc,allegraScriptAcc , maryScriptWit : maryScriptAcc)


-- | Some kind of Byron or Shelley witness.
data ByronOrShelleyWitness
data AnyEraWitness
= AByronWitness !ShelleyBootstrapWitnessSigningKeyData
| AShelleyKeyWitness !Api.ShelleyWitnessSigningKey
| AShelleyScriptWitness !(Api.MultiSigScript ShelleyEra)
| AAllegraScriptWitness !(Api.SimpleScript AllegraEra)
| AMaryScriptWitness !(Api.SimpleScript MaryEra)


categoriseSomeWitness :: SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness swsk =
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
categoriseSomeWitness :: UseCardanoEra -> SomeWitness -> 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

-- | Data required for constructing a Shelley bootstrap witness.
data ShelleyBootstrapWitnessSigningKeyData
Expand Down Expand Up @@ -540,10 +602,10 @@ runTxCreateWitness useEra (TxBodyFile txbodyFile) witSignData mbNw (OutputFile o
. newExceptT
$ Api.readFileTextEnvelope Api.AsShelleyTxBody txbodyFile
someWit <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError
$ readWitnessSigningData witSignData
$ readWitnessSigningData useEra witSignData

witness <-
case categoriseSomeWitness someWit of
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 ->
Expand Down

0 comments on commit cf35676

Please sign in to comment.