{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Shelley.Run.Key
  ( ShelleyKeyCmdError
  , SomeSigningKey(..)
  , renderShelleyKeyCmdError
  , runKeyCmd

    -- * Exports for testing
  , decodeBech32
  ) where

import           Control.Exception (Exception (..), IOException)
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans.Except (ExceptT)
import           Data.Bifunctor (Bifunctor (..))
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           System.Exit (exitFailure)

import qualified Control.Exception as Exception
import           Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, left, newExceptT)

import qualified Codec.Binary.Bech32 as Bech32

import qualified Cardano.Crypto.DSIGN as DSIGN
import qualified Cardano.Crypto.Signing as Byron
import qualified Cardano.Crypto.Signing as Byron.Crypto
import qualified Cardano.Crypto.Signing as Crypto
import qualified Cardano.Crypto.Wallet as Crypto
import qualified Cardano.Ledger.Keys as Shelley

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.Shelley.Commands
import           Cardano.CLI.Shelley.Key (VerificationKeyTextOrFile (..),
                   VerificationKeyTextOrFileError, readVerificationKeyTextOrFileAnyOf,
                   renderVerificationKeyTextOrFileError)
import           Cardano.CLI.Types (SigningKeyFile (..), VerificationKeyFile (..))


data ShelleyKeyCmdError
  = ShelleyKeyCmdReadFileError !(FileError TextEnvelopeError)
  | ShelleyKeyCmdReadKeyFileError !(FileError InputDecodeError)
  | ShelleyKeyCmdWriteFileError !(FileError ())
  | ShelleyKeyCmdByronKeyFailure !Byron.ByronKeyFailure
  | ShelleyKeyCmdByronKeyParseError
      !Text
      -- ^ Text representation of the parse error. Unfortunately, the actual
      -- error type isn't exported.
  | ShelleyKeyCmdItnKeyConvError !ItnKeyConversionError
  | ShelleyKeyCmdWrongKeyTypeError
  | ShelleyKeyCmdCardanoAddressSigningKeyFileError
      !(FileError CardanoAddressSigningKeyConversionError)
  | ShelleyKeyCmdNonLegacyKey !FilePath
  | ShelleyKeyCmdExpectedExtendedVerificationKey SomeAddressVerificationKey
  | ShelleyKeyCmdVerificationKeyReadError VerificationKeyTextOrFileError
  deriving Int -> ShelleyKeyCmdError -> ShowS
[ShelleyKeyCmdError] -> ShowS
ShelleyKeyCmdError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyKeyCmdError] -> ShowS
$cshowList :: [ShelleyKeyCmdError] -> ShowS
show :: ShelleyKeyCmdError -> FilePath
$cshow :: ShelleyKeyCmdError -> FilePath
showsPrec :: Int -> ShelleyKeyCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyKeyCmdError -> ShowS
Show

renderShelleyKeyCmdError :: ShelleyKeyCmdError -> Text
renderShelleyKeyCmdError :: ShelleyKeyCmdError -> Text
renderShelleyKeyCmdError ShelleyKeyCmdError
err =
  case ShelleyKeyCmdError
err of
    ShelleyKeyCmdReadFileError FileError TextEnvelopeError
fileErr -> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError TextEnvelopeError
fileErr)
    ShelleyKeyCmdReadKeyFileError FileError InputDecodeError
fileErr -> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError InputDecodeError
fileErr)
    ShelleyKeyCmdWriteFileError FileError ()
fileErr -> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError ()
fileErr)
    ShelleyKeyCmdByronKeyFailure ByronKeyFailure
e -> ByronKeyFailure -> Text
Byron.renderByronKeyFailure ByronKeyFailure
e
    ShelleyKeyCmdByronKeyParseError Text
errTxt -> Text
errTxt
    ShelleyKeyCmdItnKeyConvError ItnKeyConversionError
convErr -> ItnKeyConversionError -> Text
renderConversionError ItnKeyConversionError
convErr
    ShelleyKeyCmdError
ShelleyKeyCmdWrongKeyTypeError ->
      FilePath -> Text
Text.pack FilePath
"Please use a signing key file when converting ITN BIP32 or Extended keys"
    ShelleyKeyCmdCardanoAddressSigningKeyFileError FileError CardanoAddressSigningKeyConversionError
fileErr ->
      FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError FileError CardanoAddressSigningKeyConversionError
fileErr)
    ShelleyKeyCmdNonLegacyKey FilePath
fp ->
      Text
"Signing key at: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
fp forall a. Semigroup a => a -> a -> a
<> Text
" is not a legacy Byron signing key and should not need to be converted."
    ShelleyKeyCmdVerificationKeyReadError VerificationKeyTextOrFileError
e -> VerificationKeyTextOrFileError -> Text
renderVerificationKeyTextOrFileError VerificationKeyTextOrFileError
e
    ShelleyKeyCmdExpectedExtendedVerificationKey SomeAddressVerificationKey
someVerKey ->
      Text
"Expected an extended verification key but got: " forall a. Semigroup a => a -> a -> a
<> SomeAddressVerificationKey -> Text
renderSomeAddressVerificationKey SomeAddressVerificationKey
someVerKey

runKeyCmd :: KeyCmd -> ExceptT ShelleyKeyCmdError IO ()
runKeyCmd :: KeyCmd -> ExceptT ShelleyKeyCmdError IO ()
runKeyCmd KeyCmd
cmd =
  case KeyCmd
cmd of
    KeyGetVerificationKey SigningKeyFile
skf VerificationKeyFile
vkf ->
      SigningKeyFile
-> VerificationKeyFile -> ExceptT ShelleyKeyCmdError IO ()
runGetVerificationKey SigningKeyFile
skf VerificationKeyFile
vkf

    KeyNonExtendedKey VerificationKeyFile
evkf VerificationKeyFile
vkf ->
      VerificationKeyFile
-> VerificationKeyFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertToNonExtendedKey VerificationKeyFile
evkf VerificationKeyFile
vkf

    KeyConvertByronKey Maybe Text
mPassword ByronKeyType
keytype SomeKeyFile
skfOld OutputFile
skfNew ->
      Maybe Text
-> ByronKeyType
-> SomeKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
runConvertByronKey Maybe Text
mPassword ByronKeyType
keytype SomeKeyFile
skfOld OutputFile
skfNew

    KeyConvertByronGenesisVKey VerificationKeyBase64
oldVk OutputFile
newVkf ->
      VerificationKeyBase64
-> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertByronGenesisVerificationKey VerificationKeyBase64
oldVk OutputFile
newVkf

    KeyConvertITNStakeKey SomeKeyFile
