Impl.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Interface to the @octez-client@ executable expressed in Haskell types.
module Morley.Client.TezosClient.Impl
  ( TezosClientError (..)

  -- * @octez-client@ api
  , signBytes
  , rememberContract
  , importKey
  , genKey
  , genFreshKey
  , revealKey
  , revealKeyUnlessRevealed
  , ResolveError(..)
  , Resolve(..)
  , resolveAddress
  , resolveAddressMaybe
  , getAlias
  , getAliasMaybe
  , getPublicKey
  , getSecretKey
  , getTezosClientConfig
  , calcTransferFee
  , calcOriginationFee
  , calcRevealFee
  , getKeyPassword
  , registerDelegate
  , getAliasesAndAddresses
  , resolveAddressWithAlias
  , resolveAddressWithAliasMaybe

    -- * For tests
  , lookupAliasCache
  ) where

import Data.Aeson (encode)
import Data.ByteArray (ScrubbedBytes)
import Data.ByteString.Lazy.Char8 qualified as C (unpack)
import Data.Constraint ((\\))
import Data.Text qualified as T
import Fmt (pretty, (+|), (|+))
import Text.Printf (printf)
import UnliftIO.IO (hGetEcho, hSetEcho)

import Lorentz.Value
import Morley.Client.App
import Morley.Client.Logging
import Morley.Client.RPC.Getters (getManagerKey)
import Morley.Client.TezosClient.Class qualified as Class
import Morley.Client.TezosClient.Config
import Morley.Client.TezosClient.Helpers
import Morley.Client.TezosClient.Parser
import Morley.Client.TezosClient.Resolve
import Morley.Client.TezosClient.Types
import Morley.Client.TezosClient.Types.Errors
import Morley.Client.TezosClient.Types.MorleyClientM
import Morley.Client.Types
import Morley.Client.Types.AliasesAndAddresses
import Morley.Client.Util (readScrubbedBytes)
import Morley.Micheline
import Morley.Michelson.Typed.Scope
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Crypto
import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519
import Morley.Util.Constrained
import Morley.Util.Peano
import Morley.Util.SizedList.Types

-- Note: if we try to sign with an unknown alias, @octez-client@ will
-- report a fatal error (assert failure) to stdout. It's bad. It's
-- reported in two issues: https://gitlab.com/tezos/tezos/-/issues/653
-- and https://gitlab.com/tezos/tezos/-/issues/813.
-- I (@gromak) currently think it's better to wait for it to be resolved upstream.
-- Currently we will throw 'TezosClientUnexpectedOutputFormat' error.
-- | Sign an arbtrary bytestring using @octez-client@.
-- Secret key of the address corresponding to give 'AddressOrAlias' must be known.
signBytes
  :: ImplicitAlias
  -> Maybe ScrubbedBytes
  -> ByteString
  -> MorleyClientM Signature
signBytes signerAlias mbPassword opHash = do
  logDebug $ "Signing for " <> pretty signerAlias
  output <- callTezosClientStrict
    ["sign", "bytes", toCmdArg opHash, "for", toCmdArg signerAlias] MockupMode mbPassword
  liftIO case T.stripPrefix "Signature: " output of
    Nothing ->
      -- There is additional noise in the stdout in case key is password protected
      case T.stripPrefix "Enter password for encrypted key: Signature: " output of
        Nothing -> throwM $ TezosClientUnexpectedSignatureOutput output
        Just signatureTxt -> txtToSignature signatureTxt
    Just signatureTxt -> txtToSignature signatureTxt
  where
    txtToSignature :: MonadCatch m => Text -> m Signature
    txtToSignature signatureTxt = either (throwM . TezosClientCryptoParseError signatureTxt) pure $
      parseSignature . T.strip $ signatureTxt

-- | Generate a new secret key and save it with given alias.
-- If an address with given alias already exists, it will be returned
-- and no state will be changed.
genKey :: ImplicitAlias -> MorleyClientM ImplicitAddress
genKey name = do
  lookupAliasCache name >>= \case
    Just addr -> pure addr
    Nothing -> do
      let
        isAlreadyExistsError :: Text -> Bool
        -- We can do a bit better here using more complex parsing if necessary.
        isAlreadyExistsError = T.isInfixOf "already exists."

        errHandler _ errOut = pure (isAlreadyExistsError errOut)

      _ <-
        callTezosClient errHandler
        ["gen", "keys", toCmdArg name] MockupMode Nothing
      invalidateAliasCache
      resolveAddress (AddressAlias name)

