Util.hs

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

module Morley.Client.Util
  ( epNameToTezosEp
  , extractAddressesFromValue
  , disableAlphanetWarning
  -- * @runContract@
  , runContract
  , RunContractParameters(..)
  , runContractParameters
  , withBalance
  , withAmount
  , withSender
  , withSource
  , withLevel
  , withNow

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

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

import Morley.AsRPC (AsRPC, MaybeRPC, rpcStorageScopeEvi)
import Morley.Client.RPC.Class
import Morley.Client.RPC.Getters
import Morley.Client.RPC.Types
import Morley.Micheline
import Morley.Michelson.Text
import Morley.Michelson.Typed qualified as T
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, Timestamp(..), 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 _ -> []
      _ -> []

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

-- | Initializes the parameters for `runContract` with sensible defaults.
--
-- Use the @with*@ lenses to set any optional parameters.
runContractParameters
  :: T.Contract cp st -> MaybeRPC (T.Value cp) -> MaybeRPC (T.Value st)
  -> RunContractParameters cp st
runContractParameters contract cp st =
  RunContractParameters
    { rcpContract = contract
    , rcpParameter = cp
    , rcpStorage = st
    , rcpBalance = zeroMutez
    , rcpAmount = zeroMutez
    , rcpNow = Nothing
    , rcpLevel = Nothing
    , rcpSender = Nothing
    , rcpSource = Nothing
    }

makeLensesFor
  [ ("rcpBalance", "withBalance")
  , ("rcpAmount", "withAmount")
  , ("rcpSender", "withSender")
  , ("rcpSource", "withSource")
  , ("rcpLevel", "withLevel")
  , ("rcpNow", "withNow")
  ]
  ''RunContractParameters

-- | Run contract with given parameter and storage and get new storage without
-- injecting anything to the chain.
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
        , rcNow = rcpNow <&> StringEncode . round . unTimestamp
        , rcLevel = StringEncode <$> rcpLevel
        -- Note: assigning source=sender and payer=source may seem like a bug, but it's not.
        -- For some reason, the /run_code uses a different naming scheme.
        -- What this endpoint calls 'source' is actually the address that will be returned by the `SENDER` instruction.
        -- See details here: https://gitlab.com/tezos/tezos/-/issues/710
        , rcSource = rcpSender
        , rcPayer = rcpSource
        }
  res <- runCode args
  throwLeft @_ @FromExpressionError $ pure $
    fromExpression @(AsRPC (T.Value st)) (rcrStorage res)
      \\ rpcStorageScopeEvi @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