Skip to content

Commit

Permalink
Merge pull request #284 from input-output-hk/newhoggy/rename-SomeWitness
Browse files Browse the repository at this point in the history 
Rename `SomeWitness` to `SomeSigningWitness`.  Rename constructors to avoid name conflicts.
  • Loading branch information
@newhoggy
newhoggy authored Sep 18, 2023
2 parents 7926405 + 4093933 commit d634aaf
Show file tree
Hide file tree
Showing 4 changed files with 151 additions and 166 deletions.
91 changes: 0 additions & 91 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,6 @@ module Cardano.CLI.EraBased.Run.Key
import Cardano.Api
import qualified Cardano.Api.Byron as ByronApi
import Cardano.Api.Crypto.Ed25519Bip32 (xPrvFromBytes)
import Cardano.Api.Shelley

import qualified Cardano.CLI.Byron.Key as Byron
import Cardano.CLI.EraBased.Commands.Key
Expand Down Expand Up @@ -85,96 +84,6 @@ runGetVerificationKeyCmd skf vkf = do
firstExceptT KeyCmdWriteFileError . newExceptT $
writeLazyByteStringFile vkf $ textEnvelopeToJSON Nothing vk


data SomeSigningKey
= AByronSigningKey (SigningKey ByronKey)
| APaymentSigningKey (SigningKey PaymentKey)
| APaymentExtendedSigningKey (SigningKey PaymentExtendedKey)
| AStakeSigningKey (SigningKey StakeKey)
| AStakeExtendedSigningKey (SigningKey StakeExtendedKey)
| AStakePoolSigningKey (SigningKey StakePoolKey)
| AGenesisSigningKey (SigningKey GenesisKey)
| AGenesisExtendedSigningKey (SigningKey GenesisExtendedKey)
| AGenesisDelegateSigningKey (SigningKey GenesisDelegateKey)
| AGenesisDelegateExtendedSigningKey (SigningKey GenesisDelegateExtendedKey)
| AGenesisUTxOSigningKey (SigningKey GenesisUTxOKey)
| AVrfSigningKey (SigningKey VrfKey)
| AKesSigningKey (SigningKey KesKey)

withSomeSigningKey :: ()
=> SomeSigningKey
-> (forall keyrole. (Key keyrole, HasTypeProxy keyrole) => SigningKey keyrole -> a)
-> a
withSomeSigningKey ssk f =
case ssk of
AByronSigningKey sk -> f sk
APaymentSigningKey sk -> f sk
APaymentExtendedSigningKey sk -> f sk
AStakeSigningKey sk -> f sk
AStakeExtendedSigningKey sk -> f sk
AStakePoolSigningKey sk -> f sk
AGenesisSigningKey sk -> f sk
AGenesisExtendedSigningKey sk -> f sk
AGenesisDelegateSigningKey sk -> f sk
AGenesisDelegateExtendedSigningKey sk -> f sk
AGenesisUTxOSigningKey sk -> f sk
AVrfSigningKey sk -> f sk
AKesSigningKey sk -> f sk

readSigningKeyFile
:: SigningKeyFile In
-> ExceptT (FileError InputDecodeError) IO SomeSigningKey
readSigningKeyFile skFile =
newExceptT $
readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile
where
textEnvFileTypes =
[ FromSomeType (AsSigningKey AsByronKey)
AByronSigningKey
, FromSomeType (AsSigningKey AsPaymentKey)
APaymentSigningKey
, FromSomeType (AsSigningKey AsPaymentExtendedKey)
APaymentExtendedSigningKey
, FromSomeType (AsSigningKey AsStakeKey)
AStakeSigningKey
, FromSomeType (AsSigningKey AsStakeExtendedKey)
AStakeExtendedSigningKey
, FromSomeType (AsSigningKey AsStakePoolKey)
AStakePoolSigningKey
, FromSomeType (AsSigningKey AsGenesisKey)
AGenesisSigningKey
, FromSomeType (AsSigningKey AsGenesisExtendedKey)
AGenesisExtendedSigningKey
, FromSomeType (AsSigningKey AsGenesisDelegateKey)
AGenesisDelegateSigningKey
, FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey)
AGenesisDelegateExtendedSigningKey
, FromSomeType (AsSigningKey AsGenesisUTxOKey)
AGenesisUTxOSigningKey
, FromSomeType (AsSigningKey AsVrfKey)
AVrfSigningKey
, FromSomeType (AsSigningKey AsKesKey)
AKesSigningKey
]

