{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.Shelley.Run.StakeAddress
  ( ShelleyStakeAddressCmdError(ShelleyStakeAddressCmdReadKeyFileError)
  , renderShelleyStakeAddressCmdError
  , runStakeAddressCmd
  , runStakeAddressKeyGenToFile
  ) where

import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT)
import qualified Data.ByteString.Char8 as BS
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text

import           Cardano.Api
import           Cardano.Api.Shelley

import           Cardano.CLI.Shelley.Key (StakeVerifier (..), VerificationKeyOrFile,
                   VerificationKeyOrHashOrFile, readVerificationKeyOrFile,
                   readVerificationKeyOrHashOrFile)
import           Cardano.CLI.Shelley.Parsers
import           Cardano.CLI.Shelley.Run.Read
import           Cardano.CLI.Types

data ShelleyStakeAddressCmdError
  = ShelleyStakeAddressCmdReadKeyFileError !(FileError InputDecodeError)
  | ShelleyStakeAddressCmdReadScriptFileError !(FileError ScriptDecodeError)
  | ShelleyStakeAddressCmdWriteFileError !(FileError ())
  deriving Int -> ShelleyStakeAddressCmdError -> ShowS
[ShelleyStakeAddressCmdError] -> ShowS
ShelleyStakeAddressCmdError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyStakeAddressCmdError] -> ShowS
$cshowList :: [ShelleyStakeAddressCmdError] -> ShowS
show :: ShelleyStakeAddressCmdError -> String
$cshow :: ShelleyStakeAddressCmdError -> String
showsPrec :: Int -> ShelleyStakeAddressCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyStakeAddressCmdError -> ShowS
Show

renderShelleyStakeAddressCmdError :: ShelleyStakeAddressCmdError -> Text
renderShelleyStakeAddressCmdError :: ShelleyStakeAddressCmdError -> Text
renderShelleyStakeAddressCmdError ShelleyStakeAddressCmdError
err =
  case ShelleyStakeAddressCmdError
err of
    ShelleyStakeAddressCmdReadKeyFileError FileError InputDecodeError
fileErr -> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError InputDecodeError
fileErr)
    ShelleyStakeAddressCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError ()
fileErr)
    ShelleyStakeAddressCmdReadScriptFileError FileError ScriptDecodeError
fileErr -> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError ScriptDecodeError
fileErr)