itnKeyFile OutputFile
outFile ->
      SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNStakeKey SomeKeyFile
itnKeyFile OutputFile
outFile
    KeyConvertITNExtendedToStakeKey SomeKeyFile
itnPrivKeyFile OutputFile
outFile ->
      SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNExtendedToStakeKey SomeKeyFile
itnPrivKeyFile OutputFile
outFile
    KeyConvertITNBip32ToStakeKey SomeKeyFile
itnPrivKeyFile OutputFile
outFile ->
      SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNBip32ToStakeKey SomeKeyFile
itnPrivKeyFile OutputFile
outFile

    KeyConvertCardanoAddressSigningKey CardanoAddressKeyType
keyType SigningKeyFile
skfOld OutputFile
skfNew ->
      CardanoAddressKeyType
-> SigningKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertCardanoAddressSigningKey CardanoAddressKeyType
keyType SigningKeyFile
skfOld OutputFile
skfNew

runGetVerificationKey :: SigningKeyFile
                      -> VerificationKeyFile
                      -> ExceptT ShelleyKeyCmdError IO ()
runGetVerificationKey :: SigningKeyFile
-> VerificationKeyFile -> ExceptT ShelleyKeyCmdError IO ()
runGetVerificationKey SigningKeyFile
skf (VerificationKeyFile FilePath
vkf) = do
    SomeSigningKey
ssk <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyKeyCmdError
ShelleyKeyCmdReadKeyFileError forall a b. (a -> b) -> a -> b
$
             SigningKeyFile
-> ExceptT (FileError InputDecodeError) IO SomeSigningKey
readSigningKeyFile SigningKeyFile
skf
    forall a.
SomeSigningKey
-> (forall keyrole. Key keyrole => SigningKey keyrole -> a) -> a
withSomeSigningKey SomeSigningKey
ssk forall a b. (a -> b) -> a -> b
$ \SigningKey keyrole
sk ->
      let vk :: VerificationKey keyrole
vk = forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey keyrole
sk in
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
        forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
vkf forall a. Maybe a
Nothing VerificationKey keyrole
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 => SigningKey keyrole -> a)
                   -> a
withSomeSigningKey :: forall a.
SomeSigningKey
-> (forall keyrole. Key keyrole => SigningKey keyrole -> a) -> a
withSomeSigningKey SomeSigningKey
ssk forall keyrole. Key keyrole => SigningKey keyrole -> a
f =
    case SomeSigningKey
ssk of
      AByronSigningKey           SigningKey ByronKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey ByronKey
sk
      APaymentSigningKey         SigningKey PaymentKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey PaymentKey
sk
      APaymentExtendedSigningKey SigningKey PaymentExtendedKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey PaymentExtendedKey
sk
      AStakeSigningKey           SigningKey StakeKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey StakeKey
sk
      AStakeExtendedSigningKey   SigningKey StakeExtendedKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey StakeExtendedKey
sk
      AStakePoolSigningKey       SigningKey StakePoolKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey StakePoolKey
sk
      AGenesisSigningKey         SigningKey GenesisKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey GenesisKey
sk
      AGenesisExtendedSigningKey SigningKey GenesisExtendedKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey GenesisExtendedKey
sk
      AGenesisDelegateSigningKey SigningKey GenesisDelegateKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey GenesisDelegateKey
sk
      AGenesisDelegateExtendedSigningKey
                                 SigningKey GenesisDelegateExtendedKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey GenesisDelegateExtendedKey
sk
      AGenesisUTxOSigningKey     SigningKey GenesisUTxOKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey GenesisUTxOKey
sk
      AVrfSigningKey             SigningKey VrfKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey VrfKey
sk
      AKesSigningKey             SigningKey KesKey
sk -> forall keyrole. Key keyrole => SigningKey keyrole -> a
f SigningKey KesKey
sk

readSigningKeyFile
  :: SigningKeyFile
  -> ExceptT (FileError InputDecodeError) IO SomeSigningKey
readSigningKeyFile :: SigningKeyFile
-> ExceptT (FileError InputDecodeError) IO SomeSigningKey
readSigningKeyFile (SigningKeyFile FilePath
skFile) =
    forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
      forall b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> FilePath
-> IO (Either (FileError InputDecodeError) b)
readKeyFileAnyOf [FromSomeType SerialiseAsBech32 SomeSigningKey]
bech32FileTypes [FromSomeType HasTextEnvelope SomeSigningKey]
textEnvFileTypes FilePath
skFile
  where
    textEnvFileTypes :: [FromSomeType HasTextEnvelope SomeSigningKey]
textEnvFileTypes =
      [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ByronKey
AsByronKey)
                      SigningKey ByronKey -> SomeSigningKey
AByronSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey)
                      SigningKey PaymentKey -> SomeSigningKey
APaymentSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey)
                      SigningKey PaymentExtendedKey -> SomeSigningKey
APaymentExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey)
                      SigningKey StakeKey -> SomeSigningKey
AStakeSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey)
                      SigningKey StakeExtendedKey -> SomeSigningKey
AStakeExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey)
                      SigningKey StakePoolKey -> SomeSigningKey
AStakePoolSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisKey
AsGenesisKey)
                      SigningKey GenesisKey -> SomeSigningKey
AGenesisSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisExtendedKey
AsGenesisExtendedKey)
                      SigningKey GenesisExtendedKey -> SomeSigningKey
AGenesisExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
                      SigningKey GenesisDelegateKey -> SomeSigningKey
AGenesisDelegateSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey)
                      SigningKey GenesisDelegateExtendedKey -> SomeSigningKey
AGenesisDelegateExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                      SigningKey GenesisUTxOKey -> SomeSigningKey
AGenesisUTxOSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VrfKey
AsVrfKey)
                      SigningKey VrfKey -> SomeSigningKey
AVrfSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType KesKey
AsKesKey)
                      SigningKey KesKey -> SomeSigningKey
AKesSigningKey
      ]

    bech32FileTypes :: [FromSomeType SerialiseAsBech32 SomeSigningKey]
bech32FileTypes =
      [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey)
                      SigningKey PaymentKey -> SomeSigningKey
APaymentSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey)
                      SigningKey PaymentExtendedKey -> SomeSigningKey
APaymentExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey)
                      SigningKey StakeKey -> SomeSigningKey
AStakeSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey)
                      SigningKey StakeExtendedKey -> SomeSigningKey
AStakeExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey)
                      SigningKey StakePoolKey -> SomeSigningKey
AStakePoolSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType VrfKey
AsVrfKey)
                      SigningKey VrfKey -> SomeSigningKey
AVrfSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType KesKey
AsKesKey)
                      SigningKey KesKey -> SomeSigningKey
AKesSigningKey
      ]


runConvertToNonExtendedKey
  :: VerificationKeyFile
  -> VerificationKeyFile
  -> ExceptT ShelleyKeyCmdError IO ()
runConvertToNonExtendedKey :: VerificationKeyFile
-> VerificationKeyFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertToNonExtendedKey VerificationKeyFile
evkf (VerificationKeyFile FilePath
vkf) =
  SomeAddressVerificationKey -> ExceptT ShelleyKeyCmdError IO ()
writeVerificationKey forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VerificationKeyFile
-> ExceptT ShelleyKeyCmdError IO SomeAddressVerificationKey
readExtendedVerificationKeyFile VerificationKeyFile
evkf
 where
  -- TODO: Expose a function specifically for this purpose
  -- and explain the extended verification keys can be converted
  -- to their non-extended counterparts however this is NOT the case
  -- for extended signing keys

  writeVerificationKey
    :: SomeAddressVerificationKey
    -> ExceptT ShelleyKeyCmdError IO ()
  writeVerificationKey :: SomeAddressVerificationKey -> ExceptT ShelleyKeyCmdError IO ()
writeVerificationKey SomeAddressVerificationKey
ssk =
    case SomeAddressVerificationKey
ssk of
      APaymentExtendedVerificationKey VerificationKey PaymentExtendedKey
vk ->
        forall keyrole.
Key keyrole =>
FilePath
-> VerificationKey keyrole -> ExceptT ShelleyKeyCmdError IO ()
writeToDisk FilePath
vkf (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey PaymentExtendedKey
vk :: VerificationKey PaymentKey)
      AStakeExtendedVerificationKey VerificationKey StakeExtendedKey
vk ->
        forall keyrole.
Key keyrole =>
FilePath
-> VerificationKey keyrole -> ExceptT ShelleyKeyCmdError IO ()
writeToDisk FilePath
vkf (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey StakeExtendedKey
vk :: VerificationKey StakeKey)
      AGenesisExtendedVerificationKey VerificationKey GenesisExtendedKey
vk ->
        forall keyrole.
Key keyrole =>
FilePath
-> VerificationKey keyrole -> ExceptT ShelleyKeyCmdError IO ()
writeToDisk FilePath
vkf (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisExtendedKey
vk :: VerificationKey GenesisKey)
      AGenesisDelegateExtendedVerificationKey VerificationKey GenesisDelegateExtendedKey
vk ->
        forall keyrole.
Key keyrole =>
FilePath
-> VerificationKey keyrole -> ExceptT ShelleyKeyCmdError IO ()
writeToDisk FilePath
vkf (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisDelegateExtendedKey
vk :: VerificationKey GenesisDelegateKey)
      SomeAddressVerificationKey
nonExtendedKey -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ SomeAddressVerificationKey -> ShelleyKeyCmdError
ShelleyKeyCmdExpectedExtendedVerificationKey SomeAddressVerificationKey
nonExtendedKey


  writeToDisk
   :: Key keyrole
   => FilePath -> VerificationKey keyrole -> ExceptT ShelleyKeyCmdError IO ()
  writeToDisk :: forall keyrole.
Key keyrole =>
FilePath
-> VerificationKey keyrole -> ExceptT ShelleyKeyCmdError IO ()
writeToDisk FilePath
vkf' VerificationKey keyrole
vk = forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
                          forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
vkf' forall a. Maybe a
Nothing VerificationKey keyrole
vk


readExtendedVerificationKeyFile
  :: VerificationKeyFile
  -> ExceptT ShelleyKeyCmdError IO SomeAddressVerificationKey
readExtendedVerificationKeyFile :: VerificationKeyFile
-> ExceptT ShelleyKeyCmdError IO SomeAddressVerificationKey
readExtendedVerificationKeyFile VerificationKeyFile
evkfile = do
  SomeAddressVerificationKey
vKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT VerificationKeyTextOrFileError -> ShelleyKeyCmdError
ShelleyKeyCmdVerificationKeyReadError
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ VerificationKeyTextOrFile
-> IO
     (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
readVerificationKeyTextOrFileAnyOf
                         forall a b. (a -> b) -> a -> b
$ VerificationKeyFile -> VerificationKeyTextOrFile
VktofVerificationKeyFile VerificationKeyFile
evkfile
  case SomeAddressVerificationKey
vKey of
      k :: SomeAddressVerificationKey
k@APaymentExtendedVerificationKey{} -> forall (m :: * -> *) a. Monad m => a -> m a
return SomeAddressVerificationKey
k
      k :: SomeAddressVerificationKey
k@AStakeExtendedVerificationKey{} -> forall (m :: * -> *) a. Monad m => a -> m a
return SomeAddressVerificationKey
k
      k :: SomeAddressVerificationKey
k@AGenesisExtendedVerificationKey{} -> forall (m :: * -> *) a. Monad m => a -> m a
return SomeAddressVerificationKey
k
      k :: SomeAddressVerificationKey
k@AGenesisDelegateExtendedVerificationKey{} -> forall (m :: * -> *) a. Monad m => a -> m a
return SomeAddressVerificationKey
k
      SomeAddressVerificationKey
nonExtendedKey ->
        forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ SomeAddressVerificationKey -> ShelleyKeyCmdError
ShelleyKeyCmdExpectedExtendedVerificationKey SomeAddressVerificationKey
nonExtendedKey


runConvertByronKey
  :: Maybe Text      -- ^ Password (if applicable)
  -> ByronKeyType
  -> SomeKeyFile     -- ^ Input file: old format
  -> OutputFile      -- ^ Output file: new format
  -> ExceptT ShelleyKeyCmdError IO ()
runConvertByronKey :: Maybe Text
-> ByronKeyType
-> SomeKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
runConvertByronKey Maybe Text
mPwd (ByronPaymentKey ByronKeyFormat
format) (ASigningKeyFile SigningKeyFile
skeyPathOld) =
    forall keyrole.
Key keyrole =>
Maybe Text
-> ByronKeyFormat
-> (SigningKey -> SigningKey keyrole)
-> SigningKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronSigningKey Maybe Text
mPwd ByronKeyFormat
format SigningKey -> SigningKey ByronKey
convert SigningKeyFile
skeyPathOld
  where
    convert :: Byron.SigningKey -> SigningKey ByronKey
    convert :: SigningKey -> SigningKey ByronKey
convert = SigningKey -> SigningKey ByronKey
ByronSigningKey

runConvertByronKey Maybe Text
mPwd (ByronGenesisKey ByronKeyFormat
format) (ASigningKeyFile SigningKeyFile
skeyPathOld) =
    forall keyrole.
Key keyrole =>
Maybe Text
-> ByronKeyFormat
-> (SigningKey -> SigningKey keyrole)
-> SigningKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronSigningKey Maybe Text
mPwd ByronKeyFormat
format SigningKey -> SigningKey GenesisExtendedKey
convert SigningKeyFile
skeyPathOld
  where
    convert :: Byron.SigningKey -> SigningKey GenesisExtendedKey
    convert :: SigningKey -> SigningKey GenesisExtendedKey
convert (Byron.SigningKey XPrv
xsk) = XPrv -> SigningKey GenesisExtendedKey
GenesisExtendedSigningKey XPrv
xsk

runConvertByronKey Maybe Text
mPwd (ByronDelegateKey ByronKeyFormat
format) (ASigningKeyFile SigningKeyFile
skeyPathOld) =
    forall keyrole.
Key keyrole =>
Maybe Text
-> ByronKeyFormat
-> (SigningKey -> SigningKey keyrole)
-> SigningKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronSigningKey Maybe Text
mPwd ByronKeyFormat
format SigningKey -> SigningKey GenesisDelegateExtendedKey
convert SigningKeyFile
skeyPathOld
  where
    convert :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey
    convert :: SigningKey -> SigningKey GenesisDelegateExtendedKey
convert (Byron.SigningKey XPrv
xsk) = XPrv -> SigningKey GenesisDelegateExtendedKey
GenesisDelegateExtendedSigningKey XPrv
xsk

runConvertByronKey Maybe Text
_ (ByronPaymentKey ByronKeyFormat
NonLegacyByronKeyFormat)
                     (AVerificationKeyFile VerificationKeyFile
vkeyPathOld) =
    forall keyrole.
Key keyrole =>
(VerificationKey -> VerificationKey keyrole)
-> VerificationKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronVerificationKey VerificationKey -> VerificationKey ByronKey
convert VerificationKeyFile
vkeyPathOld
  where
    convert :: Byron.VerificationKey -> VerificationKey ByronKey
    convert :: VerificationKey -> VerificationKey ByronKey
convert = VerificationKey -> VerificationKey ByronKey
ByronVerificationKey

runConvertByronKey Maybe Text
_ (ByronGenesisKey ByronKeyFormat
NonLegacyByronKeyFormat)
                     (AVerificationKeyFile VerificationKeyFile
vkeyPathOld) =
    forall keyrole.
Key keyrole =>
(VerificationKey -> VerificationKey keyrole)
-> VerificationKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronVerificationKey VerificationKey -> VerificationKey GenesisExtendedKey
convert VerificationKeyFile
vkeyPathOld
  where
    convert :: Byron.VerificationKey -> VerificationKey GenesisExtendedKey
    convert :: VerificationKey -> VerificationKey GenesisExtendedKey
convert (Byron.VerificationKey XPub
xvk) = XPub -> VerificationKey GenesisExtendedKey
GenesisExtendedVerificationKey XPub
xvk

runConvertByronKey Maybe Text
_ (ByronDelegateKey ByronKeyFormat
NonLegacyByronKeyFormat)
                     (AVerificationKeyFile VerificationKeyFile
vkeyPathOld) =
    forall keyrole.
Key keyrole =>
(VerificationKey -> VerificationKey keyrole)
-> VerificationKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronVerificationKey VerificationKey -> VerificationKey GenesisDelegateExtendedKey
convert VerificationKeyFile
vkeyPathOld
  where
    convert :: Byron.VerificationKey
            -> VerificationKey GenesisDelegateExtendedKey
    convert :: VerificationKey -> VerificationKey GenesisDelegateExtendedKey
convert (Byron.VerificationKey XPub
xvk) =
      XPub -> VerificationKey GenesisDelegateExtendedKey
GenesisDelegateExtendedVerificationKey XPub
xvk

runConvertByronKey Maybe Text
_ (ByronPaymentKey  ByronKeyFormat
LegacyByronKeyFormat)
                      AVerificationKeyFile{} =
    forall a b. a -> b -> a
const forall e a. ExceptT e IO a
legacyVerificationKeysNotSupported

runConvertByronKey Maybe Text
_ (ByronGenesisKey  ByronKeyFormat
LegacyByronKeyFormat)
                      AVerificationKeyFile{} =
    forall a b. a -> b -> a
const forall e a. ExceptT e IO a
legacyVerificationKeysNotSupported

runConvertByronKey Maybe Text
_ (ByronDelegateKey ByronKeyFormat
LegacyByronKeyFormat)
                      AVerificationKeyFile{} =
    forall a b. a -> b -> a
const forall e a. ExceptT e IO a
legacyVerificationKeysNotSupported

legacyVerificationKeysNotSupported :: ExceptT e IO a
legacyVerificationKeysNotSupported :: forall e a. ExceptT e IO a
legacyVerificationKeysNotSupported =
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath
"convert keys: byron legacy format not supported for "
              forall a. [a] -> [a] -> [a]
++ FilePath
"verification keys. Convert the signing key and then get the "
              forall a. [a] -> [a] -> [a]
++ FilePath
"verification key."
      forall a. IO a
exitFailure


convertByronSigningKey
  :: forall keyrole.
     Key keyrole
  => Maybe Text          -- ^ Password (if applicable)
  -> ByronKeyFormat
  -> (Byron.SigningKey -> SigningKey keyrole)
  -> SigningKeyFile      -- ^ Input file: old format
  -> OutputFile          -- ^ Output file: new format
  -> ExceptT ShelleyKeyCmdError IO ()
convertByronSigningKey :: forall keyrole.
Key keyrole =>
Maybe Text
-> ByronKeyFormat
-> (SigningKey -> SigningKey keyrole)
-> SigningKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronSigningKey Maybe Text
mPwd ByronKeyFormat
byronFormat SigningKey -> SigningKey keyrole
convert
                       SigningKeyFile
skeyPathOld
                       (OutputFile FilePath
skeyPathNew) = do


    SomeByronSigningKey
sKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronKeyFailure -> ShelleyKeyCmdError
ShelleyKeyCmdByronKeyFailure
              forall a b. (a -> b) -> a -> b
$ ByronKeyFormat
-> SigningKeyFile -> ExceptT ByronKeyFailure IO SomeByronSigningKey
Byron.readByronSigningKey ByronKeyFormat
byronFormat SigningKeyFile
skeyPathOld

    -- Account for password protected legacy Byron keys
    SigningKey
unprotectedSk <- case SomeByronSigningKey
sKey of
                       ByronApi.AByronSigningKeyLegacy (ByronSigningKeyLegacy sk :: SigningKey
sk@(Crypto.SigningKey XPrv
xprv)) ->
                         case Maybe Text
mPwd of
                           -- Change password to empty string
                           Just Text
pwd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey
Crypto.SigningKey
                                         forall a b. (a -> b) -> a -> b
$ forall oldPassPhrase newPassPhrase.
(ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
oldPassPhrase -> newPassPhrase -> XPrv -> XPrv
Crypto.xPrvChangePass (Text -> ByteString
Text.encodeUtf8 Text
pwd) (Text -> ByteString
Text.encodeUtf8 Text
"") XPrv
xprv
                           Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return SigningKey
sk
                       ByronApi.AByronSigningKey (ByronSigningKey SigningKey
sk) -> forall (m :: * -> *) a. Monad m => a -> m a
return SigningKey
sk


    let sk' :: SigningKey keyrole
        sk' :: SigningKey keyrole
sk' = SigningKey -> SigningKey keyrole
convert SigningKey
unprotectedSk

    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
      forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
skeyPathNew forall a. Maybe a
Nothing SigningKey keyrole
sk'

convertByronVerificationKey
  :: forall keyrole.
     Key keyrole
  => (Byron.VerificationKey -> VerificationKey keyrole)
  -> VerificationKeyFile -- ^ Input file: old format
  -> OutputFile          -- ^ Output file: new format
  -> ExceptT ShelleyKeyCmdError IO ()
convertByronVerificationKey :: forall keyrole.
Key keyrole =>
(VerificationKey -> VerificationKey keyrole)
-> VerificationKeyFile
-> OutputFile
-> ExceptT ShelleyKeyCmdError IO ()
convertByronVerificationKey VerificationKey -> VerificationKey keyrole
convert
                            (VerificationKeyFile FilePath
vkeyPathOld)
                            (OutputFile FilePath
vkeyPathNew) = do

    VerificationKey
vk <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronKeyFailure -> ShelleyKeyCmdError
ShelleyKeyCmdByronKeyFailure forall a b. (a -> b) -> a -> b
$
            VerificationKeyFile -> ExceptT ByronKeyFailure IO VerificationKey
Byron.readPaymentVerificationKey (FilePath -> VerificationKeyFile
Byron.VerificationKeyFile FilePath
vkeyPathOld)

    let vk' :: VerificationKey keyrole
        vk' :: VerificationKey keyrole
vk' = VerificationKey -> VerificationKey keyrole
convert VerificationKey
vk

    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
      forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
vkeyPathNew forall a. Maybe a
Nothing VerificationKey keyrole
vk'


runConvertByronGenesisVerificationKey
  :: VerificationKeyBase64  -- ^ Input key raw old format
  -> OutputFile             -- ^ Output file: new format
  -> ExceptT ShelleyKeyCmdError IO ()
runConvertByronGenesisVerificationKey :: VerificationKeyBase64
-> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertByronGenesisVerificationKey (VerificationKeyBase64 FilePath
b64ByronVKey)
                                      (OutputFile FilePath
vkeyPathNew) = do

    VerificationKey
vk <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (Text -> ShelleyKeyCmdError
ShelleyKeyCmdByronKeyParseError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
textShow)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either VerificationKeyParseError VerificationKey
Byron.Crypto.parseFullVerificationKey
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack
        forall a b. (a -> b) -> a -> b
$ FilePath
b64ByronVKey

    let vk' :: VerificationKey GenesisKey
        vk' :: VerificationKey GenesisKey
vk' = VerificationKey -> VerificationKey GenesisKey
convert VerificationKey
vk

    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
      forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
vkeyPathNew forall a. Maybe a
Nothing VerificationKey GenesisKey
vk'
  where
    convert :: Byron.VerificationKey -> VerificationKey GenesisKey
    convert :: VerificationKey -> VerificationKey GenesisKey
convert (Byron.VerificationKey XPub
xvk) =
      forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey (XPub -> VerificationKey GenesisExtendedKey
GenesisExtendedVerificationKey XPub
xvk)


--------------------------------------------------------------------------------
-- ITN verification/signing key conversion to Haskell verficiation/signing keys
--------------------------------------------------------------------------------

runConvertITNStakeKey
  :: SomeKeyFile
  -> OutputFile
  -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNStakeKey :: SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNStakeKey (AVerificationKeyFile (VerificationKeyFile FilePath
vk)) (OutputFile FilePath
outFile) = do
  Text
bech32publicKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
                     FilePath -> IO (Either ItnKeyConversionError Text)
readFileITNKey FilePath
vk
  VerificationKey StakeKey
vkey <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError
    forall a b. (a -> b) -> a -> b
$ Text -> Either ItnKeyConversionError (VerificationKey StakeKey)
convertITNVerificationKey Text
bech32publicKey
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
    forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outFile forall a. Maybe a
Nothing VerificationKey StakeKey
vkey

runConvertITNStakeKey (ASigningKeyFile (SigningKeyFile FilePath
sk)) (OutputFile FilePath
outFile) = do
  Text
bech32privateKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
                      FilePath -> IO (Either ItnKeyConversionError Text)
readFileITNKey FilePath
sk
  SigningKey StakeKey
skey <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError
    forall a b. (a -> b) -> a -> b
$ Text -> Either ItnKeyConversionError (SigningKey StakeKey)
convertITNSigningKey Text
bech32privateKey
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
    forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outFile forall a. Maybe a
Nothing SigningKey StakeKey
skey

runConvertITNExtendedToStakeKey :: SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNExtendedToStakeKey :: SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNExtendedToStakeKey (AVerificationKeyFile VerificationKeyFile
_) OutputFile
_ = forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyKeyCmdError
ShelleyKeyCmdWrongKeyTypeError
runConvertITNExtendedToStakeKey (ASigningKeyFile (SigningKeyFile FilePath
sk)) (OutputFile FilePath
outFile) = do
  Text
bech32privateKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either ItnKeyConversionError Text)
readFileITNKey FilePath
sk
  SigningKey StakeExtendedKey
skey <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError
            forall a b. (a -> b) -> a -> b
$ Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey)
convertITNExtendedSigningKey Text
bech32privateKey
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outFile forall a. Maybe a
Nothing SigningKey StakeExtendedKey
skey

