Util.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Morley.Client.Util
  ( epNameToTezosEp
  , extractAddressesFromValue
  , disableAlphanetWarning
  , runContract
  , runContractSimple
  , RunContractParameters(..)

  -- tezos-client password-related helpers
  , scrubbedBytesToString
  , readScrubbedBytes
  ) where

import Data.ByteArray (ScrubbedBytes, convert)
import qualified Data.ByteString as BS (getLine)
import Data.Constraint ((\\))
import Generics.SYB (everything, mkQ)
import System.Environment (setEnv)

import Morley.Client.RPC.AsRPC (AsRPC, rpcHasNoBigMapEvi, rpcStorageScopeEvi)
import Morley.Client.RPC.Class
import Morley.Client.RPC.Getters
import Morley.Client.RPC.Types
import Morley.Micheline
import Morley.Michelson.Text
import qualified Morley.Michelson.Typed as T (Contract, ParameterScope, StorageScope, Value)
import Morley.Michelson.Typed.Entrypoints (EpAddress(..), parseEpAddress)
import Morley.Michelson.Untyped (InternalByteString(..), Value, Value'(..))
import Morley.Michelson.Untyped.Entrypoints (EpName(..), pattern DefEpName)
import Morley.Tezos.Address
import Morley.Tezos.Core (Mutez, zeroMutez)
import Morley.Util.Exception as E (throwLeft)

-- | Sets the environment variable for disabling tezos-client
-- "not a mainnet" warning
disableAlphanetWarning :: IO ()
disableAlphanetWarning = setEnv "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" "YES"

-- | Convert 'EpName' to the textual representation used by RPC and tezos-client.
epNameToTezosEp :: EpName -> Text
epNameToTezosEp = \case
  DefEpName -> "default"
  epName -> unEpName epName

-- | Extract all addresses value from given untyped 'Value'.
--
-- Note that it returns all values that can be used as an address.
-- However, some of fetched values can never be used as an address.
extractAddressesFromValue :: Value -> [Address]
extractAddressesFromValue val =
  everything (<>) (mkQ [] fetchAddress) val
  where
    fetchAddress :: Value -> [Address]
    fetchAddress = \case
      ValueString s -> case parseEpAddress (unMText s) of
        Right addr -> [eaAddress addr]
        Left _ -> []
      ValueBytes (InternalByteString b) -> case parseAddressRaw b of
        Right addr -> [addr]
        Left _ -> []
      _ -> []

-- | Simplified version of 'runContract' for convenience
--
-- Sets transfer amount to 0 and sender and source are both unspecified.
runContractSimple
  :: forall cp st m. (HasTezosRpc m, T.ParameterScope cp, T.StorageScope st)
  => T.Contract cp st -- ^ Contract
  -> T.Value cp -- ^ Parameter passed to the contract
  -> T.Value st -- ^ Initial storage
  -> Mutez -- ^ Initial balance
  -> m (AsRPC (T.Value st))
runContractSimple rcpContract rcpParameter rcpStorage rcpBalance =
  let rcpSender = Nothing
      rcpSource = Nothing
      rcpAmount = zeroMutez
  in runContract RunContractParameters {..}

-- | A structure with all the parameters for 'runContract'
data RunContractParameters cp st = RunContractParameters
  { rcpContract :: T.Contract cp st
  , rcpParameter :: T.Value cp
  , rcpStorage :: T.Value st
  , rcpBalance :: Mutez
  , rcpAmount :: Mutez
  , rcpSender :: Maybe Address
  , rcpSource :: Maybe Address
  }

-- | Run contract with given parameter and storage and get new storage without
-- injecting anything to the chain.
--
-- Storage type is limited to not have any bigmaps because their updates are treated differently
-- in node RPC and its quite nontrivial to properly support storage update when storage type
-- contains bigmaps.
runContract
  :: forall cp st m. (HasTezosRpc m, T.ParameterScope cp, T.StorageScope st)
  => RunContractParameters cp st -> m (AsRPC (T.Value st))
runContract RunContractParameters{..} = do
  headConstants <- getBlockConstants HeadId
  let args = RunCode
        { rcScript = toExpression rcpContract
        , rcStorage = toExpression rcpStorage
        , rcInput = toExpression rcpParameter
        , rcAmount = TezosMutez rcpAmount
        , rcBalance = TezosMutez rcpBalance
        , rcChainId = bcChainId headConstants
        , rcSource = rcpSender
        , rcPayer = rcpSource
        }
  res <- runCode args
  throwLeft @_ @FromExpressionError $ pure $
    fromExpression @(AsRPC (T.Value st)) (rcrStorage res)
      \\ rpcStorageScopeEvi @st
      \\ rpcHasNoBigMapEvi @st

-- | Function for relatively safe getting password from stdin.
-- After reading bytes are converted to @ScrubbedBytes@, thus it's harder
-- to accidentally leak them.
readScrubbedBytes :: MonadIO m => m ScrubbedBytes
readScrubbedBytes = convert <$> liftIO BS.getLine

-- | Convert @ScrubbedBytes@ to @String@, so that it can be passed to @tezos-client@
-- as a stdin
scrubbedBytesToString :: ScrubbedBytes -> String
scrubbedBytesToString = decodeUtf8 . convert @ScrubbedBytes @ByteString