-- 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

  -- * @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, zeroMutez)
import Morley.Util.Exception as E (throwLeft)

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

-- | Convert 'EpName' to the textual representation used by RPC and tezos-client.
epNameToTezosEp :: EpName -> Text
epNameToTezosEp :: EpName -> Text
epNameToTezosEp = \case
  EpName
DefEpName -> Text
"default"
  EpName
epName -> EpName -> Text
unEpName EpName
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 :: Value -> [Address]
extractAddressesFromValue Value
val =
  ([Address] -> [Address] -> [Address])
-> GenericQ [Address] -> Value -> [Address]
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
(<>) ([Address] -> (Value -> [Address]) -> a -> [Address]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ [] Value -> [Address]
fetchAddress) Value
val
  where
    fetchAddress :: Value -> [Address]
    fetchAddress :: Value -> [Address]
fetchAddress = \case
      ValueString MText
s -> case Text -> Either ParseEpAddressError EpAddress
parseEpAddress (MText -> Text
unMText MText
s) of
        Right EpAddress
addr -> [EpAddress -> Address
eaAddress EpAddress
addr]
        Left ParseEpAddressError
_ -> []
      ValueBytes (InternalByteString ByteString
b) -> case ByteString -> Either ParseAddressRawError Address
parseAddressRaw ByteString
b of
        Right Address
addr -> [Address
addr]
        Left ParseAddressRawError
_ -> []
      Value
_ -> []