bech32FileTypes =
[ FromSomeType (AsSigningKey AsPaymentKey)
APaymentSigningKey
, FromSomeType (AsSigningKey AsPaymentExtendedKey)
APaymentExtendedSigningKey
, FromSomeType (AsSigningKey AsStakeKey)
AStakeSigningKey
, FromSomeType (AsSigningKey AsStakeExtendedKey)
AStakeExtendedSigningKey
, FromSomeType (AsSigningKey AsStakePoolKey)
AStakePoolSigningKey
, FromSomeType (AsSigningKey AsVrfKey)
AVrfSigningKey
, FromSomeType (AsSigningKey AsKesKey)
AKesSigningKey
]


runConvertToNonExtendedKeyCmd
:: VerificationKeyFile In
-> VerificationKeyFile Out
Expand Down
6 changes: 3 additions & 3 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -888,7 +888,7 @@ runTxSignCmd :: ()
runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do
sks <- mapM (firstExceptT TxCmdReadWitnessSigningDataError . newExceptT . readWitnessSigningData) witSigningData

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

case txOrTxBody of
InputTxFile (File inputTxFilePath) -> do
Expand Down Expand Up @@ -1191,7 +1191,7 @@ runTxCreateWitnessCmd (File txbodyFilePath) witSignData mbNw oFile = do
someWit <- firstExceptT TxCmdReadWitnessSigningDataError
. newExceptT $ readWitnessSigningData witSignData
witness <-
case categoriseSomeWitness someWit of
case categoriseSomeSigningWitness someWit of
-- Byron witnesses require the network ID. This can either be provided
-- directly or derived from a provided Byron address.
AByronWitness bootstrapWitData ->
Expand All @@ -1212,7 +1212,7 @@ runTxCreateWitnessCmd (File txbodyFilePath) witSignData mbNw oFile = do
. newExceptT $ readWitnessSigningData witSignData

witness <-
case categoriseSomeWitness someWit of
case categoriseSomeSigningWitness 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
126 changes: 54 additions & 72 deletions cardano-cli/src/Cardano/CLI/Read.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ module Cardano.CLI.Read
-- * Tx witnesses
, ReadWitnessSigningDataError(..)
, renderReadWitnessSigningDataError
, SomeWitness(..)
, SomeSigningWitness(..)
, ByronOrShelleyWitness(..)
, ShelleyBootstrapWitnessSigningKeyData(..)
, CddlWitnessError(..)
Expand All @@ -49,7 +49,7 @@ module Cardano.CLI.Read

-- * Required signer
, RequiredSignerError(..)
, categoriseSomeWitness
, categoriseSomeSigningWitness
, readRequiredSigner

-- * Governance related
Expand Down Expand Up @@ -606,20 +606,19 @@ readCddlWitness fp = do

-- Witness handling

data SomeWitness
= AByronSigningKey (SigningKey ByronKey) (Maybe (Address ByronAddr))
| APaymentSigningKey (SigningKey PaymentKey)
| APaymentExtendedSigningKey (SigningKey PaymentExtendedKey)
| AStakeSigningKey (SigningKey StakeKey)
| AStakeExtendedSigningKey (SigningKey StakeExtendedKey)
| AStakePoolSigningKey (SigningKey StakePoolKey)
| AGenesisSigningKey (SigningKey GenesisKey)
| AGenesisExtendedSigningKey (SigningKey GenesisExtendedKey)
| AGenesisDelegateSigningKey (SigningKey GenesisDelegateKey)
| AGenesisDelegateExtendedSigningKey
(SigningKey GenesisDelegateExtendedKey)
| AGenesisUTxOSigningKey (SigningKey GenesisUTxOKey)
| ADRepSigningKey (SigningKey DRepKey)
data SomeSigningWitness
= AByronSigningWitness (SigningKey ByronKey) (Maybe (Address ByronAddr))
| APaymentSigningWitness (SigningKey PaymentKey)
| APaymentExtendedSigningWitness (SigningKey PaymentExtendedKey)
| AStakeSigningWitness (SigningKey StakeKey)
| AStakeExtendedSigningWitness (SigningKey StakeExtendedKey)
| AStakePoolSigningWitness (SigningKey StakePoolKey)
| AGenesisSigningWitness (SigningKey GenesisKey)
| AGenesisExtendedSigningWitness (SigningKey GenesisExtendedKey)
| AGenesisDelegateSigningWitness (SigningKey GenesisDelegateKey)
| AGenesisDelegateExtendedSigningWitness (SigningKey GenesisDelegateExtendedKey)
| AGenesisUTxOSigningWitness (SigningKey GenesisUTxOKey)
| ADRepSigningWitness (SigningKey DRepKey)