-- | Generate a new secret key and save it with given alias.
-- If an address with given alias already exists, it will be removed
-- and replaced with a fresh one.
genFreshKey :: ImplicitAlias -> MorleyClientM ImplicitAddress
genFreshKey name = do
  let
    isNoAliasError :: Text -> Bool
    -- We can do a bit better here using more complex parsing if necessary.
    isNoAliasError = T.isInfixOf "no public key hash alias named"

    errHandler _ errOutput = pure (isNoAliasError errOutput)

  _ <-
    callTezosClient errHandler
    ["forget", "address", toCmdArg name, "--force"] MockupMode Nothing
  callTezosClientStrict ["gen", "keys", toCmdArg name] MockupMode Nothing
  invalidateAliasCache
  resolveAddress (AddressAlias name)

-- | Reveal public key corresponding to the given alias.
-- Fails if it's already revealed.
revealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> MorleyClientM ()
revealKey alias mbPassword = do
  logDebug $ "Revealing key for " +| alias |+ ""
  let
    alreadyRevealed = T.isInfixOf "previously revealed"
    revealedImplicitAccount = T.isInfixOf "only implicit accounts can be revealed"
    emptyImplicitContract = T.isInfixOf "Empty implicit contract"
    errHandler _ errOut =
      False <$ do
        when (alreadyRevealed errOut) (throwM (AlreadyRevealed alias))
        when (revealedImplicitAccount errOut) (throwM (CantRevealContract alias))
        when (emptyImplicitContract errOut) (throwM (EmptyImplicitContract alias))

  _ <-
    callTezosClient errHandler
    ["reveal", "key", "for", toCmdArg alias] ClientMode mbPassword

  logDebug $ "Successfully revealed key for " +| alias |+ ""

-- | Reveal key for implicit address if necessary.
revealKeyUnlessRevealed :: ImplicitAddressWithAlias -> Maybe ScrubbedBytes -> MorleyClientM ()
revealKeyUnlessRevealed (AddressWithAlias addr alias) mbPassword = do
  mbManagerKey <- getManagerKey addr
  case mbManagerKey of
    Nothing -> revealKey alias mbPassword
    Just _  -> logDebug $ alias |+ " alias has already revealed key"

-- | Register alias as delegate
registerDelegate :: ImplicitAlias -> Maybe ScrubbedBytes -> MorleyClientM ()
registerDelegate alias mbPassword = do
  logDebug $ "Registering " +| alias |+ " as delegate"
  let
    emptyImplicitContract = T.isInfixOf "Empty implicit contract"
    errHandler _ errOut =
      False <$ do
        when (emptyImplicitContract errOut) (throwM (EmptyImplicitContract alias))

  _ <-
    callTezosClient errHandler
    ["register", "key", toCmdArg alias, "as", "delegate"] ClientMode mbPassword

  logDebug $ "Successfully registered " +| alias |+ " as delegate"

-- | Call @octez-client@ to list known addresses or contracts
callListKnown :: String -> MorleyClientM Text
callListKnown objects =
  callTezosClientStrict ["list", "known", objects] MockupMode Nothing

-- | Return 'PublicKey' corresponding to given 'AddressOrAlias'.
getPublicKey
  :: ImplicitAlias
  -> MorleyClientM PublicKey
getPublicKey alias = do
  logDebug $ "Getting " +| alias |+ " public key"
  output <- callTezosClientStrict ["show", "address", toCmdArg alias] MockupMode Nothing
  liftIO case lines output of
    _ : [rawPK] -> do
      pkText <- maybe
        (throwM $ TezosClientUnexpectedOutputFormat rawPK) pure
        (T.stripPrefix "Public Key: " rawPK)
      either (throwM . TezosClientCryptoParseError pkText) pure $
        parsePublicKey pkText
    _ -> throwM $ TezosClientUnexpectedOutputFormat output

-- | Return 'SecretKey' corresponding to given 'AddressOrAlias'.
getSecretKey
  :: ImplicitAlias
  -> MorleyClientM SecretKey
getSecretKey alias = do
  logDebug $ "Getting " +| alias |+ " secret key"
  output <- callTezosClientStrict ["show", "address", toCmdArg alias, "--show-secret"] MockupMode Nothing
  liftIO case lines output of
    _ : _ : [rawSK] -> do
      skText <- maybe
        (throwM $ TezosClientUnexpectedOutputFormat rawSK) pure
        (T.stripPrefix "Secret Key: " rawSK)
      either (throwM . TezosClientCryptoParseError skText) pure $
        parseSecretKey skText
    _ -> throwM $ TezosClientUnexpectedOutputFormat output

