module Cardano.CLI.Shelley.Run.Pool
  ( ShelleyPoolCmdError(ShelleyPoolCmdReadFileError)
  , renderShelleyPoolCmdError
  , runPoolCmd
  ) where

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

import           Cardano.Api
import           Cardano.Api.Shelley
import           Cardano.CLI.Shelley.Commands
import           Cardano.CLI.Shelley.Key (VerificationKeyOrFile, readVerificationKeyOrFile)
import           Cardano.CLI.Types (OutputFormat (..))

import qualified Cardano.Ledger.Slot as Shelley
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans.Except (ExceptT)
import           Data.Text (Text)

data ShelleyPoolCmdError
  = ShelleyPoolCmdReadFileError !(FileError TextEnvelopeError)
  | ShelleyPoolCmdReadKeyFileError !(FileError InputDecodeError)
  | ShelleyPoolCmdWriteFileError !(FileError ())
  | ShelleyPoolCmdMetadataValidationError !StakePoolMetadataValidationError
  deriving Int -> ShelleyPoolCmdError -> ShowS
[ShelleyPoolCmdError] -> ShowS
ShelleyPoolCmdError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyPoolCmdError] -> ShowS
$cshowList :: [ShelleyPoolCmdError] -> ShowS
show :: ShelleyPoolCmdError -> String
$cshow :: ShelleyPoolCmdError -> String
showsPrec :: Int -> ShelleyPoolCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyPoolCmdError -> ShowS
Show

renderShelleyPoolCmdError :: ShelleyPoolCmdError -> Text
renderShelleyPoolCmdError :: ShelleyPoolCmdError -> Text
renderShelleyPoolCmdError ShelleyPoolCmdError
err =
  case ShelleyPoolCmdError
err of
    ShelleyPoolCmdReadFileError FileError TextEnvelopeError
fileErr -> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr)
    ShelleyPoolCmdReadKeyFileError FileError InputDecodeError
fileErr -> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError InputDecodeError
fileErr)
    ShelleyPoolCmdWriteFileError FileError ()
fileErr -> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError ()
fileErr)
    ShelleyPoolCmdMetadataValidationError StakePoolMetadataValidationError
validationErr ->
      Text
"Error validating stake pool metadata: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall e. Error e => e -> String
displayError StakePoolMetadataValidationError
validationErr)



runPoolCmd :: PoolCmd -> ExceptT ShelleyPoolCmdError IO ()
runPoolCmd :: PoolCmd -> ExceptT ShelleyPoolCmdError IO ()
runPoolCmd (PoolRegistrationCert VerificationKeyOrFile StakePoolKey
sPvkey VerificationKeyOrFile VrfKey
vrfVkey Lovelace
pldg Lovelace
pCost Rational
pMrgn VerificationKeyOrFile StakeKey
rwdVerFp [VerificationKeyOrFile StakeKey]
ownerVerFps [StakePoolRelay]
relays Maybe StakePoolMetadataReference
mbMetadata NetworkId
network OutputFile
outfp) =
  VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Lovelace
-> Lovelace
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> NetworkId
-> OutputFile
-> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRegistrationCert VerificationKeyOrFile StakePoolKey
sPvkey VerificationKeyOrFile VrfKey
vrfVkey Lovelace
pldg Lovelace
pCost Rational
pMrgn VerificationKeyOrFile StakeKey
rwdVerFp [VerificationKeyOrFile StakeKey]
ownerVerFps [StakePoolRelay]
relays Maybe StakePoolMetadataReference
mbMetadata NetworkId
network OutputFile
outfp
runPoolCmd (PoolRetirementCert VerificationKeyOrFile StakePoolKey
sPvkeyFp EpochNo
retireEpoch OutputFile
outfp) =
  VerificationKeyOrFile StakePoolKey
-> EpochNo -> OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRetirementCert VerificationKeyOrFile StakePoolKey
sPvkeyFp EpochNo
retireEpoch OutputFile
outfp
runPoolCmd (PoolGetId VerificationKeyOrFile StakePoolKey
sPvkey OutputFormat
outputFormat) = VerificationKeyOrFile StakePoolKey
-> OutputFormat -> ExceptT ShelleyPoolCmdError IO ()
runPoolId VerificationKeyOrFile StakePoolKey
sPvkey OutputFormat
outputFormat
runPoolCmd (PoolMetadataHash PoolMetadataFile
poolMdFile Maybe OutputFile
mOutFile) = PoolMetadataFile
-> Maybe OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runPoolMetadataHash PoolMetadataFile
poolMdFile Maybe OutputFile
mOutFile