-- | Data required for constructing a Shelley bootstrap witness.
Expand All @@ -638,22 +637,21 @@ data ByronOrShelleyWitness
= AByronWitness !ShelleyBootstrapWitnessSigningKeyData
| AShelleyKeyWitness !ShelleyWitnessSigningKey

categoriseSomeWitness :: SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness swsk =
categoriseSomeSigningWitness :: SomeSigningWitness -> ByronOrShelleyWitness
categoriseSomeSigningWitness swsk =
case swsk of
AByronSigningKey sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr)
APaymentSigningKey sk -> AShelleyKeyWitness (WitnessPaymentKey sk)
APaymentExtendedSigningKey sk -> AShelleyKeyWitness (WitnessPaymentExtendedKey sk)
AStakeSigningKey sk -> AShelleyKeyWitness (WitnessStakeKey sk)
AStakeExtendedSigningKey sk -> AShelleyKeyWitness (WitnessStakeExtendedKey sk)
AStakePoolSigningKey sk -> AShelleyKeyWitness (WitnessStakePoolKey sk)
AGenesisSigningKey sk -> AShelleyKeyWitness (WitnessGenesisKey sk)
AGenesisExtendedSigningKey sk -> AShelleyKeyWitness (WitnessGenesisExtendedKey sk)
AGenesisDelegateSigningKey sk -> AShelleyKeyWitness (WitnessGenesisDelegateKey sk)
AGenesisDelegateExtendedSigningKey sk
-> AShelleyKeyWitness (WitnessGenesisDelegateExtendedKey sk)
AGenesisUTxOSigningKey sk -> AShelleyKeyWitness (WitnessGenesisUTxOKey sk)
ADRepSigningKey sk -> AShelleyKeyWitness (WitnessPaymentKey $ castDrep sk)
AByronSigningWitness sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr)
APaymentSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentKey sk)
APaymentExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentExtendedKey sk)
AStakeSigningWitness sk -> AShelleyKeyWitness (WitnessStakeKey sk)
AStakeExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessStakeExtendedKey sk)
AStakePoolSigningWitness sk -> AShelleyKeyWitness (WitnessStakePoolKey sk)
AGenesisSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisKey sk)
AGenesisExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisExtendedKey sk)
AGenesisDelegateSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisDelegateKey sk)
AGenesisDelegateExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisDelegateExtendedKey sk)
AGenesisUTxOSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisUTxOKey sk)
ADRepSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentKey $ castDrep sk)

-- TODO: Conway era - Add constrctor for SigningKey DrepKey to ShelleyWitnessSigningKey
castDrep :: SigningKey DRepKey -> SigningKey PaymentKey
Expand All @@ -679,57 +677,41 @@ renderReadWitnessSigningDataError err =

