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

-- | An alternative implementation of @morley-client@ that does not require
-- @tezos-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 ((+|), (|+))
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.Client.TezosClient.Types (AddressOrAlias(..), mkAlias)
import Morley.Tezos.Address (Address, mkKeyAddress)
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 Address SecretKey
moreSecretKeys :: Map Address 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 Address 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 Address SecretKey
moreSecretKeys =
      [(Address, SecretKey)] -> Map Address SecretKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Address, SecretKey)] -> Map Address SecretKey)
-> [(Address, SecretKey)] -> Map Address SecretKey
forall a b. (a -> b) -> a -> b
$ (SecretKey -> (Address, SecretKey))
-> [SecretKey] -> [(Address, SecretKey)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\SecretKey
sk -> (PublicKey -> Address
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
  { MorleyOnlyRpcM a -> ReaderT MorleyOnlyRpcEnv IO a
unMorleyOnlyRpcM :: ReaderT MorleyOnlyRpcEnv IO a }
  deriving newtype
    ( a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
(a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
(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
<$ :: a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
$c<$ :: forall a b. a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
fmap :: (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
$cfmap :: forall a b. (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
Functor, Functor MorleyOnlyRpcM
a -> MorleyOnlyRpcM a
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
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
MorleyOnlyRpcM (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
(a -> b -> c)
-> MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM c
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
<* :: MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
$c<* :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM a
*> :: MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
$c*> :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
liftA2 :: (a -> b -> c)
-> MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM c
<*> :: MorleyOnlyRpcM (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
$c<*> :: forall a b.
MorleyOnlyRpcM (a -> b) -> MorleyOnlyRpcM a -> MorleyOnlyRpcM b
pure :: a -> MorleyOnlyRpcM a
$cpure :: forall a. a -> MorleyOnlyRpcM a
$cp1Applicative :: Functor MorleyOnlyRpcM
Applicative, Applicative MorleyOnlyRpcM
a -> MorleyOnlyRpcM a
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
MorleyOnlyRpcM a -> (a -> MorleyOnlyRpcM b) -> MorleyOnlyRpcM b
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
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 :: a -> MorleyOnlyRpcM a
$creturn :: forall a. a -> MorleyOnlyRpcM a
>> :: MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
$c>> :: forall a b.
MorleyOnlyRpcM a -> MorleyOnlyRpcM b -> MorleyOnlyRpcM b
>>= :: MorleyOnlyRpcM a -> (a -> MorleyOnlyRpcM b) -> MorleyOnlyRpcM b
$c>>= :: forall a b.
MorleyOnlyRpcM a -> (a -> MorleyOnlyRpcM b) -> MorleyOnlyRpcM b
$cp1Monad :: Applicative MorleyOnlyRpcM
Monad, MonadReader MorleyOnlyRpcEnv
    , Monad MorleyOnlyRpcM
Monad MorleyOnlyRpcM
-> (forall a. IO a -> MorleyOnlyRpcM a) -> MonadIO MorleyOnlyRpcM
IO a -> MorleyOnlyRpcM a
forall a. IO a -> MorleyOnlyRpcM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> MorleyOnlyRpcM a
$cliftIO :: forall a. IO a -> MorleyOnlyRpcM a
$cp1MonadIO :: Monad MorleyOnlyRpcM
MonadIO, Monad MorleyOnlyRpcM
e -> MorleyOnlyRpcM a
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 :: e -> MorleyOnlyRpcM a
$cthrowM :: forall e a. Exception e => e -> MorleyOnlyRpcM a
$cp1MonadThrow :: Monad MorleyOnlyRpcM
MonadThrow, MonadThrow MorleyOnlyRpcM
MonadThrow MorleyOnlyRpcM
-> (forall e a.
    Exception e =>
    MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a)
-> MonadCatch MorleyOnlyRpcM
MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a
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 :: MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a
$ccatch :: forall e a.
Exception e =>
MorleyOnlyRpcM a -> (e -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a
$cp1MonadCatch :: MonadThrow MorleyOnlyRpcM
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
MorleyOnlyRpcM a
-> (a -> ExitCase b -> MorleyOnlyRpcM c)
-> (a -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM (b, c)
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM 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)
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 :: 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 a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
$cuninterruptibleMask :: forall b.
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
mask :: ((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
$cmask :: forall b.
((forall a. MorleyOnlyRpcM a -> MorleyOnlyRpcM a)
 -> MorleyOnlyRpcM b)
-> MorleyOnlyRpcM b
$cp1MonadMask :: MonadCatch MorleyOnlyRpcM
MonadMask, MonadIO MorleyOnlyRpcM
MonadIO MorleyOnlyRpcM
-> (forall b.
    ((forall a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b)
-> MonadUnliftIO MorleyOnlyRpcM
((forall a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b
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 a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b
$cwithRunInIO :: forall b.
((forall a. MorleyOnlyRpcM a -> IO a) -> IO b) -> MorleyOnlyRpcM b
$cp1MonadUnliftIO :: MonadIO MorleyOnlyRpcM
MonadUnliftIO
    )

-- | Run 'MorleyOnlyRpcM' action within given 'MorleyOnlyRpcEnv'. Retry action
-- in case of invalid counter error.
runMorleyOnlyRpcM :: MorleyOnlyRpcEnv -> MorleyOnlyRpcM a -> IO a
runMorleyOnlyRpcM :: 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 -> MorleyOnlyRpcM a
retryInvalidCounter MorleyOnlyRpcM a
action)) MorleyOnlyRpcEnv
env
  where
    retryInvalidCounter :: MorleyOnlyRpcM a -> MorleyOnlyRpcM a
retryInvalidCounter MorleyOnlyRpcM a
a = MorleyOnlyRpcM a
a MorleyOnlyRpcM a
-> (ClientRpcError -> MorleyOnlyRpcM a) -> MorleyOnlyRpcM a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` MorleyOnlyRpcM a -> ClientRpcError -> MorleyOnlyRpcM a
forall (m :: * -> *) a.
MonadThrow m =>
m a -> ClientRpcError -> m a
handleInvalidCounterRpc MorleyOnlyRpcM a
retryAction
      where
        retryAction :: MorleyOnlyRpcM a
retryAction = MorleyOnlyRpcM ()
forall (m :: * -> *) env.
(MonadIO m, HasTezosRpc m, WithClientLog env m) =>
m ()
waitBeforeRetry MorleyOnlyRpcM () -> MorleyOnlyRpcM a -> MorleyOnlyRpcM a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MorleyOnlyRpcM a -> MorleyOnlyRpcM a
retryInvalidCounter MorleyOnlyRpcM a
action

----------------
-- 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 Address
  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 Address
addr -> Builder
"Secret key is unknown for " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> 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 :: AddressOrAlias
-> Maybe ScrubbedBytes -> ByteString -> MorleyOnlyRpcM Signature
signBytes AddressOrAlias
sender Maybe ScrubbedBytes
_password ByteString
opHash = case AddressOrAlias
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 Address
address -> do
      MorleyOnlyRpcEnv
env <- MorleyOnlyRpcM MorleyOnlyRpcEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
      case MorleyOnlyRpcEnv -> Map Address SecretKey
moreSecretKeys MorleyOnlyRpcEnv
env Map Address SecretKey
-> Getting
     (Maybe SecretKey) (Map Address SecretKey) (Maybe SecretKey)
-> Maybe SecretKey
forall s a. s -> Getting a s a -> a
^. Index (Map Address SecretKey)
-> Lens'
     (Map Address SecretKey) (Maybe (IxValue (Map Address SecretKey)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address SecretKey)
Address
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
$ Address -> MorleyOnlyRpcException
UnknownSecretKeyFor Address
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 :: Address -> MorleyOnlyRpcM (Maybe ScrubbedBytes)
getKeyPassword Address
_ = Maybe ScrubbedBytes -> MorleyOnlyRpcM (Maybe ScrubbedBytes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ScrubbedBytes
forall a. Maybe a
Nothing

  -- This method can be implemented if necessary by manually checking whether
  -- the operation is confirmed. For now we simply don't wait for confirmation
  -- in RPC-only mode.
  waitForOperation :: OperationHash -> MorleyOnlyRpcM ()
waitForOperation = \OperationHash
_ -> MorleyOnlyRpcM ()
forall (f :: * -> *). Applicative f => f ()
pass

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

  -- We return a dummy value 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]: consider using a `Map` instead
  getAlias :: AddressOrAlias -> MorleyOnlyRpcM Alias
getAlias AddressOrAlias
_ = Alias -> MorleyOnlyRpcM Alias
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Alias
mkAlias Text
"MorleyOnlyRpc")

  -- Actions that are not supported and simply throw exceptions.
  genKey :: AliasOrAliasHint -> MorleyOnlyRpcM Address
genKey AliasOrAliasHint
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM Address
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM Address)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM Address
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"genKey"
  genFreshKey :: AliasOrAliasHint -> MorleyOnlyRpcM Address
genFreshKey AliasOrAliasHint
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM Address
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM Address)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM Address
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"genFreshKey"
  importKey :: Bool -> AliasOrAliasHint -> SecretKey -> MorleyOnlyRpcM Alias
importKey Bool
_ AliasOrAliasHint
_ SecretKey
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM Alias
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM Alias)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM Alias
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"importKey"
  revealKey :: Alias -> Maybe ScrubbedBytes -> MorleyOnlyRpcM ()
revealKey Alias
_ 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"
  resolveAddressMaybe :: AddressOrAlias -> MorleyOnlyRpcM (Maybe Address)
resolveAddressMaybe AddressOrAlias
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM (Maybe Address)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM (Maybe Address))
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM (Maybe Address)
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"resolveAddressMaybe"
  getPublicKey :: AddressOrAlias -> MorleyOnlyRpcM PublicKey
getPublicKey AddressOrAlias
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM PublicKey
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM PublicKey)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM PublicKey
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"getPublicKey"
  registerDelegate :: AliasOrAliasHint -> Maybe ScrubbedBytes -> MorleyOnlyRpcM ()
registerDelegate AliasOrAliasHint
_ 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
"registerDelegate"
  getTezosClientConfig :: MorleyOnlyRpcM TezosClientConfig
getTezosClientConfig = UnsupportedByOnlyRPC -> MorleyOnlyRpcM TezosClientConfig
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM TezosClientConfig)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM TezosClientConfig
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"getTezosClientConfig"
  calcTransferFee :: AddressOrAlias
-> Maybe ScrubbedBytes
-> TezosInt64
-> [CalcTransferFeeData]
-> MorleyOnlyRpcM [TezosMutez]
calcTransferFee AddressOrAlias
_ Maybe ScrubbedBytes
_ TezosInt64
_ [CalcTransferFeeData]
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM [TezosMutez]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM [TezosMutez])
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM [TezosMutez]
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"calcTransferFee"
  calcOriginationFee :: CalcOriginationFeeData cp st -> MorleyOnlyRpcM TezosMutez
calcOriginationFee CalcOriginationFeeData cp st
_ = UnsupportedByOnlyRPC -> MorleyOnlyRpcM TezosMutez
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnsupportedByOnlyRPC -> MorleyOnlyRpcM TezosMutez)
-> UnsupportedByOnlyRPC -> MorleyOnlyRpcM TezosMutez
forall a b. (a -> b) -> a -> b
$ Text -> UnsupportedByOnlyRPC
UnsupportedByOnlyRPC Text
"calcOriginationFee"

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 :: ClientError -> MorleyOnlyRpcM a
throwClientError = ClientError -> MorleyOnlyRpcM a
forall (m :: * -> *) a. MonadThrow m => ClientError -> m a
throwClientErrorImpl

instance HasTezosRpc MorleyOnlyRpcM where
  getBlockHash :: BlockId -> MorleyOnlyRpcM Text
getBlockHash = BlockId -> MorleyOnlyRpcM Text
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> m Text
getBlockHashImpl
  getCounterAtBlock :: BlockId -> Address -> MorleyOnlyRpcM TezosInt64
getCounterAtBlock = BlockId -> Address -> MorleyOnlyRpcM TezosInt64
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> 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
  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
  injectOperation :: HexJSONByteString -> MorleyOnlyRpcM OperationHash
injectOperation = HexJSONByteString -> MorleyOnlyRpcM OperationHash
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
HexJSONByteString -> m OperationHash
injectOperationImpl
  getContractScriptAtBlock :: BlockId -> Address -> MorleyOnlyRpcM OriginationScript
getContractScriptAtBlock = BlockId -> Address -> MorleyOnlyRpcM OriginationScript
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> m OriginationScript
getContractScriptImpl
  getContractStorageAtBlock :: BlockId -> Address -> MorleyOnlyRpcM Expression
getContractStorageAtBlock = BlockId -> Address -> MorleyOnlyRpcM Expression
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> m Expression
getContractStorageAtBlockImpl
  getContractBigMapAtBlock :: BlockId -> Address -> GetBigMap -> MorleyOnlyRpcM GetBigMapResult
getContractBigMapAtBlock = BlockId -> Address -> GetBigMap -> MorleyOnlyRpcM GetBigMapResult
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> 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 -> Address -> MorleyOnlyRpcM (Maybe KeyHash)
getDelegateAtBlock = BlockId -> Address -> MorleyOnlyRpcM (Maybe KeyHash)
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> 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 -> Address -> MorleyOnlyRpcM (Maybe PublicKey)
getManagerKeyAtBlock = BlockId -> Address -> MorleyOnlyRpcM (Maybe PublicKey)
forall (m :: * -> *).
(RunClient m, MonadUnliftIO m, MonadCatch m) =>
BlockId -> Address -> m (Maybe PublicKey)
getManagerKeyImpl