-- 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
  ) where

import Network.HTTP.Types.Status (Status(..))
import Servant.API
  (Capture, Get, JSON, Post, QueryParam, ReqBody, ToHttpApiData(..), (:<|>)(..), (:>))
import Servant.Client.Core (ResponseF(..), RunClient, 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]] :<|>

    -- 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 :<|>

    -- POST

    -- 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 :<|>

    Capture "block_id" BlockId :> "context" :> "contracts" :> Capture "address" Address' :> "manager_key"
      :> Get '[JSON] (Maybe PublicKey)

    ) :<|>

  "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

nodeAPI :: Proxy NodeAPI
nodeAPI :: Proxy NodeAPI
nodeAPI = Proxy NodeAPI
forall k (t :: k). Proxy t
Proxy

data NodeMethods m = NodeMethods
  { NodeMethods m -> BlockId -> m Text
getBlockHash :: BlockId -> m Text
  , NodeMethods m -> BlockId -> Address -> m TezosInt64
getCounter :: BlockId -> Address -> m TezosInt64
  , NodeMethods m -> BlockId -> Address -> m OriginationScript
getScript :: BlockId -> Address -> m OriginationScript
  , NodeMethods m -> BlockId -> Address -> m Expression
getStorageAtBlock :: BlockId -> Address -> m Expression
  , NodeMethods m -> BlockId -> m BlockConstants
getBlockConstants :: BlockId -> m BlockConstants
  , NodeMethods m -> BlockId -> m BlockHeader
getBlockHeader :: BlockId -> m BlockHeader
  , NodeMethods m -> BlockId -> m ProtocolParameters
getProtocolParameters :: BlockId -> m ProtocolParameters
  , NodeMethods m -> BlockId -> m [[BlockOperation]]
getBlockOperations :: BlockId -> m [[BlockOperation]]
  , NodeMethods m
-> BlockId -> Address -> GetBigMap -> m GetBigMapResult
getBigMap :: BlockId -> Address -> GetBigMap -> m GetBigMapResult
  , NodeMethods m -> BlockId -> Natural -> Text -> m Expression
getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression
  , NodeMethods m
-> BlockId
-> Natural
-> Maybe Natural
-> Maybe Natural
-> m Expression
getBigMapValuesAtBlock :: BlockId -> Natural -> Maybe Natural -> Maybe Natural -> m Expression
  , NodeMethods m -> BlockId -> Address -> m TezosMutez
getBalance :: BlockId -> Address -> m TezosMutez
  , NodeMethods m -> BlockId -> Address -> m (Maybe KeyHash)
getDelegate :: BlockId -> Address -> m (Maybe KeyHash)
  , NodeMethods m -> BlockId -> ForgeOperation -> m HexJSONByteString
forgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString
  , NodeMethods m -> BlockId -> RunOperation -> m RunOperationResult
runOperation :: BlockId -> RunOperation -> m RunOperationResult
  , NodeMethods m
-> BlockId -> [PreApplyOperation] -> m [RunOperationResult]
preApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult]
  , NodeMethods m -> BlockId -> RunCode -> m RunCodeResult
runCode :: BlockId -> RunCode -> m RunCodeResult
  , NodeMethods m -> BlockId -> Address -> m (Maybe PublicKey)
getManagerKey :: BlockId -> Address -> m (Maybe PublicKey)
  , NodeMethods m -> m Text
getChainId :: m Text
  , NodeMethods m -> HexJSONByteString -> m OperationHash
injectOperation :: HexJSONByteString -> m OperationHash
  }

nodeMethods :: forall m. (MonadCatch m, RunClient m) => NodeMethods m
nodeMethods :: NodeMethods m
nodeMethods = NodeMethods :: forall (m :: * -> *).
(BlockId -> m Text)
-> (BlockId -> Address -> m TezosInt64)
-> (BlockId -> Address -> m OriginationScript)
-> (BlockId -> Address -> m Expression)
-> (BlockId -> m BlockConstants)
-> (BlockId -> m BlockHeader)
-> (BlockId -> m ProtocolParameters)
-> (BlockId -> m [[BlockOperation]])
-> (BlockId -> Address -> GetBigMap -> m GetBigMapResult)
-> (BlockId -> Natural -> Text -> m Expression)
-> (BlockId
    -> Natural -> Maybe Natural -> Maybe Natural -> m Expression)