readWitnessSigningData
:: WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeWitness)
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
readWitnessSigningData (KeyWitnessSigningData skFile mbByronAddr) = do
eRes <- first ReadWitnessSigningDataSigningKeyDecodeError
<$> readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile
return $ do
res <- eRes
case (res, mbByronAddr) of
(AByronSigningKey _ _, Just _) -> pure res
(AByronSigningKey _ _, Nothing) -> pure res
(AByronSigningWitness _ _, Just _) -> pure res
(AByronSigningWitness _ _, Nothing) -> pure res
(_, Nothing) -> pure res
(_, Just _) ->
-- A Byron address should only be specified along with a Byron signing key.
Left ReadWitnessSigningDataSigningKeyAndAddressMismatch
where
textEnvFileTypes =
[ FromSomeType (AsSigningKey AsByronKey)
(`AByronSigningKey` mbByronAddr)
, FromSomeType (AsSigningKey AsPaymentKey)
APaymentSigningKey
, FromSomeType (AsSigningKey AsPaymentExtendedKey)
APaymentExtendedSigningKey
, FromSomeType (AsSigningKey AsStakeKey)
AStakeSigningKey
, FromSomeType (AsSigningKey AsStakeExtendedKey)
AStakeExtendedSigningKey
, FromSomeType (AsSigningKey AsStakePoolKey)
AStakePoolSigningKey
, FromSomeType (AsSigningKey AsGenesisKey)
AGenesisSigningKey
, FromSomeType (AsSigningKey AsGenesisExtendedKey)
AGenesisExtendedSigningKey
, FromSomeType (AsSigningKey AsGenesisDelegateKey)
AGenesisDelegateSigningKey
, FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey)
AGenesisDelegateExtendedSigningKey
, FromSomeType (AsSigningKey AsGenesisUTxOKey)
AGenesisUTxOSigningKey
, FromSomeType (AsSigningKey AsDRepKey) ADRepSigningKey
[ FromSomeType (AsSigningKey AsByronKey ) (`AByronSigningWitness` mbByronAddr)
, FromSomeType (AsSigningKey AsPaymentKey ) APaymentSigningWitness
, FromSomeType (AsSigningKey AsPaymentExtendedKey ) APaymentExtendedSigningWitness
, FromSomeType (AsSigningKey AsStakeKey ) AStakeSigningWitness
, FromSomeType (AsSigningKey AsStakeExtendedKey ) AStakeExtendedSigningWitness
, FromSomeType (AsSigningKey AsStakePoolKey ) AStakePoolSigningWitness
, FromSomeType (AsSigningKey AsGenesisKey ) AGenesisSigningWitness
, FromSomeType (AsSigningKey AsGenesisExtendedKey ) AGenesisExtendedSigningWitness
, FromSomeType (AsSigningKey AsGenesisDelegateKey ) AGenesisDelegateSigningWitness
, FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey ) AGenesisDelegateExtendedSigningWitness
, FromSomeType (AsSigningKey AsGenesisUTxOKey ) AGenesisUTxOSigningWitness
, FromSomeType (AsSigningKey AsDRepKey ) ADRepSigningWitness
]

bech32FileTypes =
[ FromSomeType (AsSigningKey AsPaymentKey)
APaymentSigningKey
, FromSomeType (AsSigningKey AsPaymentExtendedKey)
APaymentExtendedSigningKey
, FromSomeType (AsSigningKey AsStakeKey)
AStakeSigningKey
, FromSomeType (AsSigningKey AsStakeExtendedKey)
AStakeExtendedSigningKey
, FromSomeType (AsSigningKey AsStakePoolKey)
AStakePoolSigningKey
[ FromSomeType (AsSigningKey AsPaymentKey ) APaymentSigningWitness
, FromSomeType (AsSigningKey AsPaymentExtendedKey ) APaymentExtendedSigningWitness
, FromSomeType (AsSigningKey AsStakeKey ) AStakeSigningWitness
, FromSomeType (AsSigningKey AsStakeExtendedKey ) AStakeExtendedSigningWitness
, FromSomeType (AsSigningKey AsStakePoolKey ) AStakePoolSigningWitness
]

-- Required signers
Expand All @@ -750,17 +732,17 @@ readRequiredSigner (RequiredSignerSkeyFile skFile) = do
eKeyWit <- first RequiredSignerErrorFile <$> readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile
return $ do
keyWit <- eKeyWit
case categoriseSomeWitness keyWit of
case categoriseSomeSigningWitness keyWit of
AByronWitness _ ->
Left $ RequiredSignerErrorByronKey skFile
AShelleyKeyWitness skey ->
return . getHash $ toShelleySigningKey skey
where
textEnvFileTypes =
[ FromSomeType (AsSigningKey AsPaymentKey) APaymentSigningKey
, FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningKey
, FromSomeType (AsSigningKey AsStakePoolKey) AStakePoolSigningKey
, FromSomeType (AsSigningKey AsGenesisDelegateKey) AGenesisDelegateSigningKey
[ FromSomeType (AsSigningKey AsPaymentKey ) APaymentSigningWitness
, FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningWitness
, FromSomeType (AsSigningKey AsStakePoolKey ) AStakePoolSigningWitness
, FromSomeType (AsSigningKey AsGenesisDelegateKey) AGenesisDelegateSigningWitness
]
bech32FileTypes = []

Expand Down
Loading

0 comments on commit d634aaf

Please sign in to comment.