API.hs

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

-- | This module contains servant types for tezos-node
-- RPC API.
module Morley.Client.RPC.API
  ( NodeMethods (..)
  , nodeMethods
  , monitorHeads
  ) where

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)
import Morley.Tezos.Address (Address, formatAddress)
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" Address'
      :> "counter" :> Get '[JSON] TezosInt64 :<|>

    Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address'
      :> "script" :> Get '[JSON] OriginationScript :<|>

    Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "contract" Address'
      :> "storage" :> Get '[JSON] Expression :<|>

    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" Address'
      :> "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 `tezos-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" Address' :> "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 -> Address -> m TezosInt64
  , getScript :: BlockId -> Address -> m OriginationScript
  , getStorageAtBlock :: BlockId -> Address -> m Expression
  , getBlockConstants :: BlockId -> m BlockConstants
  , getBlockHeader :: BlockId -> m BlockHeader
  , getProtocolParameters :: BlockId -> m ProtocolParameters
  , getBlockOperations :: BlockId -> m [[BlockOperation]]
  , getBlockOperationHashes :: BlockId -> m [[OperationHash]]
  , getBigMap :: BlockId -> Address -> 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 -> Address -> 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 -> Address -> 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
  { getCounter        = withAddress' getCounter'
  , getScript         = withAddress' getScript'
  , getStorageAtBlock = withAddress' getStorageAtBlock'
  , getBigMap         = withAddress' getBigMap'
  , getBalance        = withAddress' getBalance'
  , getDelegate       = \block addr -> do
      result <- try $ getDelegate' block (Address' addr)
      case result of
        Left (FailureResponse _ Response{responseStatusCode=Status{statusCode = 404}})
          -> pure Nothing
        Left err -> throwM err
        Right res -> pure $ Just res
  , getManagerKey     = withAddress' getManagerKey'
  , ..
  }
  where
    withAddress' f blockId = f blockId . Address'
    getDelegate' :: BlockId -> Address' -> m KeyHash
    (getBlockHash
        :<|> getCounter'
        :<|> getScript'
        :<|> getStorageAtBlock'
        :<|> getBlockConstants
        :<|> getBlockHeader
        :<|> getProtocolParameters
        :<|> getBlockOperations
        :<|> getBlockOperationHashes
        :<|> getBigMap'
        :<|> getBigMapValueAtBlock
        :<|> getBigMapValuesAtBlock
        :<|> getBalance'
        :<|> getDelegate'
        :<|> getManagerKey'
        :<|> getScriptSizeAtBlock
        :<|> forgeOperation
        :<|> runOperation
        :<|> preApplyOperations
        :<|> runCode)
      :<|> getChainId
      :<|> injectOperation
      = nodeAPI `clientIn` (Proxy @m)

----------------------------------------------------------------------------
-- Instances and helpers
----------------------------------------------------------------------------

-- | We use this wrapper to avoid orphan instances.
newtype Address' = Address'
  { unAddress' :: Address }

instance ToHttpApiData Address' where
  toUrlPiece = formatAddress . unAddress'