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

-- | An alternative implementation of @morley-client@ that does not require
-- @octez-client@ and has some limitations because of that (not all methods
-- are implemented).

module Morley.Client.OnlyRPC
  ( MorleyOnlyRpcEnv (..)
  , mkMorleyOnlyRpcEnv

  , MorleyOnlyRpcM (..)
  , runMorleyOnlyRpcM
  ) where

import Colog (HasLog(..), Message)
import Control.Lens (at)
import Data.Map.Strict qualified as Map
import Fmt (pretty, (+|), (|+))
import Servant.Client (BaseUrl, ClientEnv)
import Servant.Client.Core (RunClient(..))
import UnliftIO (MonadUnliftIO)

import Morley.Client.App
import Morley.Client.Init
import Morley.Client.Logging (ClientLogAction)
import Morley.Client.RPC.Class (HasTezosRpc(..))
import Morley.Client.RPC.HttpClient (newClientEnv)
import Morley.Client.TezosClient.Class (HasTezosClient(..))
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Crypto (SecretKey, sign, toPublic)

----------------
-- Environment
----------------

-- | Environment used by 'MorleyOnlyRpcM'.
data MorleyOnlyRpcEnv = MorleyOnlyRpcEnv
  { MorleyOnlyRpcEnv -> ClientLogAction MorleyOnlyRpcM
moreLogAction :: ClientLogAction MorleyOnlyRpcM
  -- ^ Action used to log messages.
  , MorleyOnlyRpcEnv -> ClientEnv
moreClientEnv :: ClientEnv
  -- ^ Environment necessary to make HTTP calls.
  , MorleyOnlyRpcEnv -> Map ImplicitAddress SecretKey
moreSecretKeys :: Map ImplicitAddress SecretKey
  -- ^ In-memory secret keys that can be used for signing.
  }

-- | Construct 'MorleyOnlyRpcEnv'.
--
-- * Full 'MorleyClientConfig' is not passed because we need just 2 things from it.
-- * Log action is built the same way as for t'Morley.Client.MorleyClientEnv'.
-- * All secret keys are passed as an argument.
mkMorleyOnlyRpcEnv ::
  [SecretKey] -> BaseUrl -> Word -> IO MorleyOnlyRpcEnv
mkMorleyOnlyRpcEnv :: [SecretKey] -> BaseUrl -> Word -> IO MorleyOnlyRpcEnv
mkMorleyOnlyRpcEnv [SecretKey]
secretKeys BaseUrl
endpoint Word
verbosity = do
  ClientEnv
clientEnv <- BaseUrl -> IO ClientEnv
newClientEnv BaseUrl
endpoint
  pure MorleyOnlyRpcEnv :: ClientLogAction MorleyOnlyRpcM
-> ClientEnv -> Map ImplicitAddress SecretKey -> MorleyOnlyRpcEnv
MorleyOnlyRpcEnv
    { moreLogAction :: ClientLogAction MorleyOnlyRpcM
moreLogAction = Word -> ClientLogAction MorleyOnlyRpcM
forall (m :: * -> *). MonadIO m => Word -> ClientLogAction m
mkLogAction Word
verbosity
    , moreClientEnv :: ClientEnv
moreClientEnv = ClientEnv
clientEnv
    , moreSecretKeys :: Map ImplicitAddress SecretKey
moreSecretKeys =
      [(ImplicitAddress, SecretKey)] -> Map ImplicitAddress SecretKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ImplicitAddress, SecretKey)] -> Map ImplicitAddress SecretKey)
-> [(ImplicitAddress, SecretKey)] -> Map ImplicitAddress SecretKey
forall a b. (a -> b) -> a -> b
$ (SecretKey -> (ImplicitAddress, SecretKey))
-> [SecretKey] -> [(ImplicitAddress, SecretKey)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\SecretKey
sk -> (PublicKey -> ImplicitAddress
mkKeyAddress (SecretKey -> PublicKey
toPublic SecretKey
sk), SecretKey
sk)) [SecretKey]
secretKeys
    }

----------------
-- Monad
----------------

