-- 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
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 :> 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 `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" ContractAddress' :> "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 NodeAPI
nodeAPI = Proxy NodeAPI
forall {k} (t :: k). Proxy t
Proxy

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


monitorHeads :: forall m. (RunStreamingClient m) => m (SourceIO BlockHeader)
monitorHeads :: forall (m :: * -> *).
RunStreamingClient m =>
m (SourceIO BlockHeader)
monitorHeads = forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @StreamingAPI Proxy StreamingAPI -> Proxy m -> Client m StreamingAPI
forall (m :: * -> *) api.
HasClient m api =>
Proxy api -> Proxy m -> Client m api
`clientIn` forall {k} (t :: k). Proxy t
forall {t :: * -> *}. Proxy t
Proxy @m

nodeMethods :: forall m. (MonadCatch m, RunClient m) => NodeMethods m
nodeMethods :: forall (m :: * -> *). (MonadCatch m, RunClient m) => NodeMethods m
nodeMethods = NodeMethods :: forall (m :: * -> *).
(BlockId -> m Text)
-> (BlockId -> ImplicitAddress -> m TezosInt64)
-> (BlockId -> ContractAddress -> m OriginationScript)
-> (BlockId -> ContractAddress -> m Expression)
-> (BlockId -> m BlockConstants)
-> (BlockId -> m BlockHeader)
-> (BlockId -> m ProtocolParameters)
-> (BlockId -> m [[BlockOperation]])
-> (BlockId -> m [[OperationHash]])
-> (BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult)
-> (BlockId -> Natural -> Text -> m Expression)
-> (BlockId
    -> Natural -> Maybe Natural -> Maybe Natural -> m Expression)
-> (BlockId -> Address -> m TezosMutez)
-> (BlockId -> ContractAddress -> m (Maybe KeyHash))
-> (BlockId -> CalcSize -> m ScriptSize)
-> (BlockId -> ForgeOperation -> m HexJSONByteString)
-> (BlockId -> RunOperation -> m RunOperationResult)
-> (BlockId -> [PreApplyOperation] -> m [RunOperationResult])
-> (BlockId -> RunCode -> m RunCodeResult)
-> (BlockId -> ImplicitAddress -> m (Maybe PublicKey))
-> m Text
-> (HexJSONByteString -> m OperationHash)
-> NodeMethods m
NodeMethods
  { getCounter :: BlockId -> ImplicitAddress -> m TezosInt64
getCounter        = (BlockId -> ImplicitAddress' -> m TezosInt64)
-> BlockId -> ImplicitAddress -> m TezosInt64
forall {t} {kind :: AddressKind} {c}.
(t -> KindedAddress' kind -> c) -> t -> KindedAddress kind -> c
withKindedAddress' BlockId -> ImplicitAddress' -> m TezosInt64
getCounter'
  , getScript :: BlockId -> ContractAddress -> m OriginationScript
getScript         = (BlockId -> ContractAddress' -> m OriginationScript)
-> BlockId -> ContractAddress -> m OriginationScript
forall {t} {kind :: AddressKind} {c}.
(t -> KindedAddress' kind -> c) -> t -> KindedAddress kind -> c
withKindedAddress' BlockId -> ContractAddress' -> m OriginationScript
getScript'
  , getStorageAtBlock :: BlockId -> ContractAddress -> m Expression
getStorageAtBlock = (BlockId -> ContractAddress' -> m Expression)
-> BlockId -> ContractAddress -> m Expression
forall {t} {kind :: AddressKind} {c}.
(t -> KindedAddress' kind -> c) -> t -> KindedAddress kind -> c
withKindedAddress' BlockId -> ContractAddress' -> m Expression
getStorageAtBlock'
  , getBigMap :: BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
getBigMap         = (BlockId -> ContractAddress' -> GetBigMap -> m GetBigMapResult)
-> BlockId -> ContractAddress -> GetBigMap -> m GetBigMapResult
forall {t} {kind :: AddressKind} {c}.
(t -> KindedAddress' kind -> c) -> t -> KindedAddress kind -> c
withKindedAddress' BlockId -> ContractAddress' -> 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 -> ContractAddress -> m (Maybe KeyHash)
getDelegate       = \BlockId
block ContractAddress
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 -> ContractAddress' -> m KeyHash
getDelegate' BlockId
block (ContractAddress -> ContractAddress'
forall (kind :: AddressKind).
KindedAddress kind -> KindedAddress' kind
KindedAddress' ContractAddress
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 -> ImplicitAddress -> m (Maybe PublicKey)
getManagerKey     = (BlockId -> ImplicitAddress' -> m (Maybe PublicKey))
-> BlockId -> ImplicitAddress -> m (Maybe PublicKey)
forall {t} {kind :: AddressKind} {c}.
(t -> KindedAddress' kind -> c) -> t -> KindedAddress kind -> c
withKindedAddress' BlockId -> ImplicitAddress' -> m (Maybe PublicKey)
getManagerKey'
  , m Text
HexJSONByteString -> m OperationHash
BlockId -> m [[BlockOperation]]
BlockId -> m [[OperationHash]]
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 -> CalcSize -> m ScriptSize
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
getScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize
getBigMapValuesAtBlock :: BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression
getBlockOperationHashes :: BlockId -> m [[OperationHash]]
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
getScriptSizeAtBlock :: BlockId -> CalcSize -> m ScriptSize
getBigMapValuesAtBlock :: BlockId
-> Natural -> Maybe Natural -> Maybe Natural -> m Expression
getBigMapValueAtBlock :: BlockId -> Natural -> Text -> m Expression
getBlockOperationHashes :: BlockId -> m [[OperationHash]]
getBlockOperations :: BlockId -> m [[BlockOperation]]
getProtocolParameters :: BlockId -> m ProtocolParameters
getBlockHeader :: BlockId -> m BlockHeader
getBlockConstants :: BlockId -> m BlockConstants
getBlockHash :: BlockId -> m Text
..
  }
  where
    withKindedAddress' :: (t -> KindedAddress' kind -> c) -> t -> KindedAddress kind -> c
withKindedAddress' t -> KindedAddress' kind -> c
f t
blockId = t -> KindedAddress' kind -> c
f t
blockId (KindedAddress' kind -> c)
-> (KindedAddress kind -> KindedAddress' kind)
-> KindedAddress kind
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress kind -> KindedAddress' kind
forall (kind :: AddressKind).
KindedAddress kind -> KindedAddress' kind
KindedAddress'
    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 -> ContractAddress' -> m KeyHash
    (BlockId -> m Text
getBlockHash
        :<|> BlockId -> ImplicitAddress' -> m TezosInt64
getCounter'
        :<|> BlockId -> ContractAddress' -> m OriginationScript
getScript'
        :<|> BlockId -> ContractAddress' -> m Expression
getStorageAtBlock'
        :<|> BlockId -> m BlockConstants
getBlockConstants
        :<|> BlockId -> m BlockHeader
getBlockHeader
        :<|> BlockId -> m ProtocolParameters
getProtocolParameters
        :<|> BlockId -> m [[BlockOperation]]
getBlockOperations
        :<|> BlockId -> m [[OperationHash]]
getBlockOperationHashes
        :<|> BlockId -> ContractAddress' -> 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 -> ContractAddress' -> m KeyHash
getDelegate'
        :<|> BlockId -> ImplicitAddress' -> m (Maybe PublicKey)
getManagerKey'
        :<|> BlockId -> CalcSize -> m ScriptSize
getScriptSizeAtBlock
        :<|> BlockId -> ForgeOperation -> m HexJSONByteString
forgeOperation
        :<|> BlockId -> RunOperation -> m RunOperationResult
runOperation
        :<|> BlockId -> [PreApplyOperation] -> m [RunOperationResult]
preApplyOperations
        :<|> BlockId -> RunCode -> m RunCodeResult
runCode)
      :<|> 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` (forall {k} (t :: k). Proxy t
forall {t :: * -> *}. Proxy t
Proxy @m)

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

-- | We use this wrapper to avoid orphan instances.
newtype KindedAddress' kind = KindedAddress' { forall (kind :: AddressKind).
KindedAddress' kind -> KindedAddress kind
unAddress' :: KindedAddress kind }

type ContractAddress' = KindedAddress' 'AddressKindContract
type ImplicitAddress' = KindedAddress' 'AddressKindImplicit

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

newtype Address' = Address' Address

instance ToHttpApiData Address' where
  toUrlPiece :: Address' -> Text
toUrlPiece (Address' (MkAddress KindedAddress kind
addr)) = KindedAddress kind -> Text
forall (kind :: AddressKind). KindedAddress kind -> Text
formatAddress KindedAddress kind
addr