{-# LANGUAGE GeneralisedNewtypeDeriving #-}

module Cardano.CLI.Byron.Key
  ( -- * Keys
    ByronKeyFailure(..)
  , NewSigningKeyFile(..)
  , NewVerificationKeyFile(..)
  , VerificationKeyFile(..)
  , prettyPublicKey
  , readByronSigningKey
  , readPaymentVerificationKey
  , renderByronKeyFailure
  , byronWitnessToVerKey
  )
where

import           Control.Exception (Exception (..))
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left,
                   right)
import qualified Data.ByteString as SB
import qualified Data.ByteString.UTF8 as UTF8
import           Data.String (IsString, fromString)
import           Data.Text (Text)
import qualified Data.Text as T
import           Formatting (build, sformat, (%))

import           Cardano.Api.Byron

import qualified Cardano.Chain.Common as Common
import           Cardano.CLI.Shelley.Commands (ByronKeyFormat (..))
import           Cardano.CLI.Types
import qualified Cardano.Crypto.Signing as Crypto


data ByronKeyFailure
  = ReadSigningKeyFailure !FilePath !Text
  | ReadVerificationKeyFailure !FilePath !Text
  | LegacySigningKeyDeserialisationFailed !FilePath
  | SigningKeyDeserialisationFailed !FilePath
  | VerificationKeyDeserialisationFailed !FilePath !Text
  | CannotMigrateFromNonLegacySigningKey !FilePath
  deriving Int -> ByronKeyFailure -> ShowS
[ByronKeyFailure] -> ShowS
ByronKeyFailure -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ByronKeyFailure] -> ShowS
$cshowList :: [ByronKeyFailure] -> ShowS
show :: ByronKeyFailure -> FilePath
$cshow :: ByronKeyFailure -> FilePath
showsPrec :: Int -> ByronKeyFailure -> ShowS
$cshowsPrec :: Int -> ByronKeyFailure -> ShowS
Show

renderByronKeyFailure :: ByronKeyFailure -> Text
renderByronKeyFailure :: ByronKeyFailure -> Text
renderByronKeyFailure ByronKeyFailure
err =
  case ByronKeyFailure
err of
    CannotMigrateFromNonLegacySigningKey FilePath
fp ->
      Text
"Migrate from non-legacy Byron key unnecessary: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
fp
    ReadSigningKeyFailure FilePath
sKeyFp Text
readErr ->
      Text
"Error reading signing key at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
sKeyFp forall a. Semigroup a => a -> a -> a
<> Text
" Error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Text
readErr
    ReadVerificationKeyFailure FilePath
vKeyFp Text
readErr ->
      Text
"Error reading verification key at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
vKeyFp forall a. Semigroup a => a -> a -> a
<> Text
" Error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Text
readErr
    LegacySigningKeyDeserialisationFailed FilePath
fp ->
      Text
"Error attempting to deserialise a legacy signing key at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
fp
    SigningKeyDeserialisationFailed FilePath
sKeyFp  ->
      Text
"Error deserialising signing key at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
sKeyFp
    VerificationKeyDeserialisationFailed FilePath
vKeyFp Text
deSerError ->
      Text
"Error deserialising verification key at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow FilePath
vKeyFp forall a. Semigroup a => a -> a -> a
<> Text
" Error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
textShow Text
deSerError

