-- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -- | This module contains servant types for @octez-node@ RPC API. module Morley.Client.RPC.API ( NodeMethods (..) , nodeMethods , monitorHeads ) where import Data.Coerce (coerce) import Network.HTTP.Types.Status (Status(..)) import Servant.API (Capture, Get, JSON, NewlineFraming, Post, QueryParam, ReqBody, SourceIO, StreamGet, ToHttpApiData(..), (:<|>)(..), (:>)) import Servant.Client.Core (ResponseF(..), RunClient, RunStreamingClient, clientIn, pattern FailureResponse) import Morley.Client.RPC.QueryFixedParam import Morley.Client.RPC.Types import Morley.Micheline (Expression, TezosInt64, TezosMutez, TezosNat) import Morley.Tezos.Address import Morley.Tezos.Address.Kinds import Morley.Tezos.Crypto (KeyHash, PublicKey) import Morley.Util.ByteString -- We put an empty line after each endpoint to make it easier to -- visually distinguish them. type NodeAPI = "chains" :> "main" :> "blocks" :> ( -- GET Capture "block_id" BlockId :> "hash" :> Get '[JSON] Text :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ImplicitAddress' :> "counter" :> Get '[JSON] TezosInt64 :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "script" :> Get '[JSON] OriginationScript :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "storage" :> Get '[JSON] Expression :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' :> "ticket_balance" :> ReqBody '[JSON] GetTicketBalance :> Post '[JSON] TezosNat :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "all_ticket_balances" :> Get '[JSON] [GetAllTicketBalancesResponse] :<|> Capture "block_id" BlockId :> Get '[JSON] BlockConstants :<|> Capture "block_id" BlockId :> "header" :> Get '[JSON] BlockHeader :<|> Capture "block_id" BlockId :> "context" :> "constants" :> Get '[JSON] ProtocolParameters :<|> Capture "block_id" BlockId :> "operations" :> Get '[JSON] [[BlockOperation]] :<|> Capture "block_id" BlockId :> "operation_hashes" :> Get '[JSON] [[OperationHash]] :<|> -- Despite this RPC is deprecated, it is said to be implemented quite sanely, -- and also we were said that it is not going to be removed soon. -- In babylonnet this entrypoint finds big_map with relevant key type and -- seeks for key in it; if there are multiple big_maps with the same key type, -- only one of them is considered (which one - it seems better not to rely on -- this info). Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" ContractAddress' :> "big_map_get" :> ReqBody '[JSON] GetBigMap :> Post '[JSON] GetBigMapResult :<|> -- This endpoint supersedes the endpoint above. -- It takes a big_map ID instead of a contract ID, so it naturally supports -- contracts with multiple big maps. -- The 'script_expr' is the `Script-expression-ID-Hash` obtained by either: -- 1) calling `octez-client hash data '123' of type int`. -- 2) or using 'Lorentz.Pack.valueToScriptExpr' and then base58 encode it. Capture "block_id" BlockId :> "context" :> "big_maps" :> Capture "big_map_id" Natural :> Capture "script_expr" Text :> Get '[JSON] Expression :<|> Capture "block_id" BlockId :> "context" :> "big_maps" :> Capture "big_map_id" Natural :> QueryParam "offset" Natural :> QueryParam "length" Natural :> Get '[JSON] Expression :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' :> "balance" :> Get '[JSON] TezosMutez :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address' :> "delegate" :> Get '[JSON] KeyHash :<|> Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "address" ImplicitAddress' :> "manager_key" :> Get '[JSON] (Maybe PublicKey) :<|> -- POST -- Calculate script size with given storage. Capture "block_id" BlockId :> "helpers" :> "scripts" :> "script_size" :> ReqBody '[JSON] CalcSize :> Post '[JSON] ScriptSize :<|> -- Turn a structured representation of an operation into a -- bytestring that can be submitted to the blockchain. Capture "block_id" BlockId :> "helpers" :> "forge" :> "operations" :> ReqBody '[JSON] ForgeOperation :> Post '[JSON] HexJSONByteString :<|> -- Run an operation without signature checks. Capture "block_id" BlockId :> "helpers" :> "scripts" :> "run_operation" :> ReqBody '[JSON] RunOperation :> Post '[JSON] RunOperationResult :<|> -- Simulate the validation of operations. Capture "block_id" BlockId :> "helpers" :> "preapply" :> "operations" :> ReqBody '[JSON] [PreApplyOperation] :> Post '[JSON] [RunOperationResult] :<|> -- Run contract with given parameter and storage. Capture "block_id" BlockId :> "helpers" :> "scripts" :> "run_code" :> ReqBody '[JSON] RunCode :> Post '[JSON] RunCodeResult ) :<|> "chains" :> "main" :> "chain_id" :> Get '[JSON] Text :<|> -- Inject a previously forged and signed operation into a node and broadcast it. -- NOTE: we're hard-coding "chain" to "main" here for consistency with the rest -- of this definition "injection" :> "operation" :> QueryFixedParam "chain" "main" :> ReqBody '[JSON] HexJSONByteString :> Post '[JSON] OperationHash type StreamingAPI = "monitor" :> "heads" :> "main" :> StreamGet NewlineFraming JSON (SourceIO BlockHeader) nodeAPI :: Proxy NodeAPI nodeAPI = Proxy data NodeMethods m = NodeMethods { getBlockHash :: BlockId -> m Text , getCounter :: BlockId -> ImplicitAddress -> m TezosInt64 , getScript :: BlockId -> ContractAddress -> m OriginationScript , getStorageAtBlock :: BlockId -> ContractAddress -> m Expression , getTicketBalanceAtBlock :: BlockId -> Address -> GetTicketBalance -> m TezosNat , getAllTicketBalancesAtBlock :: BlockId -> ContractAddress -> m [GetAllTicketBalancesResponse] , getBlockConstants :: BlockId -> m BlockConstants , getBlockHeader :: BlockId -> m BlockHeader , getProtocolParameters :: BlockId -> m ProtocolParameters , getBlockOperations :: BlockId -> m [[BlockOperation]] , getBlockOperationHashes :: BlockId -> m [[OperationHash]] , getBigMap :: BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult , getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression , getBigMapValuesAtBlock :: BlockId -> Natural -> Maybe Natural -> Maybe Natural -> m Expression , getBalance :: BlockId -> Address -> m TezosMutez , getDelegate :: BlockId -> L1Address -> m (Maybe KeyHash) , getScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize , forgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString , runOperation :: BlockId -> RunOperation -> m RunOperationResult , preApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult] , runCode :: BlockId -> RunCode -> m RunCodeResult , getManagerKey :: BlockId -> ImplicitAddress -> m (Maybe PublicKey) , getChainId :: m Text , injectOperation :: HexJSONByteString -> m OperationHash } monitorHeads :: forall m. (RunStreamingClient m) => m (SourceIO BlockHeader) monitorHeads = Proxy @StreamingAPI `clientIn` Proxy @m nodeMethods :: forall m. (MonadCatch m, RunClient m) => NodeMethods m nodeMethods = NodeMethods { getDelegate = \block (Constrained addr) -> do result <- try $ getDelegate' block (Address' $ MkAddress addr) case result of Left (FailureResponse _ Response{responseStatusCode=Status{statusCode = 404}}) -> pure Nothing Left err -> throwM err Right res -> pure $ Just res , .. } where (getBlockHash :<|> (coerce -> getCounter) :<|> (coerce -> getScript) :<|> (coerce -> getStorageAtBlock) :<|> (coerce -> getTicketBalanceAtBlock) :<|> (coerce -> getAllTicketBalancesAtBlock) :<|> getBlockConstants :<|> getBlockHeader :<|> getProtocolParameters :<|> getBlockOperations :<|> getBlockOperationHashes :<|> (coerce -> getBigMap) :<|> getBigMapValueAtBlock :<|> getBigMapValuesAtBlock :<|> (coerce -> getBalance) :<|> getDelegate' :<|> (coerce -> getManagerKey) :<|> getScriptSizeAtBlock :<|> forgeOperation :<|> runOperation :<|> preApplyOperations :<|> runCode) :<|> getChainId :<|> injectOperation = nodeAPI `clientIn` (Proxy @m) ---------------------------------------------------------------------------- -- Instances and helpers ---------------------------------------------------------------------------- -- | We use this wrapper to avoid orphan instances. newtype KindedAddress' kind = KindedAddress' { unAddress' :: KindedAddress kind } type ContractAddress' = KindedAddress' 'AddressKindContract type ImplicitAddress' = KindedAddress' 'AddressKindImplicit instance ToHttpApiData (KindedAddress' kind) where toUrlPiece = formatAddress . unAddress' newtype Address' = Address' Address instance ToHttpApiData Address' where toUrlPiece (Address' (MkAddress addr)) = formatAddress addr