runConvertITNBip32ToStakeKey :: SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNBip32ToStakeKey :: SomeKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertITNBip32ToStakeKey (AVerificationKeyFile VerificationKeyFile
_) OutputFile
_ = forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left ShelleyKeyCmdError
ShelleyKeyCmdWrongKeyTypeError
runConvertITNBip32ToStakeKey (ASigningKeyFile (SigningKeyFile FilePath
sk)) (OutputFile FilePath
outFile) = do
  Text
bech32privateKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either ItnKeyConversionError Text)
readFileITNKey FilePath
sk
  SigningKey StakeExtendedKey
skey <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ItnKeyConversionError -> ShelleyKeyCmdError
ShelleyKeyCmdItnKeyConvError
            forall a b. (a -> b) -> a -> b
$ Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey)
convertITNBIP32SigningKey Text
bech32privateKey
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outFile forall a. Maybe a
Nothing SigningKey StakeExtendedKey
skey

-- | An error that can occur while converting an Incentivized Testnet (ITN)
-- key.
data ItnKeyConversionError
  = ItnKeyBech32DecodeError !Bech32DecodeError
  | ItnReadBech32FileError !FilePath !IOException
  | ItnSigningKeyDeserialisationError !ByteString
  | ItnVerificationKeyDeserialisationError !ByteString
  deriving Int -> ItnKeyConversionError -> ShowS
