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

  -- * @octez-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, 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 (untypeValue)
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 @octez-client@'s
-- "not a mainnet" warning
disableAlphanetWarning :: IO ()
disableAlphanetWarning = setEnv "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" "YES"

-- | Convert 'EpName' to the textual representation used by RPC and @octez-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 :: Value
  -- ^ The parameter value should have the same "structure" as @cp@, except it _may_ also have big_map IDs.
  -- E.g. if the contract's parameter is @pair (big_map string string) (big_map string string)@,
  -- then 'rcpParameter' may be one of:
  --
  -- * @pair (big_map string string) (big_map string string)@
  -- * @pair nat (big_map string string)@
  -- * @pair (big_map string string) nat@
  -- * @pair nat nat@
  --
  -- ... where @nat@ represents a big_map ID.
  , rcpStorage :: Value
  -- ^ The storage value should have the same "structure" as @st@, except it _may_ also have big_map IDs.
  -- See the documentation of 'rcpParameter'.
  , rcpBalance :: Mutez
  , rcpNow :: Maybe Timestamp
  , rcpLevel :: Maybe Natural
  , rcpAmount :: Mutez
  , rcpSender :: Maybe ImplicitAddress
  , rcpSource :: Maybe ImplicitAddress
  }

-- | Initializes the parameters for `runContract` with sensible defaults.
--
-- Use the @with*@ lenses to set any optional parameters.
runContractParameters
  :: (T.ForbidOp cp, T.ForbidOp st)
  => T.Contract cp st -> T.Value cp -> T.Value st
  -> RunContractParameters cp st
runContractParameters contract cp st =
  RunContractParameters
    { rcpContract = contract
    , rcpParameter = untypeValue cp
    , rcpStorage = untypeValue 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.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 @octez-client@
-- as a stdin
scrubbedBytesToString :: ScrubbedBytes -> String
scrubbedBytesToString = decodeUtf8 . convert @ScrubbedBytes @ByteString