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

module Cardano.CLI.EraIndependent.Address.Run
  ( runAddressCmds
  , runAddressBuildCmd
  , runAddressKeyGenCmd
  , runAddressKeyHashCmd
  , buildShelleyAddress
  , generateAndWriteKeyFiles
  )
where

import Cardano.Api
import Cardano.Api.Shelley

import Cardano.CLI.EraIndependent.Address.Command
import Cardano.CLI.EraIndependent.Address.Info.Run
import Cardano.CLI.EraIndependent.Key.Run qualified as Key
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.AddressCmdError
import Cardano.CLI.Type.Key
  ( PaymentVerifier (..)
  , StakeIdentifier (..)
  , StakeVerifier (..)
  , VerificationKeyTextOrFile
  , generateKeyPair
  , readVerificationKeyOrHashOrFile
  , readVerificationKeyTextOrFileAnyOf
  )

import Control.Monad (void)
import Data.ByteString.Char8 qualified as BS
import Data.Function
import Data.Text.IO qualified as Text

runAddressCmds
  :: ()
  => AddressCmds
  -> ExceptT AddressCmdError IO ()
runAddressCmds :: AddressCmds -> ExceptT AddressCmdError IO ()
runAddressCmds = \case
  AddressKeyGen KeyOutputFormat
fmt AddressKeyType
kt VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf ->
    KeyOutputFormat
-> AddressKeyType
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT AddressCmdError IO ()
runAddressKeyGenCmd KeyOutputFormat
fmt AddressKeyType
kt VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf
  AddressKeyHash VerificationKeyTextOrFile