--
-- Stake pool command implementations
--

-- | Create a stake pool registration cert.
-- TODO: Metadata and more stake pool relay support to be
-- added in the future.
runStakePoolRegistrationCert
  :: VerificationKeyOrFile StakePoolKey
  -- ^ Stake pool verification key.
  -> VerificationKeyOrFile VrfKey
  -- ^ VRF Verification key.
  -> Lovelace
  -- ^ Pool pledge.
  -> Lovelace
  -- ^ Pool cost.
  -> Rational
  -- ^ Pool margin.
  -> VerificationKeyOrFile StakeKey
  -- ^ Stake verification key for reward account.
  -> [VerificationKeyOrFile StakeKey]
  -- ^ Pool owner stake verification key(s).
  -> [StakePoolRelay]
  -- ^ Stake pool relays.
  -> Maybe StakePoolMetadataReference
  -- ^ Stake pool metadata.
  -> NetworkId
  -> OutputFile
  -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRegistrationCert :: VerificationKeyOrFile StakePoolKey
-> VerificationKeyOrFile VrfKey
-> Lovelace
-> Lovelace
-> Rational
-> VerificationKeyOrFile StakeKey
-> [VerificationKeyOrFile StakeKey]
-> [StakePoolRelay]
-> Maybe StakePoolMetadataReference
-> NetworkId
-> OutputFile
-> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRegistrationCert
  VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile
  VerificationKeyOrFile VrfKey
vrfVerKeyOrFile
  Lovelace
pldg
  Lovelace
pCost
  Rational
pMrgn
  VerificationKeyOrFile StakeKey
rwdStakeVerKeyOrFile
  [VerificationKeyOrFile StakeKey]
ownerStakeVerKeyOrFiles
  [StakePoolRelay]
relays
  Maybe StakePoolMetadataReference
mbMetadata
  NetworkId
network
  (OutputFile String
outfp) = do
    -- Pool verification key
    VerificationKey StakePoolKey
stakePoolVerKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      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 StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile
    let stakePoolId' :: Hash StakePoolKey
stakePoolId' = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey

    -- VRF verification key
    VerificationKey VrfKey
vrfVerKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      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 VrfKey
AsVrfKey VerificationKeyOrFile VrfKey
vrfVerKeyOrFile
    let vrfKeyHash' :: Hash VrfKey
vrfKeyHash' = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
vrfVerKey

    -- Pool reward account
    VerificationKey StakeKey
rwdStakeVerKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      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
rwdStakeVerKeyOrFile
    let stakeCred :: StakeCredential
stakeCred = Hash StakeKey -> StakeCredential
StakeCredentialByKey (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
rwdStakeVerKey)
        rewardAccountAddr :: StakeAddress
rewardAccountAddr = NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
network StakeCredential
stakeCred

    -- Pool owner(s)
    [VerificationKey StakeKey]
sPoolOwnerVkeys <-
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
        (forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
(HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole
-> IO
     (Either (FileError InputDecodeError) (VerificationKey keyrole))
readVerificationKeyOrFile AsType StakeKey
AsStakeKey
        )
        [VerificationKeyOrFile StakeKey]
ownerStakeVerKeyOrFiles
    let stakePoolOwners' :: [Hash StakeKey]
stakePoolOwners' = forall a b. (a -> b) -> [a] -> [b]
map forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash [VerificationKey StakeKey]
sPoolOwnerVkeys

    let stakePoolParams :: StakePoolParameters
stakePoolParams =
          StakePoolParameters
            { stakePoolId :: Hash StakePoolKey
stakePoolId = Hash StakePoolKey
stakePoolId'
            , stakePoolVRF :: Hash VrfKey
stakePoolVRF = Hash VrfKey
vrfKeyHash'
            , stakePoolCost :: Lovelace
stakePoolCost = Lovelace
pCost
            , stakePoolMargin :: Rational
stakePoolMargin = Rational
pMrgn
            , stakePoolRewardAccount :: StakeAddress
stakePoolRewardAccount = StakeAddress
rewardAccountAddr
            , stakePoolPledge :: Lovelace
stakePoolPledge = Lovelace
pldg
            , stakePoolOwners :: [Hash StakeKey]
stakePoolOwners = [Hash StakeKey]
stakePoolOwners'
            , stakePoolRelays :: [StakePoolRelay]
stakePoolRelays = [StakePoolRelay]
relays
            , stakePoolMetadata :: Maybe StakePoolMetadataReference
stakePoolMetadata = Maybe StakePoolMetadataReference
mbMetadata
            }

    let registrationCert :: Certificate
registrationCert = StakePoolParameters -> Certificate
makeStakePoolRegistrationCertificate StakePoolParameters
stakePoolParams

    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyPoolCmdError
ShelleyPoolCmdWriteFileError
      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
registrationCertDesc) Certificate
registrationCert
  where
    registrationCertDesc :: TextEnvelopeDescr
    registrationCertDesc :: TextEnvelopeDescr