-- | A structure with all the parameters for 'runContract'
data RunContractParameters cp st = RunContractParameters
  { RunContractParameters cp st -> Contract cp st
rcpContract :: T.Contract cp st
  , RunContractParameters cp st -> MaybeRPC (Value cp)
rcpParameter :: MaybeRPC (T.Value cp)
  , RunContractParameters cp st -> MaybeRPC (Value st)
rcpStorage :: MaybeRPC (T.Value st)
  , RunContractParameters cp st -> Mutez
rcpBalance :: Mutez
  , RunContractParameters cp st -> Mutez
rcpAmount :: Mutez
  , RunContractParameters cp st -> Maybe Address
rcpSender :: Maybe Address
  , RunContractParameters cp st -> 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
-> MaybeRPC (Value cp)
-> MaybeRPC (Value st)
-> RunContractParameters cp st
runContractParameters Contract cp st
contract MaybeRPC (Value cp)
cp MaybeRPC (Value st)
st =
  RunContractParameters :: forall (cp :: T) (st :: T).
Contract cp st
-> MaybeRPC (Value cp)
-> MaybeRPC (Value st)
-> Mutez
-> Mutez
-> Maybe Address
-> Maybe Address
-> RunContractParameters cp st
RunContractParameters
    { rcpContract :: Contract cp st
rcpContract = Contract cp st
contract
    , rcpParameter :: MaybeRPC (Value cp)
rcpParameter = MaybeRPC (Value cp)
cp
    , rcpStorage :: MaybeRPC (Value st)
rcpStorage = MaybeRPC (Value st)
st
    , rcpBalance :: Mutez
rcpBalance = Mutez
zeroMutez
    , rcpAmount :: Mutez
rcpAmount = Mutez
zeroMutez
    , rcpSender :: Maybe Address
rcpSender = Maybe Address
forall a. Maybe a
Nothing
    , rcpSource :: Maybe Address
rcpSource = Maybe Address
forall a. Maybe a
Nothing
    }

makeLensesFor
  [ ("rcpBalance", "withBalance")
  , ("rcpAmount", "withAmount")
  , ("rcpSender", "withSender")
  , ("rcpSource", "withSource")
  ]
  ''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 cp st -> m (AsRPC (Value st))
runContract RunContractParameters{Maybe Address
Mutez
Contract cp st
MaybeRPC (Value cp)
MaybeRPC (Value st)
rcpSource :: Maybe Address
rcpSender :: Maybe Address
rcpAmount :: Mutez
rcpBalance :: Mutez
rcpStorage :: MaybeRPC (Value st)
rcpParameter :: MaybeRPC (Value cp)
rcpContract :: Contract cp st
rcpSource :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> Maybe Address
rcpSender :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> Maybe Address
rcpAmount :: forall (cp :: T) (st :: T). RunContractParameters cp st -> Mutez
rcpBalance :: forall (cp :: T) (st :: T). RunContractParameters cp st -> Mutez
rcpStorage :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> MaybeRPC (Value st)
rcpParameter :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> MaybeRPC (Value cp)
rcpContract :: forall (cp :: T) (st :: T).
RunContractParameters cp st -> Contract cp st
..} = do
  BlockConstants
headConstants <- BlockId -> m BlockConstants
forall (m :: * -> *). HasTezosRpc m => BlockId -> m BlockConstants
getBlockConstants BlockId
HeadId
  let args :: RunCode
args = RunCode :: Expression
-> Expression
-> Expression
-> TezosMutez
-> TezosMutez
-> Text
-> Maybe Address
-> Maybe Address
-> RunCode
RunCode
        { rcScript :: Expression
rcScript = Contract cp st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract cp st
rcpContract
        , rcStorage :: Expression
rcStorage = MaybeRPC (Value st) -> Expression
forall a. ToExpression a => a -> Expression
toExpression MaybeRPC (Value st)
rcpStorage
        , rcInput :: Expression
rcInput = MaybeRPC (Value cp) -> Expression
forall a. ToExpression a => a -> Expression
toExpression MaybeRPC (Value cp)
rcpParameter
        , rcAmount :: TezosMutez
rcAmount = Mutez -> TezosMutez
TezosMutez Mutez
rcpAmount
        , rcBalance :: TezosMutez
rcBalance = Mutez -> TezosMutez
TezosMutez Mutez
rcpBalance
        , rcChainId :: Text
rcChainId = BlockConstants -> Text
bcChainId BlockConstants
headConstants
        -- 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 :: Maybe Address
rcSource = Maybe Address
rcpSender
        , rcPayer :: Maybe Address
rcPayer = Maybe Address
rcpSource
        }
  RunCodeResult
res <- RunCode -> m RunCodeResult
forall (m :: * -> *). HasTezosRpc m => RunCode -> m RunCodeResult
runCode RunCode
args
  forall a.
(MonadThrow m, Exception FromExpressionError) =>
m (Either FromExpressionError a) -> m a
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
m (Either e a) -> m a
throwLeft @_ @FromExpressionError (m (Either FromExpressionError (Value (TAsRPC st)))
 -> m (Value (TAsRPC st)))
-> m (Either FromExpressionError (Value (TAsRPC st)))
-> m (Value (TAsRPC st))
forall a b. (a -> b) -> a -> b
$ Either FromExpressionError (Value (TAsRPC st))
-> m (Either FromExpressionError (Value (TAsRPC st)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FromExpressionError (Value (TAsRPC st))
 -> m (Either FromExpressionError (Value (TAsRPC st))))
-> Either FromExpressionError (Value (TAsRPC st))
-> m (Either FromExpressionError (Value (TAsRPC st)))
forall a b. (a -> b) -> a -> b
$
    Expression -> Either FromExpressionError (AsRPC (Value st))
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @(AsRPC (T.Value st)) (RunCodeResult -> Expression
rcrStorage RunCodeResult
res)
      (StorageScope (TAsRPC st) =>
 Either FromExpressionError (Value (TAsRPC st)))
-> (StorageScope st :- StorageScope (TAsRPC st))
-> Either FromExpressionError (Value (TAsRPC st))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ StorageScope st :- StorageScope (TAsRPC st)
forall (t :: T). StorageScope t :- StorageScope (TAsRPC t)
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 :: m ScrubbedBytes
readScrubbedBytes = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> ScrubbedBytes) -> m ByteString -> m ScrubbedBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
BS.getLine

-- | Convert @ScrubbedBytes@ to @String@, so that it can be passed to @tezos-client@
-- as a stdin
scrubbedBytesToString :: ScrubbedBytes -> String
scrubbedBytesToString :: ScrubbedBytes -> String
scrubbedBytesToString = ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> String)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ScrubbedBytes, ByteArray ByteString) =>
ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert @ScrubbedBytes @ByteString