[ItnKeyConversionError] -> ShowS
ItnKeyConversionError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ItnKeyConversionError] -> ShowS
$cshowList :: [ItnKeyConversionError] -> ShowS
show :: ItnKeyConversionError -> FilePath
$cshow :: ItnKeyConversionError -> FilePath
showsPrec :: Int -> ItnKeyConversionError -> ShowS
$cshowsPrec :: Int -> ItnKeyConversionError -> ShowS
Show

-- | Render an error message for an 'ItnKeyConversionError'.
renderConversionError :: ItnKeyConversionError -> Text
renderConversionError :: ItnKeyConversionError -> Text
renderConversionError ItnKeyConversionError
err =
  case ItnKeyConversionError
err of
    ItnKeyBech32DecodeError Bech32DecodeError
decErr ->
      Text
"Error decoding Bech32 key: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError Bech32DecodeError
decErr)
    ItnReadBech32FileError FilePath
fp IOException
readErr ->
      Text
"Error reading Bech32 key at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
fp
                        forall a. Semigroup a => a -> a -> a
<> Text
" Error: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (forall e. Exception e => e -> FilePath
displayException IOException
readErr)
    ItnSigningKeyDeserialisationError ByteString
_sKey ->
      -- Sensitive data, such as the signing key, is purposely not included in
      -- the error message.
      Text
"Error deserialising signing key."
    ItnVerificationKeyDeserialisationError ByteString
vKey ->
      Text
"Error deserialising verification key: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow (ByteString -> FilePath
BSC.unpack ByteString
vKey)

-- | Convert public ed25519 key to a Shelley stake verification key
convertITNVerificationKey :: Text -> Either ItnKeyConversionError (VerificationKey StakeKey)
convertITNVerificationKey :: Text -> Either ItnKeyConversionError (VerificationKey StakeKey)
convertITNVerificationKey Text
pubKey = do
  (HumanReadablePart
_, DataPart
_, ByteString
keyBS) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Bech32DecodeError -> ItnKeyConversionError
ItnKeyBech32DecodeError (Text
-> Either
     Bech32DecodeError (HumanReadablePart, DataPart, ByteString)
decodeBech32 Text
pubKey)
  case forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
DSIGN.rawDeserialiseVerKeyDSIGN ByteString
keyBS of
    Just VerKeyDSIGN Ed25519DSIGN
verKey -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey 'Staking StandardCrypto -> VerificationKey StakeKey
StakeVerificationKey forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole) crypto.
VerKeyDSIGN (DSIGN crypto) -> VKey kd crypto
Shelley.VKey VerKeyDSIGN Ed25519DSIGN
verKey
    Maybe (VerKeyDSIGN Ed25519DSIGN)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString -> ItnKeyConversionError
ItnVerificationKeyDeserialisationError ByteString
keyBS

-- | Convert private ed22519 key to a Shelley signing key.
convertITNSigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeKey)
convertITNSigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeKey)
convertITNSigningKey Text
privKey = do
  (HumanReadablePart
_, DataPart
_, ByteString
keyBS) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Bech32DecodeError -> ItnKeyConversionError
ItnKeyBech32DecodeError (Text
-> Either
     Bech32DecodeError (HumanReadablePart, DataPart, ByteString)
decodeBech32 Text
privKey)
  case forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
DSIGN.rawDeserialiseSignKeyDSIGN ByteString
keyBS of
    Just SignKeyDSIGN Ed25519DSIGN
signKey -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN StandardCrypto -> SigningKey StakeKey
StakeSigningKey SignKeyDSIGN Ed25519DSIGN
signKey
    Maybe (SignKeyDSIGN Ed25519DSIGN)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString -> ItnKeyConversionError
ItnSigningKeyDeserialisationError ByteString
keyBS

-- | Convert extended private ed22519 key to a Shelley signing key
-- Extended private key = 64 bytes,
-- Public key = 32 bytes.
convertITNExtendedSigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey)
convertITNExtendedSigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey)
convertITNExtendedSigningKey Text
privKey = do
  (HumanReadablePart
_, DataPart
_, ByteString
privkeyBS) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Bech32DecodeError -> ItnKeyConversionError
ItnKeyBech32DecodeError (Text
-> Either
     Bech32DecodeError (HumanReadablePart, DataPart, ByteString)
decodeBech32 Text
privKey)
  let dummyChainCode :: ByteString
dummyChainCode = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0
  case ByteString -> Maybe XPrv
xPrvFromBytes forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ByteString
privkeyBS, ByteString
dummyChainCode] of
    Just XPrv
xprv -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ XPrv -> SigningKey StakeExtendedKey
StakeExtendedSigningKey XPrv
xprv
    Maybe XPrv
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString -> ItnKeyConversionError
ItnSigningKeyDeserialisationError ByteString
privkeyBS

-- BIP32 Private key = 96 bytes (64 bytes extended private key + 32 bytes chaincode)
-- BIP32 Public Key = 64 Bytes
convertITNBIP32SigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey)
convertITNBIP32SigningKey :: Text -> Either ItnKeyConversionError (SigningKey StakeExtendedKey)
convertITNBIP32SigningKey Text
privKey = do
  (HumanReadablePart
_, DataPart
_, ByteString
privkeyBS) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Bech32DecodeError -> ItnKeyConversionError
ItnKeyBech32DecodeError (Text
-> Either
     Bech32DecodeError (HumanReadablePart, DataPart, ByteString)
decodeBech32 Text
privKey)
  case ByteString -> Maybe XPrv
xPrvFromBytes ByteString
privkeyBS of
    Just XPrv