registrationCertDesc = TextEnvelopeDescr
"Stake Pool Registration Certificate"

runStakePoolRetirementCert
  :: VerificationKeyOrFile StakePoolKey
  -> Shelley.EpochNo
  -> OutputFile
  -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRetirementCert :: VerificationKeyOrFile StakePoolKey
-> EpochNo -> OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runStakePoolRetirementCert VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile EpochNo
retireEpoch (OutputFile String
outfp) = do
    -- Pool verification key
    VerificationKey StakePoolKey
stakePoolVerKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      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 StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
stakePoolVerKeyOrFile

    let stakePoolId' :: Hash StakePoolKey
stakePoolId' = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey
        retireCert :: Certificate
retireCert = Hash StakePoolKey -> EpochNo -> Certificate
makeStakePoolRetirementCertificate Hash StakePoolKey
stakePoolId' EpochNo
retireEpoch

    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyPoolCmdError
ShelleyPoolCmdWriteFileError
      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
retireCertDesc) Certificate
retireCert
  where
    retireCertDesc :: TextEnvelopeDescr
    retireCertDesc :: TextEnvelopeDescr
retireCertDesc = TextEnvelopeDescr
"Stake Pool Retirement Certificate"

runPoolId
  :: VerificationKeyOrFile StakePoolKey
  -> OutputFormat
  -> ExceptT ShelleyPoolCmdError IO ()
runPoolId :: VerificationKeyOrFile StakePoolKey
-> OutputFormat -> ExceptT ShelleyPoolCmdError IO ()
runPoolId VerificationKeyOrFile StakePoolKey
verKeyOrFile OutputFormat
outputFormat = do
    VerificationKey StakePoolKey
stakePoolVerKey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError InputDecodeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadKeyFileError
      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 StakePoolKey
AsStakePoolKey VerificationKeyOrFile StakePoolKey
verKeyOrFile
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      case OutputFormat
outputFormat of
        OutputFormat
OutputFormatHex ->
          ByteString -> IO ()
BS.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey)
        OutputFormat
OutputFormatBech32 ->
          Text -> IO ()
Text.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakePoolKey
stakePoolVerKey)

runPoolMetadataHash :: PoolMetadataFile -> Maybe OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runPoolMetadataHash :: PoolMetadataFile
-> Maybe OutputFile -> ExceptT ShelleyPoolCmdError IO ()
runPoolMetadataHash (PoolMetadataFile String
poolMDPath) Maybe OutputFile
mOutFile = do
  ByteString
metadataBytes <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError TextEnvelopeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
poolMDPath) forall a b. (a -> b) -> a -> b
$
    String -> IO ByteString
BS.readFile String
poolMDPath
  (StakePoolMetadata
_metadata, Hash StakePoolMetadata
metadataHash) <-
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakePoolMetadataValidationError -> ShelleyPoolCmdError
ShelleyPoolCmdMetadataValidationError
    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 a b. (a -> b) -> a -> b
$ ByteString
-> Either
     StakePoolMetadataValidationError
     (StakePoolMetadata, Hash StakePoolMetadata)
validateAndHashStakePoolMetadata ByteString
metadataBytes
  case Maybe OutputFile
mOutFile of
    Maybe OutputFile
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex Hash StakePoolMetadata
metadataHash)
    Just (OutputFile String
fpath) ->
      forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyPoolCmdError
ShelleyPoolCmdWriteFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fpath)
        forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BS.writeFile String
fpath (forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex Hash StakePoolMetadata
metadataHash)