vkf Maybe (File () 'Out)
mOFp ->
    VerificationKeyTextOrFile
-> Maybe (File () 'Out) -> ExceptT AddressCmdError IO ()
runAddressKeyHashCmd VerificationKeyTextOrFile
vkf Maybe (File () 'Out)
mOFp
  AddressBuild PaymentVerifier
paymentVerifier Maybe StakeIdentifier
mbStakeVerifier NetworkId
nw Maybe (File () 'Out)
mOutFp ->
    PaymentVerifier
-> Maybe StakeIdentifier
-> NetworkId
-> Maybe (File () 'Out)
-> ExceptT AddressCmdError IO ()
runAddressBuildCmd PaymentVerifier
paymentVerifier Maybe StakeIdentifier
mbStakeVerifier NetworkId
nw Maybe (File () 'Out)
mOutFp
  AddressInfo Text
txt Maybe (File () 'Out)
mOFp ->
    Text -> Maybe (File () 'Out) -> ExceptT AddressInfoError IO ()
runAddressInfoCmd Text
txt Maybe (File () 'Out)
mOFp ExceptT AddressInfoError IO ()
-> (ExceptT AddressInfoError IO ()
    -> ExceptT AddressCmdError IO ())
-> ExceptT AddressCmdError IO ()
forall a b. a -> (a -> b) -> b
& (AddressInfoError -> AddressCmdError)
-> ExceptT AddressInfoError IO () -> ExceptT AddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AddressInfoError -> AddressCmdError
AddressCmdAddressInfoError

runAddressKeyGenCmd
  :: KeyOutputFormat
  -> AddressKeyType
  -> VerificationKeyFile Out
  -> SigningKeyFile Out
  -> ExceptT AddressCmdError IO ()
runAddressKeyGenCmd :: KeyOutputFormat
-> AddressKeyType
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT AddressCmdError IO ()
runAddressKeyGenCmd KeyOutputFormat
fmt AddressKeyType
kt VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf = case AddressKeyType
kt of
  AddressKeyType
AddressKeyShelley -> ExceptT
  AddressCmdError
  IO
  (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ExceptT AddressCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   AddressCmdError
   IO
   (VerificationKey PaymentKey, SigningKey PaymentKey)
 -> ExceptT AddressCmdError IO ())
-> ExceptT
     AddressCmdError
     IO
     (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ KeyOutputFormat
-> AsType PaymentKey
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     AddressCmdError
     IO
     (VerificationKey PaymentKey, SigningKey PaymentKey)
forall keyrole.
(Key keyrole, HasTypeProxy keyrole,
 SerialiseAsBech32 (SigningKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
KeyOutputFormat
-> AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
generateAndWriteKeyFiles KeyOutputFormat
fmt AsType PaymentKey
AsPaymentKey VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf
  AddressKeyType
AddressKeyShelleyExtended -> ExceptT
  AddressCmdError
  IO
  (VerificationKey PaymentExtendedKey, SigningKey PaymentExtendedKey)
-> ExceptT AddressCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   AddressCmdError
   IO
   (VerificationKey PaymentExtendedKey, SigningKey PaymentExtendedKey)
 -> ExceptT AddressCmdError IO ())
-> ExceptT
     AddressCmdError
     IO
     (VerificationKey PaymentExtendedKey, SigningKey PaymentExtendedKey)
-> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ KeyOutputFormat
-> AsType PaymentExtendedKey
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     AddressCmdError
     IO
     (VerificationKey PaymentExtendedKey, SigningKey PaymentExtendedKey)
forall keyrole.
(Key keyrole, HasTypeProxy keyrole,
 SerialiseAsBech32 (SigningKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
KeyOutputFormat
-> AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
generateAndWriteKeyFiles KeyOutputFormat
fmt AsType PaymentExtendedKey
AsPaymentExtendedKey VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf
  AddressKeyType
AddressKeyByron -> AsType ByronKey
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT AddressCmdError IO ()
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT AddressCmdError IO ()
generateAndWriteByronKeyFiles AsType ByronKey
AsByronKey VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf

generateAndWriteByronKeyFiles
  :: ()
  => Key keyrole
  => HasTypeProxy keyrole
  => AsType keyrole
  -> VerificationKeyFile Out
  -> SigningKeyFile Out
  -> ExceptT AddressCmdError IO ()
generateAndWriteByronKeyFiles :: forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT AddressCmdError IO ()
generateAndWriteByronKeyFiles AsType keyrole
asType VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf = do
  (VerificationKey keyrole
 -> SigningKey keyrole -> ExceptT AddressCmdError IO ())
-> (VerificationKey keyrole, SigningKey keyrole)
-> ExceptT AddressCmdError IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> VerificationKey keyrole
-> SigningKey keyrole
-> ExceptT AddressCmdError IO ()
forall keyrole.
Key keyrole =>
VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> VerificationKey keyrole
-> SigningKey keyrole
-> ExceptT AddressCmdError IO ()
writeByronPaymentKeyFiles VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf) ((VerificationKey keyrole, SigningKey keyrole)
 -> ExceptT AddressCmdError IO ())
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
-> ExceptT AddressCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (VerificationKey keyrole, SigningKey keyrole)
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
forall a. IO a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AsType keyrole -> IO (VerificationKey keyrole, SigningKey keyrole)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole, HasTypeProxy keyrole) =>
AsType keyrole -> m (VerificationKey keyrole, SigningKey keyrole)
generateKeyPair AsType keyrole
asType)

generateAndWriteKeyFiles
  :: ()
  => Key keyrole
  => HasTypeProxy keyrole
  => SerialiseAsBech32 (SigningKey keyrole)
  => SerialiseAsBech32 (VerificationKey keyrole)
  => KeyOutputFormat
  -> AsType keyrole
  -> VerificationKeyFile Out
  -> SigningKeyFile Out
  -> ExceptT AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
generateAndWriteKeyFiles :: forall keyrole.
(Key keyrole, HasTypeProxy keyrole,
 SerialiseAsBech32 (SigningKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
KeyOutputFormat
-> AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
generateAndWriteKeyFiles KeyOutputFormat
fmt AsType keyrole
asType VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf = do
  (VerificationKey keyrole
vk, SigningKey keyrole
sk) <- IO (VerificationKey keyrole, SigningKey keyrole)
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
forall a. IO a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AsType keyrole -> IO (VerificationKey keyrole, SigningKey keyrole)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole, HasTypeProxy keyrole) =>
AsType keyrole -> m (VerificationKey keyrole, SigningKey keyrole)
generateKeyPair AsType keyrole
asType)
  KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> VerificationKey keyrole
-> SigningKey keyrole
-> ExceptT AddressCmdError IO ()
forall keyrole.
(Key keyrole, SerialiseAsBech32 (SigningKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> VerificationKey keyrole
-> SigningKey keyrole
-> ExceptT AddressCmdError IO ()
writePaymentKeyFiles KeyOutputFormat
fmt VerificationKeyFile 'Out
vkf SigningKeyFile 'Out
skf VerificationKey keyrole
vk SigningKey keyrole
sk
  (VerificationKey keyrole, SigningKey keyrole)
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey keyrole
vk, SigningKey keyrole
sk)

writePaymentKeyFiles
  :: Key keyrole
  => SerialiseAsBech32 (SigningKey keyrole)
  => SerialiseAsBech32 (VerificationKey keyrole)
  => KeyOutputFormat
  -> VerificationKeyFile Out
  -> SigningKeyFile Out
  -> VerificationKey keyrole
  -> SigningKey keyrole
  -> ExceptT AddressCmdError IO ()
writePaymentKeyFiles :: forall keyrole.
(Key keyrole, SerialiseAsBech32 (SigningKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> VerificationKey keyrole
-> SigningKey keyrole
-> ExceptT AddressCmdError IO ()
writePaymentKeyFiles KeyOutputFormat
fmt VerificationKeyFile 'Out
vkeyPath SigningKeyFile 'Out
skeyPath VerificationKey keyrole
vkey SigningKey keyrole
skey = do
  (FileError () -> AddressCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT AddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> AddressCmdError
AddressCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT AddressCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    case KeyOutputFormat
fmt of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
          SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
skeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
            Maybe TextEnvelopeDescr -> SigningKey keyrole -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey keyrole
skey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
          SigningKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile SigningKeyFile 'Out
skeyPath (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
            SigningKey keyrole -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey keyrole
skey

    case KeyOutputFormat
fmt of
      KeyOutputFormat
KeyOutputFormatTextEnvelope ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
          VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
            Maybe TextEnvelopeDescr -> VerificationKey keyrole -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.paymentVkeyDesc) VerificationKey keyrole
vkey
      KeyOutputFormat
KeyOutputFormatBech32 ->
        IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
          VerificationKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile VerificationKeyFile 'Out
vkeyPath (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
            VerificationKey keyrole -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 VerificationKey keyrole
vkey
 where
  skeyDesc :: TextEnvelopeDescr
  skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Payment Signing Key"

writeByronPaymentKeyFiles
  :: Key keyrole
  => VerificationKeyFile Out
  -> SigningKeyFile Out
  -> VerificationKey keyrole
  -> SigningKey keyrole
  -> ExceptT AddressCmdError IO ()
writeByronPaymentKeyFiles :: forall keyrole.
Key keyrole =>
VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> VerificationKey keyrole
-> SigningKey keyrole
-> ExceptT AddressCmdError IO ()
writeByronPaymentKeyFiles VerificationKeyFile 'Out
vkeyPath SigningKeyFile 'Out
skeyPath VerificationKey keyrole
vkey SigningKey keyrole
skey = do
  (FileError () -> AddressCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT AddressCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> AddressCmdError
AddressCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT AddressCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- No bech32 encoding for Byron keys
    IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
skeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey keyrole -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey keyrole
skey
    IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey keyrole -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.paymentVkeyDesc) VerificationKey keyrole
vkey
 where
  skeyDesc :: TextEnvelopeDescr
  skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Payment Signing Key"

runAddressKeyHashCmd
  :: VerificationKeyTextOrFile
  -> Maybe (File () Out)
  -> ExceptT AddressCmdError IO ()
runAddressKeyHashCmd :: VerificationKeyTextOrFile
-> Maybe (File () 'Out) -> ExceptT AddressCmdError IO ()
runAddressKeyHashCmd VerificationKeyTextOrFile
vkeyTextOrFile Maybe (File () 'Out)
mOutputFp = do
  SomeAddressVerificationKey
vkey <-
    (VerificationKeyTextOrFileError -> AddressCmdError)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
-> ExceptT AddressCmdError IO SomeAddressVerificationKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT VerificationKeyTextOrFileError -> AddressCmdError
AddressCmdVerificationKeyTextOrFileError (ExceptT
   VerificationKeyTextOrFileError IO SomeAddressVerificationKey
 -> ExceptT AddressCmdError IO SomeAddressVerificationKey)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
-> ExceptT AddressCmdError IO SomeAddressVerificationKey
forall a b. (a -> b) -> a -> b
$
      IO
  (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
 -> ExceptT
      VerificationKeyTextOrFileError IO SomeAddressVerificationKey)
-> IO
     (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
forall a b. (a -> b) -> a -> b
$
        VerificationKeyTextOrFile
-> IO
     (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
readVerificationKeyTextOrFileAnyOf VerificationKeyTextOrFile
vkeyTextOrFile

  let hexKeyHash :: ByteString
hexKeyHash =
        (forall keyrole.
 Key keyrole =>
 VerificationKey keyrole -> ByteString)
-> SomeAddressVerificationKey -> ByteString
forall a.
(forall keyrole. Key keyrole => VerificationKey keyrole -> a)
-> SomeAddressVerificationKey -> a
mapSomeAddressVerificationKey
          (Hash keyrole -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (Hash keyrole -> ByteString)
-> (VerificationKey keyrole -> Hash keyrole)
-> VerificationKey keyrole
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey keyrole -> Hash keyrole
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash)
          SomeAddressVerificationKey
vkey

  case Maybe (File () 'Out)
mOutputFp of
    Just (File FilePath
fpath) -> IO () -> ExceptT AddressCmdError IO ()
forall a. IO a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AddressCmdError IO ())
-> IO () -> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fpath ByteString
hexKeyHash
    Maybe (File () 'Out)
Nothing -> IO () -> ExceptT AddressCmdError IO ()
forall a. IO a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AddressCmdError IO ())
-> IO () -> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn ByteString
hexKeyHash

runAddressBuildCmd
  :: PaymentVerifier
  -> Maybe StakeIdentifier
  -> NetworkId
  -> Maybe (File () Out)
  -> ExceptT AddressCmdError IO ()
runAddressBuildCmd :: PaymentVerifier
-> Maybe StakeIdentifier
-> NetworkId
-> Maybe (File () 'Out)
-> ExceptT AddressCmdError IO ()
runAddressBuildCmd PaymentVerifier
paymentVerifier Maybe StakeIdentifier
mbStakeVerifier NetworkId
nw Maybe (File () 'Out)
mOutFp = do
  Text
outText <- case PaymentVerifier
paymentVerifier of
    PaymentVerifierKey VerificationKeyTextOrFile
payVkeyTextOrFile -> do
      SomeAddressVerificationKey
payVKey <-
        (VerificationKeyTextOrFileError -> AddressCmdError)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
-> ExceptT AddressCmdError IO SomeAddressVerificationKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT VerificationKeyTextOrFileError -> AddressCmdError
AddressCmdVerificationKeyTextOrFileError (ExceptT
   VerificationKeyTextOrFileError IO SomeAddressVerificationKey
 -> ExceptT AddressCmdError IO SomeAddressVerificationKey)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
-> ExceptT AddressCmdError IO SomeAddressVerificationKey
forall a b. (a -> b) -> a -> b
$
          IO
  (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
 -> ExceptT
      VerificationKeyTextOrFileError IO SomeAddressVerificationKey)
-> IO
     (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
forall a b. (a -> b) -> a -> b
$
            VerificationKeyTextOrFile
-> IO
     (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
readVerificationKeyTextOrFileAnyOf VerificationKeyTextOrFile
payVkeyTextOrFile

      AddressAny
addr <- case SomeAddressVerificationKey
payVKey of
        AByronVerificationKey VerificationKey ByronKey
vk ->
          AddressAny -> ExceptT AddressCmdError IO AddressAny
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address ByronAddr -> AddressAny
AddressByron (NetworkId -> VerificationKey ByronKey -> Address ByronAddr
makeByronAddress NetworkId
nw VerificationKey ByronKey
vk))
        APaymentVerificationKey VerificationKey PaymentKey
vk ->
          Address ShelleyAddr -> AddressAny
AddressShelley (Address ShelleyAddr -> AddressAny)
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
-> ExceptT AddressCmdError IO AddressAny
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerificationKey PaymentKey
-> Maybe StakeIdentifier
-> NetworkId
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
buildShelleyAddress VerificationKey PaymentKey
vk Maybe StakeIdentifier
mbStakeVerifier NetworkId
nw
        APaymentExtendedVerificationKey VerificationKey PaymentExtendedKey
vk ->
          Address ShelleyAddr -> AddressAny
AddressShelley (Address ShelleyAddr -> AddressAny)
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
-> ExceptT AddressCmdError IO AddressAny
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerificationKey PaymentKey
-> Maybe StakeIdentifier
-> NetworkId
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
buildShelleyAddress (VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey PaymentExtendedKey
vk) Maybe StakeIdentifier
mbStakeVerifier NetworkId
nw
        AGenesisUTxOVerificationKey VerificationKey GenesisUTxOKey
vk ->
          Address ShelleyAddr -> AddressAny
AddressShelley (Address ShelleyAddr -> AddressAny)
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
-> ExceptT AddressCmdError IO AddressAny
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerificationKey PaymentKey
-> Maybe StakeIdentifier
-> NetworkId
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
buildShelleyAddress (VerificationKey GenesisUTxOKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisUTxOKey
vk) Maybe StakeIdentifier
mbStakeVerifier NetworkId
nw
        SomeAddressVerificationKey
nonPaymentKey ->
          AddressCmdError -> ExceptT AddressCmdError IO AddressAny
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (AddressCmdError -> ExceptT AddressCmdError IO AddressAny)
-> AddressCmdError -> ExceptT AddressCmdError IO AddressAny
forall a b. (a -> b) -> a -> b
$ SomeAddressVerificationKey -> AddressCmdError
AddressCmdExpectedPaymentVerificationKey SomeAddressVerificationKey
nonPaymentKey
      Text -> ExceptT AddressCmdError IO Text
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExceptT AddressCmdError IO Text)
-> Text -> ExceptT AddressCmdError IO Text
forall a b. (a -> b) -> a -> b
$ AddressAny -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress (AddressAny
addr :: AddressAny)
    PaymentVerifierScriptFile (File FilePath
fp) -> do
      ScriptInAnyLang ScriptLanguage lang
_lang Script lang
script <-
        (FileError ScriptDecodeError -> AddressCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT AddressCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> AddressCmdError
AddressCmdReadScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT AddressCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT AddressCmdError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
          FilePath
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
FilePath -> t m ScriptInAnyLang
readFileScriptInAnyLang FilePath
fp

      let payCred :: PaymentCredential
payCred = ScriptHash -> PaymentCredential
PaymentCredentialByScript (Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script)

      StakeAddressReference
stakeAddressReference <- ExceptT AddressCmdError IO StakeAddressReference
-> (StakeIdentifier
    -> ExceptT AddressCmdError IO StakeAddressReference)
-> Maybe StakeIdentifier
-> ExceptT AddressCmdError IO StakeAddressReference
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StakeAddressReference
-> ExceptT AddressCmdError IO StakeAddressReference
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StakeAddressReference
NoStakeAddress) StakeIdentifier -> ExceptT AddressCmdError IO StakeAddressReference
makeStakeAddressRef Maybe StakeIdentifier
mbStakeVerifier

      Text -> ExceptT AddressCmdError IO Text
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExceptT AddressCmdError IO Text)
-> Text -> ExceptT AddressCmdError IO Text
forall a b. (a -> b) -> a -> b
$ Address ShelleyAddr -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress (Address ShelleyAddr -> Text)
-> (StakeAddressReference -> Address ShelleyAddr)
-> StakeAddressReference
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress NetworkId
nw PaymentCredential
payCred (StakeAddressReference -> Text) -> StakeAddressReference -> Text
forall a b. (a -> b) -> a -> b
$ StakeAddressReference
stakeAddressReference

  case Maybe (File () 'Out)
mOutFp of
    Just (File FilePath
fpath) -> IO () -> ExceptT AddressCmdError IO ()
forall a. IO a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AddressCmdError IO ())
-> IO () -> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
Text.writeFile FilePath
fpath Text
outText
    Maybe (File () 'Out)
Nothing -> IO () -> ExceptT AddressCmdError IO ()
forall a. IO a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AddressCmdError IO ())
-> IO () -> ExceptT AddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStr Text
outText

makeStakeAddressRef
  :: StakeIdentifier
  -> ExceptT AddressCmdError IO StakeAddressReference
makeStakeAddressRef :: StakeIdentifier -> ExceptT AddressCmdError IO StakeAddressReference
makeStakeAddressRef StakeIdentifier
stakeIdentifier =
  case StakeIdentifier
stakeIdentifier of
    StakeIdentifierVerifier StakeVerifier
stakeVerifier ->
      case StakeVerifier
stakeVerifier of
        StakeVerifierKey VerificationKeyOrHashOrFile StakeKey
stkVkeyOrFile -> do
          Hash StakeKey
stakeVKeyHash <-
            (FileError InputDecodeError -> AddressCmdError)
-> ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
-> ExceptT AddressCmdError IO (Hash StakeKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> AddressCmdError
AddressCmdReadKeyFileError (ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
 -> ExceptT AddressCmdError IO (Hash StakeKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
-> ExceptT AddressCmdError IO (Hash StakeKey)
forall a b. (a -> b) -> a -> b
$
              AsType StakeKey
-> VerificationKeyOrHashOrFile StakeKey
-> ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m, Key keyrole,
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrFile AsType StakeKey
AsStakeKey VerificationKeyOrHashOrFile StakeKey
stkVkeyOrFile
          StakeAddressReference
-> ExceptT AddressCmdError IO StakeAddressReference
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddressReference
 -> ExceptT AddressCmdError IO StakeAddressReference)
-> (StakeCredential -> StakeAddressReference)
-> StakeCredential
-> ExceptT AddressCmdError IO StakeAddressReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeCredential -> StakeAddressReference
StakeAddressByValue (StakeCredential
 -> ExceptT AddressCmdError IO StakeAddressReference)
-> StakeCredential
-> ExceptT AddressCmdError IO StakeAddressReference
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey Hash StakeKey
stakeVKeyHash
        StakeVerifierScriptFile (File FilePath
fp) -> do
          ScriptInAnyLang ScriptLanguage lang
_lang Script lang
script <-
            (FileError ScriptDecodeError -> AddressCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT AddressCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> AddressCmdError
AddressCmdReadScriptFileError (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT AddressCmdError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT AddressCmdError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
              FilePath
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
FilePath -> t m ScriptInAnyLang
readFileScriptInAnyLang FilePath
fp

          let stakeCred :: StakeCredential
stakeCred = ScriptHash -> StakeCredential
StakeCredentialByScript (Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script)
          StakeAddressReference
-> ExceptT AddressCmdError IO StakeAddressReference
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeCredential -> StakeAddressReference
StakeAddressByValue StakeCredential
stakeCred)
    StakeIdentifierAddress StakeAddress
stakeAddr ->
      StakeAddressReference
-> ExceptT AddressCmdError IO StakeAddressReference
forall a. a -> ExceptT AddressCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeAddressReference
 -> ExceptT AddressCmdError IO StakeAddressReference)
-> StakeAddressReference
-> ExceptT AddressCmdError IO StakeAddressReference
forall a b. (a -> b) -> a -> b
$ StakeCredential -> StakeAddressReference
StakeAddressByValue (StakeCredential -> StakeAddressReference)
-> StakeCredential -> StakeAddressReference
forall a b. (a -> b) -> a -> b
$ StakeAddress -> StakeCredential
stakeAddressCredential StakeAddress
stakeAddr

buildShelleyAddress
  :: VerificationKey PaymentKey
  -> Maybe StakeIdentifier
  -> NetworkId
  -> ExceptT AddressCmdError IO (Address ShelleyAddr)
buildShelleyAddress :: VerificationKey PaymentKey
-> Maybe StakeIdentifier
-> NetworkId
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
buildShelleyAddress VerificationKey PaymentKey
vkey Maybe StakeIdentifier
mbStakeVerifier NetworkId
nw =
  NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress NetworkId
nw (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vkey))
    (StakeAddressReference -> Address ShelleyAddr)
-> ExceptT AddressCmdError IO StakeAddressReference
-> ExceptT AddressCmdError IO (Address ShelleyAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT AddressCmdError IO StakeAddressReference
-> (StakeIdentifier
    -> ExceptT AddressCmdError IO StakeAddressReference)
-> Maybe StakeIdentifier
-> ExceptT AddressCmdError IO StakeAddressReference
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StakeAddressReference
-> ExceptT AddressCmdError IO StakeAddressReference
forall a. a -> ExceptT AddressCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StakeAddressReference
NoStakeAddress) StakeIdentifier -> ExceptT AddressCmdError IO StakeAddressReference
makeStakeAddressRef Maybe StakeIdentifier
mbStakeVerifier