xprv -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ XPrv -> SigningKey StakeExtendedKey
StakeExtendedSigningKey XPrv
xprv
    Maybe XPrv
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString -> ItnKeyConversionError
ItnSigningKeyDeserialisationError ByteString
privkeyBS

readFileITNKey :: FilePath -> IO (Either ItnKeyConversionError Text)
readFileITNKey :: FilePath -> IO (Either ItnKeyConversionError Text)
readFileITNKey FilePath
fp = do
  Either IOException FilePath
eStr <- forall e a. Exception e => IO a -> IO (Either e a)
Exception.try forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
fp
  case Either IOException FilePath
eStr of
    Left IOException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath -> IOException -> ItnKeyConversionError
ItnReadBech32FileError FilePath
fp IOException
e
    Right FilePath
str -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.concat forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.words forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
str

--------------------------------------------------------------------------------
-- `cardano-address` extended signing key conversions
--------------------------------------------------------------------------------

runConvertCardanoAddressSigningKey
  :: CardanoAddressKeyType
  -> SigningKeyFile
  -> OutputFile
  -> ExceptT ShelleyKeyCmdError IO ()
runConvertCardanoAddressSigningKey :: CardanoAddressKeyType
-> SigningKeyFile -> OutputFile -> ExceptT ShelleyKeyCmdError IO ()
runConvertCardanoAddressSigningKey CardanoAddressKeyType
keyType SigningKeyFile
skFile (OutputFile FilePath
outFile) = do
  SomeCardanoAddressSigningKey
sKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError CardanoAddressSigningKeyConversionError
-> ShelleyKeyCmdError
ShelleyKeyCmdCardanoAddressSigningKeyFileError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    forall a b. (a -> b) -> a -> b
$ CardanoAddressKeyType
-> SigningKeyFile
-> IO
     (Either
        (FileError CardanoAddressSigningKeyConversionError)
        SomeCardanoAddressSigningKey)
readSomeCardanoAddressSigningKeyFile CardanoAddressKeyType
keyType SigningKeyFile
skFile
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyKeyCmdError
ShelleyKeyCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    forall a b. (a -> b) -> a -> b
$ FilePath
-> SomeCardanoAddressSigningKey -> IO (Either (FileError ()) ())
writeSomeCardanoAddressSigningKeyFile FilePath
outFile SomeCardanoAddressSigningKey
sKey

-- | Some kind of signing key that was converted from a @cardano-address@
-- signing key.
data SomeCardanoAddressSigningKey
  = ACardanoAddrShelleyPaymentSigningKey !(SigningKey PaymentExtendedKey)
  | ACardanoAddrShelleyStakeSigningKey !(SigningKey StakeExtendedKey)
  | ACardanoAddrByronSigningKey !(SigningKey ByronKey)

-- | An error that can occur while converting a @cardano-address@ extended
-- signing key.
data CardanoAddressSigningKeyConversionError
  = CardanoAddressSigningKeyBech32DecodeError !Bech32DecodeError
  -- ^ There was an error in decoding the string as Bech32.
  | CardanoAddressSigningKeyDeserialisationError !ByteString
  -- ^ There was an error in converting the @cardano-address@ extended signing
  -- key.
  deriving (Int -> CardanoAddressSigningKeyConversionError -> ShowS
[CardanoAddressSigningKeyConversionError] -> ShowS
CardanoAddressSigningKeyConversionError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CardanoAddressSigningKeyConversionError] -> ShowS
$cshowList :: [CardanoAddressSigningKeyConversionError] -> ShowS
show :: CardanoAddressSigningKeyConversionError -> FilePath
$cshow :: CardanoAddressSigningKeyConversionError -> FilePath
showsPrec :: Int -> CardanoAddressSigningKeyConversionError -> ShowS
$cshowsPrec :: Int -> CardanoAddressSigningKeyConversionError -> ShowS
Show, CardanoAddressSigningKeyConversionError
-> CardanoAddressSigningKeyConversionError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CardanoAddressSigningKeyConversionError
-> CardanoAddressSigningKeyConversionError -> Bool
$c/= :: CardanoAddressSigningKeyConversionError
-> CardanoAddressSigningKeyConversionError -> Bool
== :: CardanoAddressSigningKeyConversionError
-> CardanoAddressSigningKeyConversionError -> Bool
$c== :: CardanoAddressSigningKeyConversionError
-> CardanoAddressSigningKeyConversionError -> Bool
Eq)

instance Error CardanoAddressSigningKeyConversionError where
  displayError :: CardanoAddressSigningKeyConversionError -> FilePath
displayError = Text -> FilePath
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoAddressSigningKeyConversionError -> Text
renderCardanoAddressSigningKeyConversionError

-- | Render an error message for a 'CardanoAddressSigningKeyConversionError'.
renderCardanoAddressSigningKeyConversionError
  :: CardanoAddressSigningKeyConversionError
  -> Text
renderCardanoAddressSigningKeyConversionError :: CardanoAddressSigningKeyConversionError -> Text
renderCardanoAddressSigningKeyConversionError CardanoAddressSigningKeyConversionError
err =
  case CardanoAddressSigningKeyConversionError
err of
    CardanoAddressSigningKeyBech32DecodeError Bech32DecodeError
decErr ->
      FilePath -> Text
Text.pack (forall e. Error e => e -> FilePath
displayError Bech32DecodeError
decErr)
    CardanoAddressSigningKeyDeserialisationError ByteString
_bs ->
      -- Sensitive data, such as the signing key, is purposely not included in
      -- the error message.
      Text
"Error deserialising cardano-address signing key."

-- | Decode a Bech32-encoded string.
decodeBech32
  :: Text
  -> Either Bech32DecodeError (Bech32.HumanReadablePart, Bech32.DataPart, ByteString)
decodeBech32 :: Text
-> Either
     Bech32DecodeError (HumanReadablePart, DataPart, ByteString)
decodeBech32 Text
bech32Str =
  case Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient Text
bech32Str of
    Left DecodingError
err -> forall a b. a -> Either a b
Left (DecodingError -> Bech32DecodeError
Bech32DecodingError DecodingError
err)
    Right (HumanReadablePart
hrPart, DataPart
dataPart) ->
      case DataPart -> Maybe ByteString
Bech32.dataPartToBytes DataPart
dataPart of
        Maybe ByteString
Nothing ->
          forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Bech32DecodeError
Bech32DataPartToBytesError (DataPart -> Text
Bech32.dataPartToText DataPart
dataPart)
        Just ByteString
bs -> forall a b. b -> Either a b
Right (HumanReadablePart
hrPart, DataPart
dataPart, ByteString
bs)