-> (BlockId -> Address -> m TezosMutez)
-> (BlockId -> Address -> m (Maybe KeyHash))
-> (BlockId -> ForgeOperation -> m HexJSONByteString)
-> (BlockId -> RunOperation -> m RunOperationResult)
-> (BlockId -> [PreApplyOperation] -> m [RunOperationResult])
-> (BlockId -> RunCode -> m RunCodeResult)
-> (BlockId -> Address -> m (Maybe PublicKey))
-> m Text
-> (HexJSONByteString -> m OperationHash)
-> NodeMethods m
NodeMethods
  { getCounter :: BlockId -> Address -> m TezosInt64
getCounter        = (BlockId -> Address' -> m TezosInt64)
-> BlockId -> Address -> m TezosInt64
forall t c. (t -> Address' -> c) -> t -> Address -> c
withAddress' BlockId -> Address' -> m TezosInt64
getCounter'
  , getScript :: BlockId -> Address -> m OriginationScript
getScript         = (BlockId -> Address' -> m OriginationScript)
-> BlockId -> Address -> m OriginationScript
forall t c. (t -> Address' -> c) -> t -> Address -> c
withAddress' BlockId -> Address' -> m OriginationScript
getScript'
  , getStorageAtBlock :: BlockId -> Address -> m Expression
getStorageAtBlock = (BlockId -> Address' -> m Expression)
-> BlockId -> Address -> m Expression
forall t c. (t -> Address' -> c) -> t -> Address -> c
withAddress' BlockId -> Address' -> m Expression
getStorageAtBlock'
  , getBigMap :: BlockId -> Address -> GetBigMap -> m GetBigMapResult
getBigMap         = (BlockId -> Address' -> GetBigMap -> m GetBigMapResult)
-> BlockId -> Address -> GetBigMap -> m GetBigMapResult
forall t c. (t -> Address' -> c) -> t -> Address -> c
withAddress' BlockId -> Address' -> GetBigMap -> m GetBigMapResult
getBigMap'
  , getBalance :: BlockId -> Address -> m TezosMutez
getBalance        = (BlockId -> Address' -> m TezosMutez)
-> BlockId -> Address -> m TezosMutez
forall t c. (t -> Address' -> c) -> t -> Address -> c
withAddress' BlockId -> Address' -> m TezosMutez
getBalance'
  , getDelegate :: BlockId -> Address -> m (Maybe KeyHash)
getDelegate       = \BlockId
block Address
addr -> do
      Either ClientError KeyHash
result <- m KeyHash -> m (Either ClientError KeyHash)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m KeyHash -> m (Either ClientError KeyHash))
-> m KeyHash -> m (Either ClientError KeyHash)
forall a b. (a -> b) -> a -> b
$ BlockId -> Address' -> m KeyHash
getDelegate' BlockId
block (Address -> Address'
Address' Address
addr)
      case Either ClientError KeyHash
result of
        Left (FailureResponse RequestF () (BaseUrl, ByteString)
_ Response{responseStatusCode :: forall a. ResponseF a -> Status
responseStatusCode=Status{statusCode :: Status -> Int
statusCode = Int
404}})
          -> Maybe KeyHash -> m (Maybe KeyHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe KeyHash
forall a. Maybe a
Nothing
        Left ClientError
err -> ClientError -> m (Maybe KeyHash)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientError
err
        Right KeyHash
res -> Maybe KeyHash -> m (Maybe KeyHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe KeyHash -> m (Maybe KeyHash))
-> Maybe KeyHash -> m (Maybe KeyHash)
forall a b. (a -> b) -> a -> b
$ KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just KeyHash
res
  , getManagerKey :: BlockId -> Address -> m (Maybe PublicKey)
getManagerKey     = (BlockId -> Address' -> m (Maybe PublicKey))
-> BlockId -> Address -> m (Maybe PublicKey)
forall t c. (t -> Address' -> c) -> t -> Address -> c
withAddress' BlockId -> Address' -> m (Maybe PublicKey)
getManagerKey'
  , m Text
HexJSONByteString -> m OperationHash
BlockId -> m [[BlockOperation]]
BlockId -> m Text
BlockId -> m ProtocolParameters
BlockId -> m BlockHeader
BlockId -> m BlockConstants
BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
BlockId -> Natural -> Text -> m Expression
BlockId -> [PreApplyOperation] -> m [RunOperationResult]
BlockId -> RunCode -> m RunCodeResult
BlockId -> RunOperation -> m RunOperationResult
BlockId -> ForgeOperation -> m HexJSONByteString
injectOperation :: HexJSONByteString -> m OperationHash
getChainId :: m Text
runCode :: BlockId -> RunCode -> m RunCodeResult
preApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult]
runOperation :: BlockId -> RunOperation -> m RunOperationResult
forgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString
getBigMapValuesAtBlock :: BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression
getBlockOperations :: BlockId -> m [[BlockOperation]]
getProtocolParameters :: BlockId -> m ProtocolParameters
getBlockHeader :: BlockId -> m BlockHeader
getBlockConstants :: BlockId -> m BlockConstants
getBlockHash :: BlockId -> m Text
injectOperation :: HexJSONByteString -> m OperationHash
getChainId :: m Text
runCode :: BlockId -> RunCode -> m RunCodeResult
preApplyOperations :: BlockId -> [PreApplyOperation] -> m [RunOperationResult]
runOperation :: BlockId -> RunOperation -> m RunOperationResult
forgeOperation :: BlockId -> ForgeOperation -> m HexJSONByteString
getBigMapValuesAtBlock :: BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression
getBlockOperations :: BlockId -> m [[BlockOperation]]
getProtocolParameters :: BlockId -> m ProtocolParameters
getBlockHeader :: BlockId -> m BlockHeader
getBlockConstants :: BlockId -> m BlockConstants
getBlockHash :: BlockId -> m Text
..
  }
  where
    withAddress' :: (t -> Address' -> c) -> t -> Address -> c
withAddress' t -> Address' -> c
f t
blockId = t -> Address' -> c
f t
blockId (Address' -> c) -> (Address -> Address') -> Address -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Address'
Address'
    getDelegate' :: BlockId -> Address' -> m KeyHash
    (BlockId -> m Text
getBlockHash :<|> BlockId -> Address' -> m TezosInt64
getCounter' :<|> BlockId -> Address' -> m OriginationScript
getScript' :<|> BlockId -> Address' -> m Expression
getStorageAtBlock' :<|> BlockId -> m BlockConstants
getBlockConstants :<|>
      BlockId -> m BlockHeader
getBlockHeader :<|> BlockId -> m ProtocolParameters
getProtocolParameters :<|> BlockId -> m [[BlockOperation]]
getBlockOperations :<|> BlockId -> Address' -> GetBigMap -> m GetBigMapResult
getBigMap' :<|>
      BlockId -> Natural -> Text -> m Expression
getBigMapValueAtBlock :<|> BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValuesAtBlock :<|> BlockId -> Address' -> m TezosMutez
getBalance' :<|> BlockId -> Address' -> m KeyHash
getDelegate' :<|>
      BlockId -> ForgeOperation -> m HexJSONByteString
forgeOperation :<|> BlockId -> RunOperation -> m RunOperationResult
runOperation :<|> BlockId -> [PreApplyOperation] -> m [RunOperationResult]
preApplyOperations :<|> BlockId -> RunCode -> m RunCodeResult
runCode :<|> BlockId -> Address' -> m (Maybe PublicKey)
getManagerKey') :<|>
      m Text
getChainId :<|> HexJSONByteString -> m OperationHash
injectOperation =
      Proxy NodeAPI
nodeAPI Proxy NodeAPI -> Proxy m -> Client m NodeAPI
forall (m :: * -> *) api.
HasClient m api =>
Proxy api -> Proxy m -> Client m api
`clientIn` (Proxy m
forall k (t :: k). Proxy t
Proxy @m)

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

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

instance ToHttpApiData Address' where
  toUrlPiece :: Address' -> Text
toUrlPiece = Address -> Text
formatAddress (Address -> Text) -> (Address' -> Address) -> Address' -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address' -> Address
unAddress'