runStakeAddressCmd :: StakeAddressCmd -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressCmd :: StakeAddressCmd -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressCmd (StakeAddressKeyGen VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyGenToFile VerificationKeyFile
vk SigningKeyFile
sk
runStakeAddressCmd (StakeAddressKeyHash VerificationKeyOrFile StakeKey
vk Maybe OutputFile
mOutputFp) = VerificationKeyOrFile StakeKey
-> Maybe OutputFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyHash VerificationKeyOrFile StakeKey
vk Maybe OutputFile
mOutputFp
runStakeAddressCmd (StakeAddressBuild StakeVerifier
stakeVerifier NetworkId
nw Maybe OutputFile
mOutputFp) =
  StakeVerifier
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressBuild StakeVerifier
stakeVerifier NetworkId
nw Maybe OutputFile
mOutputFp
runStakeAddressCmd (StakeRegistrationCert StakeVerifier
stakeVerifier OutputFile
outputFp) =
  StakeVerifier
-> OutputFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialRegistrationCert StakeVerifier
stakeVerifier OutputFile
outputFp
runStakeAddressCmd (StakeCredentialDelegationCert StakeVerifier
stakeVerifier VerificationKeyOrHashOrFile StakePoolKey
stkPoolVerKeyHashOrFp OutputFile
outputFp) =
  StakeVerifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> OutputFile
-> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialDelegationCert StakeVerifier
stakeVerifier VerificationKeyOrHashOrFile StakePoolKey
stkPoolVerKeyHashOrFp OutputFile
outputFp
runStakeAddressCmd (StakeCredentialDeRegistrationCert StakeVerifier
stakeVerifier OutputFile
outputFp) =
  StakeVerifier
-> OutputFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialDeRegistrationCert StakeVerifier
stakeVerifier OutputFile
outputFp


--
-- Stake address command implementations
--

runStakeAddressKeyGenToFile
  :: VerificationKeyFile
  -> SigningKeyFile
  -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyGenToFile :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyGenToFile (VerificationKeyFile String
vkFp) (SigningKeyFile String
skFp) = do
  let skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Stake Signing Key"
  let vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Stake Verification Key"

  SigningKey StakeKey
skey <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType StakeKey
AsStakeKey

  let vkey :: VerificationKey StakeKey
vkey = forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey StakeKey
skey

  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdWriteFileError forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skFp (forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey StakeKey
skey
    forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkFp (forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey StakeKey
vkey

runStakeAddressKeyHash
  :: VerificationKeyOrFile StakeKey
  -> Maybe OutputFile
  -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyHash :: VerificationKeyOrFile StakeKey
-> Maybe OutputFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyHash VerificationKeyOrFile StakeKey
stakeVerKeyOrFile Maybe OutputFile
mOutputFp = do
  VerificationKey StakeKey
vkey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdReadKeyFileError
    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 keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakeKey
AsStakeKey VerificationKeyOrFile StakeKey
stakeVerKeyOrFile

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

  case Maybe OutputFile
mOutputFp of
    Just (OutputFile String
fpath) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BS.writeFile String
fpath ByteString
hexKeyHash
    Maybe OutputFile
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn ByteString
hexKeyHash

runStakeAddressBuild
  :: StakeVerifier
  -> NetworkId
  -> Maybe OutputFile
  -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressBuild :: StakeVerifier
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressBuild StakeVerifier
stakeVerifier NetworkId
network Maybe OutputFile
mOutputFp = do
  StakeAddress
stakeAddr <- NetworkId
-> StakeVerifier
-> ExceptT ShelleyStakeAddressCmdError IO StakeAddress
getStakeAddressFromVerifier NetworkId
network StakeVerifier
stakeVerifier
  let stakeAddrText :: Text
stakeAddrText = forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress StakeAddress
stakeAddr
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    case Maybe OutputFile
mOutputFp of
      Just (OutputFile String
fpath) -> String -> Text -> IO ()
Text.writeFile String
fpath Text
stakeAddrText
      Maybe OutputFile
Nothing -> Text -> IO ()
Text.putStrLn Text
stakeAddrText


runStakeCredentialRegistrationCert
  :: StakeVerifier
  -> OutputFile
  -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialRegistrationCert :: StakeVerifier
-> OutputFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialRegistrationCert StakeVerifier
stakeVerifier (OutputFile String
oFp) = do
  StakeCredential
stakeCred <- StakeVerifier
-> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
getStakeCredentialFromVerifier StakeVerifier
stakeVerifier
  StakeCredential -> ExceptT ShelleyStakeAddressCmdError IO ()
writeRegistrationCert StakeCredential
stakeCred

 where
  writeRegistrationCert
    :: StakeCredential
    -> ExceptT ShelleyStakeAddressCmdError IO ()
  writeRegistrationCert :: StakeCredential -> ExceptT ShelleyStakeAddressCmdError IO ()
writeRegistrationCert StakeCredential
sCred = do
    let deRegCert :: Certificate
deRegCert = StakeCredential -> Certificate
makeStakeAddressRegistrationCertificate StakeCredential
sCred
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdWriteFileError
      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 =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
oFp (forall a. a -> Maybe a
Just TextEnvelopeDescr
regCertDesc) Certificate
deRegCert

  regCertDesc :: TextEnvelopeDescr
  regCertDesc :: TextEnvelopeDescr
regCertDesc = TextEnvelopeDescr
"Stake Address Registration Certificate"


runStakeCredentialDelegationCert
  :: StakeVerifier
  -- ^ Delegator stake verification key, verification key file or script file.
  -> VerificationKeyOrHashOrFile StakePoolKey
  -- ^ Delegatee stake pool verification key or verification key file or
  -- verification key hash.
  -> OutputFile
  -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialDelegationCert :: StakeVerifier
-> VerificationKeyOrHashOrFile StakePoolKey
-> OutputFile
-> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialDelegationCert StakeVerifier
stakeVerifier VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile (OutputFile String
outFp) = do
  Hash StakePoolKey
poolStakeVKeyHash <-
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT
      FileError InputDecodeError -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdReadKeyFileError
      (forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall keyrole.
(Key keyrole, SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole
-> IO (Either (FileError InputDecodeError) (Hash keyrole))
readVerificationKeyOrHashOrFile AsType StakePoolKey
AsStakePoolKey VerificationKeyOrHashOrFile StakePoolKey
poolVKeyOrHashOrFile)
  StakeCredential
stakeCred <- StakeVerifier
-> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
getStakeCredentialFromVerifier StakeVerifier
stakeVerifier
  StakeCredential
-> Hash StakePoolKey -> ExceptT ShelleyStakeAddressCmdError IO ()
writeDelegationCert StakeCredential
stakeCred Hash StakePoolKey
poolStakeVKeyHash

  where
    writeDelegationCert
      :: StakeCredential
      -> Hash StakePoolKey
      -> ExceptT ShelleyStakeAddressCmdError IO ()
    writeDelegationCert :: StakeCredential
-> Hash StakePoolKey -> ExceptT ShelleyStakeAddressCmdError IO ()
writeDelegationCert StakeCredential
sCred Hash StakePoolKey
poolStakeVKeyHash = do
      let delegCert :: Certificate
delegCert = StakeCredential -> Hash StakePoolKey -> Certificate
makeStakeAddressDelegationCertificate StakeCredential
sCred Hash StakePoolKey
poolStakeVKeyHash
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdWriteFileError
        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 =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
outFp (forall a. a -> Maybe a
Just TextEnvelopeDescr
delegCertDesc) Certificate
delegCert

    delegCertDesc :: TextEnvelopeDescr
    delegCertDesc :: TextEnvelopeDescr
delegCertDesc = TextEnvelopeDescr
"Stake Address Delegation Certificate"


runStakeCredentialDeRegistrationCert
  :: StakeVerifier
  -> OutputFile
  -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialDeRegistrationCert :: StakeVerifier
-> OutputFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeCredentialDeRegistrationCert StakeVerifier
stakeVerifier (OutputFile String
oFp) = do
  StakeCredential
stakeCred <- StakeVerifier
-> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
getStakeCredentialFromVerifier StakeVerifier
stakeVerifier
  StakeCredential -> ExceptT ShelleyStakeAddressCmdError IO ()
writeDeregistrationCert StakeCredential
stakeCred

  where
    writeDeregistrationCert
      :: StakeCredential
      -> ExceptT ShelleyStakeAddressCmdError IO ()
    writeDeregistrationCert :: StakeCredential -> ExceptT ShelleyStakeAddressCmdError IO ()
writeDeregistrationCert StakeCredential
sCred = do
      let deRegCert :: Certificate
deRegCert = StakeCredential -> Certificate
makeStakeAddressDeregistrationCertificate StakeCredential
sCred
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdWriteFileError
        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 =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
oFp (forall a. a -> Maybe a
Just TextEnvelopeDescr
deregCertDesc) Certificate
deRegCert

    deregCertDesc :: TextEnvelopeDescr
    deregCertDesc :: TextEnvelopeDescr
deregCertDesc = TextEnvelopeDescr
"Stake Address Deregistration Certificate"


getStakeCredentialFromVerifier
  :: StakeVerifier -> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
getStakeCredentialFromVerifier :: StakeVerifier
-> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
getStakeCredentialFromVerifier = \case
  StakeVerifierScriptFile (ScriptFile String
sFile) -> do
    ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <-
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdReadScriptFileError forall a b. (a -> b) -> a -> b
$
        String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
sFile
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ScriptHash -> StakeCredential
StakeCredentialByScript forall a b. (a -> b) -> a -> b
$ forall lang. Script lang -> ScriptHash
hashScript Script lang
script

  StakeVerifierKey VerificationKeyOrFile StakeKey
stakeVerKeyOrFile -> do
    VerificationKey StakeKey
stakeVerKey <-
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyStakeAddressCmdError
ShelleyStakeAddressCmdReadKeyFileError
        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 keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakeKey
AsStakeKey VerificationKeyOrFile StakeKey
stakeVerKeyOrFile
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
stakeVerKey

  StakeVerifierAddress StakeAddress
stakeAddr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ StakeAddress -> StakeCredential
stakeAddressCredential StakeAddress
stakeAddr

getStakeAddressFromVerifier
  :: NetworkId
  -> StakeVerifier
  -> ExceptT ShelleyStakeAddressCmdError IO StakeAddress
getStakeAddressFromVerifier :: NetworkId
-> StakeVerifier
-> ExceptT ShelleyStakeAddressCmdError IO StakeAddress
getStakeAddressFromVerifier NetworkId
networkId = \case
  StakeVerifierAddress StakeAddress
stakeAddr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeAddress
stakeAddr
  StakeVerifier
stakeVerifier ->
    NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
networkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StakeVerifier
-> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
getStakeCredentialFromVerifier StakeVerifier
stakeVerifier