-- | Monad that implements 'HasTezosClient' and 'HasTezosRpc' classes and
-- can be used for high-level actions as an alternative to t'Morley.Client.MorleyClientM'.
newtype MorleyOnlyRpcM a = MorleyOnlyRpcM
  { forall a. MorleyOnlyRpcM a -> ReaderT MorleyOnlyRpcEnv IO a
unMorleyOnlyRpcM :: ReaderT MorleyOnlyRpcEnv IO a }
  deriving newtype
    ( (forall a b. (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b)
-> (forall a b. a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a)
-> Functor MorleyOnlyRpcM
forall a b. a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
forall a b. (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
$c<$ :: forall a b. a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
fmap :: forall a b. (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
$cfmap :: forall a b. (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
Functor, Functor MorleyOnlyRpcM
Functor MorleyOnlyRpcM
-> (forall a. a -> MorleyOnlyRpcM a)
-> (forall a b.
    MorleyOnlyRpcM (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b)
-> (forall a b c.
    (a -> b -> c)
    -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM c)
-> (forall a b.
    MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b)
-> (forall a b.
    MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a)
-> Applicative MorleyOnlyRpcM
forall a. a -> MorleyOnlyRpcM a
forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
forall a b.
MorleyOnlyRpcM (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
forall a b c.
(a -> b -> c)
-> MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
$c<* :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
*> :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
$c*> :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
liftA2 :: forall a b c.
(a -> b -> c)
-> MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM c
<*> :: forall a b.
MorleyOnlyRpcM (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
$c<*> :: forall a b.
MorleyOnlyRpcM (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
pure :: forall a. a -> MorleyOnlyRpcM a
$cpure :: forall a. a -> MorleyOnlyRpcM a
Applicative, Applicative MorleyOnlyRpcM
Applicative MorleyOnlyRpcM
-> (forall a b.
    MorleyOnlyRpcM a -> (a -> MorleyOnlyRpcM b) -> MorleyOnlyRpcM b)
-> (forall a b.
    MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b)
-> (forall a. a -> MorleyOnlyRpcM a)
-> Monad MorleyOnlyRpcM
forall a. a -> MorleyOnlyRpcM a
forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
forall a b.
MorleyOnlyRpcM a -> (a -> MorleyOnlyRpcM b) -> MorleyOnlyRpcM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> MorleyOnlyRpcM a
$creturn :: forall a. a -> MorleyOnlyRpcM a
>> :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
$c>> :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
>>= :: forall a b.
MorleyOnlyRpcM a -> (a -> MorleyOnlyRpcM b) -> MorleyOnlyRpcM b
$c>>= :: forall a b.
MorleyOnlyRpcM a -> (a -> MorleyOnlyRpcM b) -> MorleyOnlyRpcM b
Monad, MonadReader MorleyOnlyRpcEnv
    , Monad MorleyOnlyRpcM
Monad MorleyOnlyRpcM
-> (forall a. IO a -> MorleyOnlyRpcM a) -> MonadIO MorleyOnlyRpcM
forall a. IO a -> MorleyOnlyRpcM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> MorleyOnlyRpcM a
$cliftIO :: forall a. IO a -> MorleyOnlyRpcM a
MonadIO, Monad MorleyOnlyRpcM
Monad MorleyOnlyRpcM
-> (forall e a. Exception e => e -> MorleyOnlyRpcM a)
-> MonadThrow MorleyOnlyRpcM
forall e a. Exception e => e -> MorleyOnlyRpcM a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> MorleyOnlyRpcM a
$cthrowM :: forall e a. Exception e => e -> MorleyOnlyRpcM a
MonadThrow, MonadThrow MorleyOnlyRpcM
MonadThrow MorleyOnlyRpcM
-> (forall e a.
    Exception e =>
    MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a)
-> MonadCatch MorleyOnlyRpcM
forall e a.
Exception e =>
MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a
$ccatch :: forall e a.
Exception e =>
MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a
MonadCatch, MonadCatch MorleyOnlyRpcM
MonadCatch MorleyOnlyRpcM
-> (forall b.
    ((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
     -> MorleyOnlyRpcM b)
    -> MorleyOnlyRpcM b)
-> (forall b.
    ((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
     -> MorleyOnlyRpcM b)
    -> MorleyOnlyRpcM b)
-> (forall a b c.
    MorleyOnlyRpcM a
    -> (a -> ExitCase b -> MorleyOnlyRpcM c)
    -> (a -> MorleyOnlyRpcM b)
    -> MorleyOnlyRpcM (b, c))
-> MonadMask MorleyOnlyRpcM
forall b.
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
forall a b c.
MorleyOnlyRpcM a
-> (a -> ExitCase b -> MorleyOnlyRpcM c)
-> (a -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
MorleyOnlyRpcM a
-> (a -> ExitCase b -> MorleyOnlyRpcM c)
-> (a -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM (b, c)
$cgeneralBracket :: forall a b c.
MorleyOnlyRpcM a
-> (a -> ExitCase b -> MorleyOnlyRpcM c)
-> (a -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM (b, c)
uninterruptibleMask :: forall b.
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
$cuninterruptibleMask :: forall b.
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
mask :: forall b.
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
$cmask :: forall b.
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
MonadMask, MonadIO MorleyOnlyRpcM
MonadIO MorleyOnlyRpcM
-> (forall b.
    ((forall a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b)
-> MonadUnliftIO MorleyOnlyRpcM
forall b.
((forall a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b.
((forall a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b
$cwithRunInIO :: forall b.
((forall a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b
MonadUnliftIO
    )

-- | Run 'MorleyOnlyRpcM' action within given 'MorleyOnlyRpcEnv'. Retry action
-- in case of invalid counter error.
runMorleyOnlyRpcM :: MorleyOnlyRpcEnv -> MorleyOnlyRpcM a -> IO a
runMorleyOnlyRpcM :: forall a. MorleyOnlyRpcEnv -> MorleyOnlyRpcM a -> IO a
runMorleyOnlyRpcM MorleyOnlyRpcEnv
env MorleyOnlyRpcM a
action = ReaderT MorleyOnlyRpcEnv IO a -> MorleyOnlyRpcEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (MorleyOnlyRpcM a -> ReaderT MorleyOnlyRpcEnv IO a
forall a. MorleyOnlyRpcM a -> ReaderT MorleyOnlyRpcEnv IO a
unMorleyOnlyRpcM MorleyOnlyRpcM a
action) MorleyOnlyRpcEnv
env

----------------
-- Exceptions
----------------

-- | This exception is thrown in methods that are completely unsupported.
data UnsupportedByOnlyRPC = UnsupportedByOnlyRPC Text
  deriving stock (Int -> UnsupportedByOnlyRPC -> ShowS
[UnsupportedByOnlyRPC] -> ShowS
UnsupportedByOnlyRPC -> String
(Int -> UnsupportedByOnlyRPC -> ShowS)
-> (UnsupportedByOnlyRPC -> String)
-> ([UnsupportedByOnlyRPC] -> ShowS)
-> Show UnsupportedByOnlyRPC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsupportedByOnlyRPC] -> ShowS
$cshowList :: [UnsupportedByOnlyRPC] -> ShowS
show :: UnsupportedByOnlyRPC -> String
$cshow :: UnsupportedByOnlyRPC -> String
showsPrec :: Int -> UnsupportedByOnlyRPC -> ShowS
$cshowsPrec :: Int -> UnsupportedByOnlyRPC -> ShowS
Show, UnsupportedByOnlyRPC -> UnsupportedByOnlyRPC -> Bool
(UnsupportedByOnlyRPC -> UnsupportedByOnlyRPC -> Bool)
-> (UnsupportedByOnlyRPC -> UnsupportedByOnlyRPC -> Bool)
-> Eq UnsupportedByOnlyRPC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsupportedByOnlyRPC -> UnsupportedByOnlyRPC -> Bool
$c/= :: UnsupportedByOnlyRPC -> UnsupportedByOnlyRPC -> Bool
== :: UnsupportedByOnlyRPC -> UnsupportedByOnlyRPC -> Bool
$c== :: UnsupportedByOnlyRPC -> UnsupportedByOnlyRPC -> Bool
Eq)

instance Exception UnsupportedByOnlyRPC where
  displayException :: UnsupportedByOnlyRPC -> String
displayException (UnsupportedByOnlyRPC Text
method) =
    Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Method '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
method Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is not supported in only-RPC mode"

-- | This exception is thrown when something goes wrong in supported methods.
data MorleyOnlyRpcException = UnknownSecretKeyFor ImplicitAddress
  deriving stock (Int -> MorleyOnlyRpcException -> ShowS
[MorleyOnlyRpcException] -> ShowS
MorleyOnlyRpcException -> String
(Int -> MorleyOnlyRpcException -> ShowS)
-> (MorleyOnlyRpcException -> String)
-> ([MorleyOnlyRpcException] -> ShowS)
-> Show MorleyOnlyRpcException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MorleyOnlyRpcException] -> ShowS
$cshowList :: [MorleyOnlyRpcException] -> ShowS
show :: MorleyOnlyRpcException -> String
$cshow :: MorleyOnlyRpcException -> String
showsPrec :: Int -> MorleyOnlyRpcException -> ShowS
$cshowsPrec :: Int -> MorleyOnlyRpcException -> ShowS
Show, MorleyOnlyRpcException -> MorleyOnlyRpcException -> Bool
(MorleyOnlyRpcException -> MorleyOnlyRpcException -> Bool)
-> (MorleyOnlyRpcException -> MorleyOnlyRpcException -> Bool)
-> Eq MorleyOnlyRpcException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MorleyOnlyRpcException -> MorleyOnlyRpcException -> Bool
$c/= :: MorleyOnlyRpcException -> MorleyOnlyRpcException -> Bool
== :: MorleyOnlyRpcException -> MorleyOnlyRpcException -> Bool
$c== :: MorleyOnlyRpcException -> MorleyOnlyRpcException -> Bool
Eq)

instance Exception MorleyOnlyRpcException where
  displayException :: MorleyOnlyRpcException -> String
displayException = \case
    UnknownSecretKeyFor ImplicitAddress
addr -> Builder
"Secret key is unknown for " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| ImplicitAddress
addr ImplicitAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

----------------
-- Instances (implementation)
----------------

instance HasLog MorleyOnlyRpcEnv Message MorleyOnlyRpcM where
  getLogAction :: MorleyOnlyRpcEnv -> ClientLogAction MorleyOnlyRpcM
getLogAction = MorleyOnlyRpcEnv -> ClientLogAction MorleyOnlyRpcM
moreLogAction
  setLogAction :: ClientLogAction MorleyOnlyRpcM
-> MorleyOnlyRpcEnv -> MorleyOnlyRpcEnv
setLogAction ClientLogAction MorleyOnlyRpcM
action MorleyOnlyRpcEnv
mce = MorleyOnlyRpcEnv
mce { moreLogAction :: ClientLogAction MorleyOnlyRpcM
moreLogAction = ClientLogAction MorleyOnlyRpcM
action }

-- [#652] We may implement more methods here if the need arises.
instance HasTezosClient MorleyOnlyRpcM where
  signBytes :: ImplicitAddressOrAlias
-> Maybe ScrubbedBytes -> ByteString -> MorleyOnlyRpcM Signature
signBytes ImplicitAddressOrAlias
sender Maybe ScrubbedBytes
_password ByteString
opHash = case ImplicitAddressOrAlias
sender of
    AddressAlias {} -> UnsupportedByOnlyRPC -> MorleyOnlyRpcM Signature
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM Signature)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM Signature
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"signBytes (AddressAlias _)"
    AddressResolved ImplicitAddress
address -> do
      MorleyOnlyRpcEnv
env <- MorleyOnlyRpcM MorleyOnlyRpcEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
      case MorleyOnlyRpcEnv -> Map ImplicitAddress SecretKey
moreSecretKeys MorleyOnlyRpcEnv
env Map ImplicitAddress SecretKey
-> Getting
     (Maybe SecretKey) (Map ImplicitAddress SecretKey) (Maybe SecretKey)
-> Maybe SecretKey
forall s a. s -> Getting a s a -> a
^. Index (Map ImplicitAddress SecretKey)
-> Lens'
     (Map ImplicitAddress SecretKey)
     (Maybe (IxValue (Map ImplicitAddress SecretKey)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ImplicitAddress SecretKey)
ImplicitAddress
address of
        Maybe SecretKey
Nothing -> MorleyOnlyRpcException -> MorleyOnlyRpcM Signature
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MorleyOnlyRpcException -> MorleyOnlyRpcM Signature)
-> MorleyOnlyRpcException -> MorleyOnlyRpcM Signature
forall a b. (a -> b) -> a -> b
$ ImplicitAddress -> MorleyOnlyRpcException
UnknownSecretKeyFor ImplicitAddress
address
        Just SecretKey
secretKey -> IO Signature -> MorleyOnlyRpcM Signature
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Signature -> MorleyOnlyRpcM Signature)
-> IO Signature -> MorleyOnlyRpcM Signature
forall a b. (a -> b) -> a -> b
$ SecretKey -> ByteString -> IO Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
secretKey ByteString
opHash

  -- In RPC-only mode we only use unencrypted in-memory passwords.
  getKeyPassword :: ImplicitAddress -> MorleyOnlyRpcM (Maybe ScrubbedBytes)
getKeyPassword ImplicitAddress
_ = Maybe ScrubbedBytes -> MorleyOnlyRpcM (Maybe ScrubbedBytes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ScrubbedBytes
forall a. Maybe a
Nothing

  -- Stateful actions that simply do nothing because there is no persistent state.
  rememberContract :: AliasBehavior
-> ContractAddress -> ContractAlias -> MorleyOnlyRpcM ()
rememberContract = \AliasBehavior
_ ContractAddress
_ ContractAlias
_ -> MorleyOnlyRpcM ()
forall (f :: * -> *). Applicative f => f ()
pass

  -- We return a dummy alias here, because this function is used in a lot of
  -- places and with an exception here it's not possible to send transactions.
  -- So be aware of this and do not rely on this value!
  -- TODO [#652] [#910]: consider using a `Map` instead
  getAliasesAndAddresses :: MorleyOnlyRpcM [(Text, Text)]
getAliasesAndAddresses = do
    Map ImplicitAddress SecretKey
implicitAddrs <- (MorleyOnlyRpcEnv -> Map ImplicitAddress SecretKey)
-> MorleyOnlyRpcM (Map ImplicitAddress SecretKey)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MorleyOnlyRpcEnv -> Map ImplicitAddress SecretKey
moreSecretKeys
    pure $
      Map ImplicitAddress SecretKey
-> [Key (Map ImplicitAddress SecretKey)]
forall t. ToPairs t => t -> [Key t]
keys Map ImplicitAddress SecretKey
implicitAddrs [ImplicitAddress]
-> (ImplicitAddress -> (Text, Text)) -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ImplicitAddress
implicitAddr -> (Text
"MorleyOnlyRpc", ImplicitAddress -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ImplicitAddress
implicitAddr)

  -- Actions that are not supported and simply throw exceptions.
  genKey :: ImplicitAlias -> MorleyOnlyRpcM ImplicitAddress
genKey ImplicitAlias
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM ImplicitAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM ImplicitAddress)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM ImplicitAddress
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"genKey"
  genFreshKey :: ImplicitAlias -> MorleyOnlyRpcM ImplicitAddress
genFreshKey ImplicitAlias
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM ImplicitAddress
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM ImplicitAddress)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM ImplicitAddress
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"genFreshKey"
  revealKey :: ImplicitAlias -> Maybe ScrubbedBytes -> MorleyOnlyRpcM ()
revealKey ImplicitAlias
_ Maybe ScrubbedBytes
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM ())
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM ()
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"revealKey"

instance RunClient MorleyOnlyRpcM where
  runRequestAcceptStatus :: Maybe [Status] -> Request -> MorleyOnlyRpcM Response
runRequestAcceptStatus Maybe [Status]
statuses Request
req = do
    ClientEnv
env <- MorleyOnlyRpcEnv -> ClientEnv
moreClientEnv (MorleyOnlyRpcEnv -> ClientEnv)
-> MorleyOnlyRpcM MorleyOnlyRpcEnv -> MorleyOnlyRpcM ClientEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MorleyOnlyRpcM MorleyOnlyRpcEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
    ClientEnv -> Maybe [Status] -> Request -> MorleyOnlyRpcM Response
forall env (m :: * -> *).
(WithClientLog env m, MonadIO m, MonadThrow m) =>
ClientEnv -> Maybe [Status] -> Request -> m Response
runRequestAcceptStatusImpl ClientEnv
env Maybe [Status]
statuses Request
req
  throwClientError :: forall a. ClientError -> MorleyOnlyRpcM a
throwClientError = ClientError -> MorleyOnlyRpcM a
forall (m :: * -> *) a. MonadThrow m => ClientError -> m a
throwClientErrorImpl

instance HasTezosRpc MorleyOnlyRpcM where
  getBlockHash :: BlockId -> MorleyOnlyRpcM BlockHash
getBlockHash = BlockId -> MorleyOnlyRpcM BlockHash
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m BlockHash
getBlockHashImpl
  getCounterAtBlock :: BlockId -> ImplicitAddress -> MorleyOnlyRpcM TezosInt64
getCounterAtBlock = BlockId -> ImplicitAddress -> MorleyOnlyRpcM TezosInt64
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ImplicitAddress -> m TezosInt64
getCounterImpl
  getBlockHeader :: BlockId -> MorleyOnlyRpcM BlockHeader
getBlockHeader = BlockId -> MorleyOnlyRpcM BlockHeader
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m BlockHeader
getBlockHeaderImpl
  getBlockConstants :: BlockId -> MorleyOnlyRpcM BlockConstants
getBlockConstants = BlockId -> MorleyOnlyRpcM BlockConstants
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m BlockConstants
getBlockConstantsImpl
  getBlockOperations :: BlockId -> MorleyOnlyRpcM [[BlockOperation]]
getBlockOperations = BlockId -> MorleyOnlyRpcM [[BlockOperation]]
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m [[BlockOperation]]
getBlockOperationsImpl
  getBlockOperationHashes :: BlockId -> MorleyOnlyRpcM [[OperationHash]]
getBlockOperationHashes = BlockId -> MorleyOnlyRpcM [[OperationHash]]
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m [[OperationHash]]
getBlockOperationHashesImpl
  getProtocolParametersAtBlock :: BlockId -> MorleyOnlyRpcM ProtocolParameters
getProtocolParametersAtBlock = BlockId -> MorleyOnlyRpcM ProtocolParameters
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m ProtocolParameters
getProtocolParametersImpl
  runOperationAtBlock :: BlockId -> RunOperation -> MorleyOnlyRpcM RunOperationResult
runOperationAtBlock = BlockId -> RunOperation -> MorleyOnlyRpcM RunOperationResult
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> RunOperation -> m RunOperationResult
runOperationImpl
  preApplyOperationsAtBlock :: BlockId
-> [PreApplyOperation] -> MorleyOnlyRpcM [RunOperationResult]
preApplyOperationsAtBlock = BlockId
-> [PreApplyOperation] -> MorleyOnlyRpcM [RunOperationResult]
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> [PreApplyOperation] -> m [RunOperationResult]
preApplyOperationsImpl
  forgeOperationAtBlock :: BlockId -> ForgeOperation -> MorleyOnlyRpcM HexJSONByteString
forgeOperationAtBlock = BlockId -> ForgeOperation -> MorleyOnlyRpcM HexJSONByteString
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ForgeOperation -> m HexJSONByteString
forgeOperationImpl
  getScriptSizeAtBlock :: BlockId -> CalcSize -> MorleyOnlyRpcM ScriptSize
getScriptSizeAtBlock = BlockId -> CalcSize -> MorleyOnlyRpcM ScriptSize
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> CalcSize -> m ScriptSize
getScriptSizeAtBlockImpl
  injectOperation :: HexJSONByteString -> MorleyOnlyRpcM OperationHash
injectOperation = HexJSONByteString -> MorleyOnlyRpcM OperationHash
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
HexJSONByteString -> m OperationHash
injectOperationImpl
  getContractScriptAtBlock :: BlockId -> ContractAddress -> MorleyOnlyRpcM OriginationScript
getContractScriptAtBlock = BlockId -> ContractAddress -> MorleyOnlyRpcM OriginationScript
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> m OriginationScript
getContractScriptImpl
  getContractStorageAtBlock :: BlockId -> ContractAddress -> MorleyOnlyRpcM Expression
getContractStorageAtBlock = BlockId -> ContractAddress -> MorleyOnlyRpcM Expression
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> m Expression
getContractStorageAtBlockImpl
  getContractBigMapAtBlock :: BlockId
-> ContractAddress -> GetBigMap -> MorleyOnlyRpcM GetBigMapResult
getContractBigMapAtBlock = BlockId
-> ContractAddress -> GetBigMap -> MorleyOnlyRpcM GetBigMapResult
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
getContractBigMapImpl
  getBigMapValueAtBlock :: BlockId -> Natural -> Text -> MorleyOnlyRpcM Expression
getBigMapValueAtBlock = BlockId -> Natural -> Text -> MorleyOnlyRpcM Expression
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Natural -> Text -> m Expression
getBigMapValueAtBlockImpl
  getBigMapValuesAtBlock :: BlockId
-> Natural
-> Maybe Natural
-> Maybe Natural
-> MorleyOnlyRpcM Expression
getBigMapValuesAtBlock = BlockId
-> Natural
-> Maybe Natural
-> Maybe Natural
-> MorleyOnlyRpcM Expression
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValuesAtBlockImpl
  getBalanceAtBlock :: BlockId -> Address -> MorleyOnlyRpcM Mutez
getBalanceAtBlock = BlockId -> Address -> MorleyOnlyRpcM Mutez
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> m Mutez
getBalanceImpl
  getDelegateAtBlock :: BlockId -> L1Address -> MorleyOnlyRpcM (Maybe KeyHash)
getDelegateAtBlock = BlockId -> L1Address -> MorleyOnlyRpcM (Maybe KeyHash)
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> L1Address -> m (Maybe KeyHash)
getDelegateImpl
  runCodeAtBlock :: BlockId -> RunCode -> MorleyOnlyRpcM RunCodeResult
runCodeAtBlock = BlockId -> RunCode -> MorleyOnlyRpcM RunCodeResult
forall (m :: * -> *).
(RunClient m, MonadCatch m) =>
BlockId -> RunCode -> m RunCodeResult
runCodeImpl
  getChainId :: MorleyOnlyRpcM ChainId
getChainId = MorleyOnlyRpcM ChainId
forall (m :: * -> *). (RunClient m, MonadCatch m) => m ChainId
getChainIdImpl
  getManagerKeyAtBlock :: BlockId -> ImplicitAddress -> MorleyOnlyRpcM (Maybe PublicKey)
getManagerKeyAtBlock = BlockId -> ImplicitAddress -> MorleyOnlyRpcM (Maybe PublicKey)
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> ImplicitAddress -> m (Maybe PublicKey)
getManagerKeyImpl
  waitForOperation :: MorleyOnlyRpcM OperationHash -> MorleyOnlyRpcM OperationHash
waitForOperation = ((MorleyOnlyRpcEnv -> ClientEnv) -> MorleyOnlyRpcM ClientEnv
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MorleyOnlyRpcEnv -> ClientEnv
moreClientEnv MorleyOnlyRpcM ClientEnv
-> (ClientEnv -> MorleyOnlyRpcM OperationHash)
-> MorleyOnlyRpcM OperationHash
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) ((ClientEnv -> MorleyOnlyRpcM OperationHash)
 -> MorleyOnlyRpcM OperationHash)
-> (MorleyOnlyRpcM OperationHash
    -> ClientEnv -> MorleyOnlyRpcM OperationHash)
-> MorleyOnlyRpcM OperationHash
-> MorleyOnlyRpcM OperationHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyOnlyRpcM OperationHash
-> ClientEnv -> MorleyOnlyRpcM OperationHash
forall (m :: * -> *).
(MonadUnliftIO m, HasTezosRpc m) =>
m OperationHash -> ClientEnv -> m OperationHash
waitForOperationImpl