newtype NewSigningKeyFile =
  NewSigningKeyFile FilePath
  deriving (NewSigningKeyFile -> NewSigningKeyFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
$c/= :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
== :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
$c== :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
Eq, Eq NewSigningKeyFile
NewSigningKeyFile -> NewSigningKeyFile -> Bool
NewSigningKeyFile -> NewSigningKeyFile -> Ordering
NewSigningKeyFile -> NewSigningKeyFile -> NewSigningKeyFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NewSigningKeyFile -> NewSigningKeyFile -> NewSigningKeyFile
$cmin :: NewSigningKeyFile -> NewSigningKeyFile -> NewSigningKeyFile
max :: NewSigningKeyFile -> NewSigningKeyFile -> NewSigningKeyFile
$cmax :: NewSigningKeyFile -> NewSigningKeyFile -> NewSigningKeyFile
>= :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
$c>= :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
> :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
$c> :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
<= :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
$c<= :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
< :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
$c< :: NewSigningKeyFile -> NewSigningKeyFile -> Bool
compare :: NewSigningKeyFile -> NewSigningKeyFile -> Ordering
$ccompare :: NewSigningKeyFile -> NewSigningKeyFile -> Ordering
Ord, Int -> NewSigningKeyFile -> ShowS
[NewSigningKeyFile] -> ShowS
NewSigningKeyFile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewSigningKeyFile] -> ShowS
$cshowList :: [NewSigningKeyFile] -> ShowS
show :: NewSigningKeyFile -> FilePath
$cshow :: NewSigningKeyFile -> FilePath
showsPrec :: Int -> NewSigningKeyFile -> ShowS
$cshowsPrec :: Int -> NewSigningKeyFile -> ShowS
Show, FilePath -> NewSigningKeyFile
forall a. (FilePath -> a) -> IsString a
fromString :: FilePath -> NewSigningKeyFile
$cfromString :: FilePath -> NewSigningKeyFile
IsString)

newtype NewVerificationKeyFile =
  NewVerificationKeyFile FilePath
   deriving (NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
$c/= :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
== :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
$c== :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
Eq, Eq NewVerificationKeyFile
NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
NewVerificationKeyFile -> NewVerificationKeyFile -> Ordering
NewVerificationKeyFile
-> NewVerificationKeyFile -> NewVerificationKeyFile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NewVerificationKeyFile
-> NewVerificationKeyFile -> NewVerificationKeyFile
$cmin :: NewVerificationKeyFile
-> NewVerificationKeyFile -> NewVerificationKeyFile
max :: NewVerificationKeyFile
-> NewVerificationKeyFile -> NewVerificationKeyFile
$cmax :: NewVerificationKeyFile
-> NewVerificationKeyFile -> NewVerificationKeyFile
>= :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
$c>= :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
> :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
$c> :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
<= :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
$c<= :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
< :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
$c< :: NewVerificationKeyFile -> NewVerificationKeyFile -> Bool
compare :: NewVerificationKeyFile -> NewVerificationKeyFile -> Ordering
$ccompare :: NewVerificationKeyFile -> NewVerificationKeyFile -> Ordering
Ord, Int -> NewVerificationKeyFile -> ShowS
[NewVerificationKeyFile] -> ShowS
NewVerificationKeyFile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewVerificationKeyFile] -> ShowS
$cshowList :: [NewVerificationKeyFile] -> ShowS
show :: NewVerificationKeyFile -> FilePath
$cshow :: NewVerificationKeyFile -> FilePath
showsPrec :: Int -> NewVerificationKeyFile -> ShowS
$cshowsPrec :: Int -> NewVerificationKeyFile -> ShowS
Show, FilePath -> NewVerificationKeyFile
forall a. (FilePath -> a) -> IsString a
fromString :: FilePath -> NewVerificationKeyFile
$cfromString :: FilePath -> NewVerificationKeyFile
IsString)

-- | Print some invariant properties of a public key:
--   its hash and formatted view.
prettyPublicKey :: VerificationKey ByronKey-> Text
prettyPublicKey :: VerificationKey ByronKey -> Text
prettyPublicKey (ByronVerificationKey VerificationKey
vk) =
  forall a. Format Text a -> a
sformat (  Format
  (AddressHash VerificationKey
   -> VerificationKey -> VerificationKey -> Text)
  (AddressHash VerificationKey
   -> VerificationKey -> VerificationKey -> Text)
"    public key hash: " forall r a r'. Format r a -> Format r' r -> Format r' a
% forall a r. Buildable a => Format r (a -> r)
build forall r a r'. Format r a -> Format r' r -> Format r' a
%
           Format
  (VerificationKey -> VerificationKey -> Text)
  (VerificationKey -> VerificationKey -> Text)
"\npublic key (base64): " forall r a r'. Format r a -> Format r' r -> Format r' a
% forall r. Format r (VerificationKey -> r)
Crypto.fullVerificationKeyF forall r a r'. Format r a -> Format r' r -> Format r' a
%
           Format (VerificationKey -> Text) (VerificationKey -> Text)
"\n   public key (hex): " forall r a r'. Format r a -> Format r' r -> Format r' a
% forall r. Format r (VerificationKey -> r)
Crypto.fullVerificationKeyHexF)
    (forall a. ToCBOR a => a -> AddressHash a
Common.addressHash VerificationKey
vk) VerificationKey
vk VerificationKey
vk