-- | Convert a Ed25519 BIP32 extended signing key (96 bytes) to a @cardano-crypto@
-- style extended signing key.
--
-- Note that both the ITN and @cardano-address@ use this key format.
convertBip32SigningKey
  :: ByteString
  -> Either CardanoAddressSigningKeyConversionError Crypto.XPrv
convertBip32SigningKey :: ByteString -> Either CardanoAddressSigningKeyConversionError XPrv
convertBip32SigningKey ByteString
signingKeyBs =
  case ByteString -> Maybe XPrv
xPrvFromBytes ByteString
signingKeyBs of
    Just XPrv
xPrv -> forall a b. b -> Either a b
Right XPrv
xPrv
    Maybe XPrv
Nothing ->
      forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString -> CardanoAddressSigningKeyConversionError
CardanoAddressSigningKeyDeserialisationError ByteString
signingKeyBs

-- | Read a file containing a Bech32-encoded Ed25519 BIP32 extended signing
-- key.
readBech32Bip32SigningKeyFile
  :: SigningKeyFile
  -> IO (Either (FileError CardanoAddressSigningKeyConversionError) Crypto.XPrv)
readBech32Bip32SigningKeyFile :: SigningKeyFile
-> IO
     (Either (FileError CardanoAddressSigningKeyConversionError) XPrv)
readBech32Bip32SigningKeyFile (SigningKeyFile FilePath
fp) = do
  Either IOException FilePath
eStr <- forall e a. Exception e => IO a -> IO (Either e a)
Exception.try forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
fp
  case Either IOException FilePath
eStr of
    Left IOException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall e. FilePath -> IOException -> FileError e
FileIOError FilePath
fp IOException
e
    Right FilePath
str ->
      case Text
-> Either
     Bech32DecodeError (HumanReadablePart, DataPart, ByteString)
decodeBech32 ([Text] -> Text
Text.concat forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.words forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
str) of
        Left Bech32DecodeError
err ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
            forall e. FilePath -> e -> FileError e
FileError FilePath
fp (Bech32DecodeError -> CardanoAddressSigningKeyConversionError
CardanoAddressSigningKeyBech32DecodeError Bech32DecodeError
err)
        Right (HumanReadablePart
_hrPart, DataPart
_dataPart, ByteString
bs) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall e. FilePath -> e -> FileError e
FileError FilePath
fp) (ByteString -> Either CardanoAddressSigningKeyConversionError XPrv
convertBip32SigningKey ByteString
bs)

-- | Read a file containing a Bech32-encoded @cardano-address@ extended
-- signing key.
readSomeCardanoAddressSigningKeyFile
  :: CardanoAddressKeyType
  -> SigningKeyFile
  -> IO (Either (FileError CardanoAddressSigningKeyConversionError) SomeCardanoAddressSigningKey)
readSomeCardanoAddressSigningKeyFile :: CardanoAddressKeyType
-> SigningKeyFile
-> IO
     (Either
        (FileError CardanoAddressSigningKeyConversionError)
        SomeCardanoAddressSigningKey)
readSomeCardanoAddressSigningKeyFile CardanoAddressKeyType
keyType SigningKeyFile
skFile = do
    Either (FileError CardanoAddressSigningKeyConversionError) XPrv
xPrv <- SigningKeyFile
-> IO
     (Either (FileError CardanoAddressSigningKeyConversionError) XPrv)
readBech32Bip32SigningKeyFile SigningKeyFile
skFile
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrv -> SomeCardanoAddressSigningKey
toSomeCardanoAddressSigningKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (FileError CardanoAddressSigningKeyConversionError) XPrv
xPrv)
  where
    toSomeCardanoAddressSigningKey :: Crypto.XPrv -> SomeCardanoAddressSigningKey
    toSomeCardanoAddressSigningKey :: XPrv -> SomeCardanoAddressSigningKey
toSomeCardanoAddressSigningKey XPrv
xPrv =
      case CardanoAddressKeyType
keyType of
        CardanoAddressKeyType
CardanoAddressShelleyPaymentKey ->
          SigningKey PaymentExtendedKey -> SomeCardanoAddressSigningKey
ACardanoAddrShelleyPaymentSigningKey
            (XPrv -> SigningKey PaymentExtendedKey
PaymentExtendedSigningKey XPrv
xPrv)
        CardanoAddressKeyType
CardanoAddressShelleyStakeKey ->
          SigningKey StakeExtendedKey -> SomeCardanoAddressSigningKey
ACardanoAddrShelleyStakeSigningKey (XPrv -> SigningKey StakeExtendedKey
StakeExtendedSigningKey XPrv
xPrv)
        CardanoAddressKeyType
CardanoAddressIcarusPaymentKey ->
          SigningKey ByronKey -> SomeCardanoAddressSigningKey
ACardanoAddrByronSigningKey forall a b. (a -> b) -> a -> b
$
            SigningKey -> SigningKey ByronKey
ByronSigningKey (XPrv -> SigningKey
Byron.SigningKey XPrv
xPrv)
        CardanoAddressKeyType
CardanoAddressByronPaymentKey ->
          SigningKey ByronKey -> SomeCardanoAddressSigningKey
ACardanoAddrByronSigningKey forall a b. (a -> b) -> a -> b
$
            SigningKey -> SigningKey ByronKey
ByronSigningKey (XPrv -> SigningKey
Byron.SigningKey XPrv
xPrv)

-- | Write a text envelope formatted file containing a @cardano-address@
-- extended signing key, but converted to a format supported by @cardano-cli@.
writeSomeCardanoAddressSigningKeyFile
  :: FilePath
  -> SomeCardanoAddressSigningKey
  -> IO (Either (FileError ()) ())
writeSomeCardanoAddressSigningKeyFile :: FilePath
-> SomeCardanoAddressSigningKey -> IO (Either (FileError ()) ())
writeSomeCardanoAddressSigningKeyFile FilePath
outFile SomeCardanoAddressSigningKey
skey =
  case SomeCardanoAddressSigningKey
skey of
    ACardanoAddrShelleyPaymentSigningKey SigningKey PaymentExtendedKey
sk ->
      forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outFile forall a. Maybe a
Nothing SigningKey PaymentExtendedKey
sk
    ACardanoAddrShelleyStakeSigningKey SigningKey StakeExtendedKey
sk ->
      forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outFile forall a. Maybe a
Nothing SigningKey StakeExtendedKey
sk
    ACardanoAddrByronSigningKey SigningKey ByronKey
sk ->
      forall a.
HasTextEnvelope a =>
FilePath
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope FilePath
outFile forall a. Maybe a
Nothing SigningKey ByronKey
sk