-- 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 :: 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
_ -> []

-- | 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 :: Contract cp st
-> Value cp -> Value st -> Mutez -> m (AsRPC (Value st))
runContractSimple Contract cp st
rcpContract Value cp
rcpParameter Value st
rcpStorage Mutez
rcpBalance =
  let rcpSender :: Maybe a
rcpSender = Maybe a
forall a. Maybe a
Nothing
      rcpSource :: Maybe a
rcpSource = Maybe a
forall a. Maybe a
Nothing
      rcpAmount :: Mutez
rcpAmount = Mutez
zeroMutez
  in RunContractParameters cp st -> m (AsRPC (Value st))
forall (cp :: T) (st :: T) (m :: * -> *).
(HasTezosRpc m, ParameterScope cp, StorageScope st) =>
RunContractParameters cp st -> m (AsRPC (Value st))
runContract RunContractParameters :: forall (cp :: T) (st :: T).
Contract cp st
-> Value cp
-> Value st
-> Mutez
-> Mutez
-> Maybe Address
-> Maybe Address
-> RunContractParameters cp st
RunContractParameters {Maybe Address
Mutez
Value cp
Value st
Contract cp st
forall a. Maybe a
rcpSource :: Maybe Address
rcpSender :: Maybe Address
rcpAmount :: Mutez
rcpBalance :: Mutez
rcpStorage :: Value st
rcpParameter :: Value cp
rcpContract :: Contract cp st
rcpAmount :: Mutez
rcpSource :: forall a. Maybe a
rcpSender :: forall a. Maybe a
rcpBalance :: Mutez
rcpStorage :: Value st
rcpParameter :: Value cp
rcpContract :: Contract cp st
..}

-- | 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 -> Value cp
rcpParameter :: T.Value cp
  , RunContractParameters cp st -> Value st
rcpStorage :: 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
  }

-- | 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 cp st -> m (AsRPC (Value st))
runContract RunContractParameters{Maybe Address
Mutez
Value cp
Value st
Contract cp st
rcpSource :: Maybe Address
rcpSender :: Maybe Address
rcpAmount :: Mutez
rcpBalance :: Mutez
rcpStorage :: Value st
rcpParameter :: 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 -> Value st
rcpParameter :: forall (cp :: T) (st :: T). RunContractParameters cp st -> 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 = Value st -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value st
rcpStorage
        , rcInput :: Expression
rcInput = Value cp -> Expression
forall a. ToExpression a => a -> Expression
toExpression 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
        , 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' Instr (AsRPC st)))
 -> m (Value' Instr (AsRPC st)))
-> m (Either FromExpressionError (Value' Instr (AsRPC st)))
-> m (Value' Instr (AsRPC st))
forall a b. (a -> b) -> a -> b
$ Either FromExpressionError (Value' Instr (AsRPC st))
-> m (Either FromExpressionError (Value' Instr (AsRPC st)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FromExpressionError (Value' Instr (AsRPC st))
 -> m (Either FromExpressionError (Value' Instr (AsRPC st))))
-> Either FromExpressionError (Value' Instr (AsRPC st))
-> m (Either FromExpressionError (Value' Instr (AsRPC 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 (AsRPC st) =>
 Either FromExpressionError (Value' Instr (AsRPC st)))
-> (StorageScope st :- StorageScope (AsRPC st))
-> Either FromExpressionError (Value' Instr (AsRPC st))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ StorageScope st :- StorageScope (AsRPC st)
forall (t :: T). StorageScope t :- StorageScope (AsRPC t)
rpcStorageScopeEvi @st
      (HasNoBigMap (AsRPC st) =>
 Either FromExpressionError (Value' Instr (AsRPC st)))
-> Dict (HasNoBigMap (AsRPC st))
-> Either FromExpressionError (Value' Instr (AsRPC st))
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ SingI st => Dict (HasNoBigMap (AsRPC st))
forall (t :: T). SingI t => Dict (HasNoBigMap (AsRPC t))
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 :: 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