-- | Save a contract with given address and alias.
-- If @replaceExisting@ is @False@ and a contract with given alias
-- already exists, this function does nothing.
rememberContract
  :: AliasBehavior
  -> ContractAddress
  -> ContractAlias
  -> MorleyClientM ()
rememberContract aliasBehavior address alias = do
  case aliasBehavior of
    DontSaveAlias ->
      logInfo $ "Not saving " +| address |+ " as " +| alias |+ " as requested"
    OverwriteDuplicateAlias -> do
      void $ callTezosClientStrict (args <> ["--force"]) MockupMode Nothing
      tryUpdateAliasCache alias address
    _ -> do
      lookupAliasCache alias >>= \case
        Nothing -> do
          let errHandler _ errOut
                | isAlreadyExistsError errOut = case aliasBehavior of
                    KeepDuplicateAlias -> pure True
                    ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias
                | otherwise = pure False
          void $ callTezosClient errHandler args MockupMode Nothing
          tryUpdateAliasCache alias address
        Just{} -> case aliasBehavior of
          KeepDuplicateAlias -> pass
          ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias
  where
    args = ["remember", "contract", toCmdArg alias, pretty address]
    isAlreadyExistsError = T.isInfixOf "already exists"

importKey
  :: Bool
  -> ImplicitAlias
  -> SecretKey
  -> MorleyClientM ImplicitAddressWithAlias
importKey replaceExisting name key = do
  let isAlreadyExistsError = T.isInfixOf "already exists"
      errHandler _ errOut
        | isAlreadyExistsError errOut = throwM $ DuplicateAlias $ unAlias name
        | otherwise = pure False
      args = ["import", "secret", "key", toCmdArg name, toCmdArg key]
  void $ callTezosClient errHandler
    (if replaceExisting then args <> ["--force"] else args)
    MockupMode Nothing
  let addr = mkKeyAddress (toPublic key)
  tryUpdateAliasCache name addr
  pure $ AddressWithAlias addr name

-- | Calc baker fee for transfer using @octez-client@.
calcTransferFee
  :: AddressOrAlias kind
  -> Maybe ScrubbedBytes
  -> TezosInt64
  -> [CalcTransferFeeData]
  -> MorleyClientM [TezosMutez]
calcTransferFee from mbPassword burnCap transferFeeDatas = do
  output <- callTezosClientStrict
    [ "multiple", "transfers", "from", pretty from, "using"
    , C.unpack $ encode transferFeeDatas, "--burn-cap", showBurnCap burnCap, "--dry-run"
    ] ClientMode mbPassword
  withSomePeano (length transferFeeDatas) $
    \(_ :: Proxy n) -> toList <$> feeOutputParser @n output

-- | Calc baker fee for origination using @octez-client@.
calcOriginationFee :: UntypedValScope st => CalcOriginationFeeData cp st -> MorleyClientM TezosMutez
calcOriginationFee CalcOriginationFeeData{..} = do
  output <- callTezosClientStrict
    [ "originate", "contract", "-", "transferring"
    , showTez cofdBalance
    , "from", pretty cofdFrom, "running"
    , toCmdArg cofdContract, "--init"
    , toCmdArg cofdStorage, "--burn-cap"
    , showBurnCap cofdBurnCap, "--dry-run"
    ] ClientMode cofdMbFromPassword
  fees <- feeOutputParser @1 output
  case fees of
    singleFee :< Nil -> return singleFee

-- | Calc baker fee for revealing using @octez-client@.
--
-- Note that @octez-client@ does not support passing an address here,
-- at least at the moment of writing.
calcRevealFee :: ImplicitAlias -> Maybe ScrubbedBytes -> TezosInt64 -> MorleyClientM TezosMutez
calcRevealFee alias mbPassword burnCap = do
  output <- callTezosClientStrict
    [ "reveal", "key", "for", toCmdArg alias
    , "--burn-cap", showBurnCap burnCap
    , "--dry-run"
    ] ClientMode mbPassword
  fees <- feeOutputParser @1 output
  case fees of
    singleFee :< Nil -> return singleFee

feeOutputParser :: forall n. (SingIPeano n) => Text -> MorleyClientM (SizedList n TezosMutez)
feeOutputParser output =
  case parseBakerFeeFromOutput @n output of
    Right fee -> return fee
    Left err -> throwM $ TezosClientParseFeeError output $ pretty err

showBurnCap :: TezosInt64 -> String
showBurnCap x = printf "%.6f" $ (fromIntegralToRealFrac @TezosInt64 @Float x) / 1000