byronWitnessToVerKey :: SomeByronSigningKey -> VerificationKey ByronKey
byronWitnessToVerKey :: SomeByronSigningKey -> VerificationKey ByronKey
byronWitnessToVerKey (AByronSigningKeyLegacy SigningKey ByronKeyLegacy
sKeyLeg) = forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey ByronKeyLegacy
sKeyLeg
byronWitnessToVerKey (AByronSigningKey SigningKey ByronKey
sKeyNonLeg) = forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey ByronKey
sKeyNonLeg

-- TODO:  we need to support password-protected secrets.
-- | Read signing key from a file.
readByronSigningKey :: ByronKeyFormat -> SigningKeyFile -> ExceptT ByronKeyFailure IO SomeByronSigningKey
readByronSigningKey :: ByronKeyFormat
-> SigningKeyFile -> ExceptT ByronKeyFailure IO SomeByronSigningKey
readByronSigningKey ByronKeyFormat
bKeyFormat (SigningKeyFile FilePath
fp) = do
  ByteString
sK <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> Text -> ByronKeyFailure
ReadSigningKeyFailure FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> FilePath
displayException) forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile FilePath
fp
  case ByronKeyFormat
bKeyFormat of
    ByronKeyFormat
LegacyByronKeyFormat ->
      case forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ByronKeyLegacy
AsByronKeyLegacy) ByteString
sK of
        Right SigningKey ByronKeyLegacy
legKey -> forall (m :: * -> *) a x. Monad m => a -> ExceptT x m a
right forall a b. (a -> b) -> a -> b
$ SigningKey ByronKeyLegacy -> SomeByronSigningKey
AByronSigningKeyLegacy SigningKey ByronKeyLegacy
legKey
        Left SerialiseAsRawBytesError
_ -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ FilePath -> ByronKeyFailure
LegacySigningKeyDeserialisationFailed FilePath
fp
    ByronKeyFormat
NonLegacyByronKeyFormat ->
      case forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ByronKey
AsByronKey) ByteString
sK of
        Right SigningKey ByronKey
nonLegSKey -> forall (m :: * -> *) a x. Monad m => a -> ExceptT x m a
right forall a b. (a -> b) -> a -> b
$ SigningKey ByronKey -> SomeByronSigningKey
AByronSigningKey SigningKey ByronKey
nonLegSKey
        Left SerialiseAsRawBytesError
_ -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ FilePath -> ByronKeyFailure
SigningKeyDeserialisationFailed FilePath
fp

-- | Read verification key from a file.  Throw an error if the file can't be read
-- or the key fails to deserialise.
readPaymentVerificationKey :: VerificationKeyFile -> ExceptT ByronKeyFailure IO Crypto.VerificationKey
readPaymentVerificationKey :: VerificationKeyFile -> ExceptT ByronKeyFailure IO VerificationKey
readPaymentVerificationKey (VerificationKeyFile FilePath
fp) = do
  ByteString
vkB <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> Text -> ByronKeyFailure
ReadVerificationKeyFailure FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> FilePath
displayException) (FilePath -> IO ByteString
SB.readFile FilePath
fp)
  -- Verification Key
  let eVk :: ExceptT VerificationKeyParseError IO VerificationKey
eVk = 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
Crypto.parseFullVerificationKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
UTF8.toString ByteString
vkB
  -- Convert error to 'CliError'
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> Text -> ByronKeyFailure
VerificationKeyDeserialisationFailed FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) ExceptT VerificationKeyParseError IO VerificationKey
eVk