showTez :: TezosMutez -> String
showTez = toCmdArg . unTezosMutez

-- | Get password for secret key associated with given address
-- in case this key is password-protected
getKeyPassword :: ImplicitAlias -> MorleyClientM (Maybe ScrubbedBytes)
getKeyPassword alias = do
  output <- callTezosClientStrict [ "show", "address", pretty alias, "-S"] MockupMode Nothing
  encryptionType <-
    case parseSecretKeyEncryption output of
      Right t -> return t
      Left err -> throwM $ TezosClientParseEncryptionTypeError output $ pretty err
  case encryptionType of
    EncryptedKey -> do
      putTextLn $ "Please enter password for '" <> pretty alias <> "':"
      Just <$> withoutEcho readScrubbedBytes
    _ -> pure Nothing

  where
    -- Hide entered password
    withoutEcho :: (MonadIO m, MonadMask m) => m a -> m a
    withoutEcho action = do
      old <- hGetEcho stdin
      bracket_ (hSetEcho stdin False) (hSetEcho stdin old) action

{- | Calls @octez-client list known contracts@ and returns
a list of @(alias, address)@ pairs.

Note that an alias can be ambiguous: it can refer to __both__ a contract and an implicit account.
When an alias "abc" is ambiguous, the list will contain two entries:

> ("abc", "KT1...")
> ("key:abc", "tz1...")
-}
getAliasesAndAddresses :: MorleyClientM AliasesAndAddresses
getAliasesAndAddresses = do
  env <- ask
  let mv = env ^. mceTezosClientL . tceAliasMapL
  updateMVar' mv $ get >>= \case
    Nothing -> do
      res <- lift $ parseOutput =<< runMorleyClientM env (callListKnown "contracts")
      put $ Just res
      pure res
    Just a -> pure a
  where
    parseOutput :: Text -> IO AliasesAndAddresses
    parseOutput out = mkAliasesAndAddresses <$> mapM parseLine (lines out)

    -- Note: each line has the format "<alias>: <address>"
    parseLine :: Text -> IO (Constrained NullConstraint AddressWithAlias)
    parseLine ln = do
      let (aliasText', addressText) = first (T.dropEnd 2) $ T.breakOnEnd ": " ln
          -- This alias _might_ belong to both an implicit account and a contract,
          -- in which case it might be prefixed with "key".
          -- If so, we have to strip the prefix.
          aliasText = fromMaybe aliasText' $ T.stripPrefix "key:" aliasText'
      Constrained awaAddress <- parseL1Address addressText
      let awaAlias = mkAlias aliasText \\ addressKindSanity awaAddress
      pure . Constrained $ AddressWithAlias{..}

    parseL1Address :: Text -> IO L1Address
    parseL1Address addrText
      = either (throwM . TezosClientParseAddressError addrText) pure
      . parseConstrainedAddress $ addrText

invalidateAliasCache :: MorleyClientM ()
invalidateAliasCache = do
  mv <- view $ tezosClientEnvL . tceAliasMapL
  updateMVar' mv $ put Nothing

tryUpdateAliasCache :: Alias kind -> KindedAddress kind -> MorleyClientM ()
tryUpdateAliasCache alias addr = do
  mv <- view $ tezosClientEnvL . tceAliasMapL
  updateMVar' mv $ modify' $ fmap $ insertAliasAndAddress alias addr

lookupAliasCache :: Alias kind -> MorleyClientM (Maybe (KindedAddress kind))
lookupAliasCache alias = do
  mv <- view $ tezosClientEnvL . tceAliasMapL
  (lookupAddr alias =<<) <$> readMVar mv

instance Class.HasTezosClient MorleyClientM where
  signBytes (AddressWithAlias _ senderAlias) mbPassword opHash = retryOnceOnTimeout $ do
    env <- ask
    case mceSecretKey env of
      Just sk -> pure . SignatureEd25519 $ Ed25519.sign sk opHash
      Nothing -> signBytes senderAlias mbPassword opHash
  rememberContract = failOnTimeout ... rememberContract
  getAliasesAndAddresses = retryOnceOnTimeout ... getAliasesAndAddresses
  genKey alias = flip AddressWithAlias alias <$> genKey alias
  genFreshKey alias = flip AddressWithAlias alias <$> genFreshKey alias
  getKeyPassword (AddressWithAlias _ alias) = retryOnceOnTimeout $ getKeyPassword alias
  getPublicKey (AddressWithAlias _ alias) = getPublicKey alias