Skip to content

Commit f1f208a

Browse files
carbolymercarbolymer
committed
cardano-rpc | Add UTxO RPC protocol parameters query
1 parent a8055a4 commit f1f208a

File tree

9 files changed

+335
-16
lines changed

9 files changed

+335
-16
lines changed

‎cardano-rpc/CHANGELOG.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,3 +6,4 @@
66
(feature)
77
[PR 885](https://github.com/IntersectMBO/cardano-api/pull/885)
88

9+
- Add UTxO RPC protocol parameters query

‎cardano-rpc/cardano-rpc.cabal‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -54,25 +54,42 @@ library
5454
exposed-modules:
5555
Cardano.Rpc.Client
5656
Cardano.Rpc.Proto.Api.Node
57+
Cardano.Rpc.Proto.Api.UtxoRpc.Query
5758
Cardano.Rpc.Server
5859
Cardano.Rpc.Server.Config
5960
Cardano.Rpc.Server.Internal.Env
6061
Cardano.Rpc.Server.Internal.Error
6162
Cardano.Rpc.Server.Internal.Monad
63+
Cardano.Rpc.Server.Internal.UtxoRpc.Query
6264
Proto.Cardano.Rpc.Node
6365
Proto.Cardano.Rpc.Node_Fields
66+
Proto.Utxorpc.V1alpha.Cardano.Cardano
67+
Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields
68+
Proto.Utxorpc.V1alpha.Query.Query
69+
Proto.Utxorpc.V1alpha.Query.Query_Fields
6470

6571
other-modules:
72+
Cardano.Rpc.Server.Internal.Orphans
6673
Paths_cardano_rpc
6774

6875
autogen-modules:
6976
Paths_cardano_rpc
7077
Proto.Cardano.Rpc.Node
7178
Proto.Cardano.Rpc.Node_Fields
79+
Proto.Utxorpc.V1alpha.Cardano.Cardano
80+
Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields
81+
Proto.Utxorpc.V1alpha.Query.Query
82+
Proto.Utxorpc.V1alpha.Query.Query_Fields
7283

7384
build-depends:
7485
base,
86+
bytestring,
7587
cardano-api >=10.17,
88+
cardano-ledger-api,
89+
cardano-ledger-binary,
90+
cardano-ledger-conway,
91+
cardano-ledger-core,
92+
containers,
7693
contra-tracer,
7794
filepath,
7895
generic-data,

‎cardano-rpc/proto/cardano/rpc/node.proto‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
1-
21
syntax = "proto3";
32

3+
package cardano.rpc;
4+
45
import "google/protobuf/empty.proto";
56

67
service Node {
@@ -10,7 +11,7 @@ service Node {
1011
}
1112

1213
enum Era {
13-
byron = 0;
14+
byron = 0;
1415
shelley = 1;
1516
allegra = 2;
1617
mary = 3;

‎cardano-rpc/src/Cardano/Rpc/Client.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@ module Cardano.Rpc.Client
88
)
99
where
1010

11+
import Cardano.Rpc.Server.Internal.Orphans ()
12+
1113
import Data.ProtoLens.Field
1214
import Network.GRPC.Client
1315
import Network.GRPC.Client.StreamType.IO

‎cardano-rpc/src/Cardano/Rpc/Proto/Api/UtxoRpc/Query.hs‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
{-# LANGUAGE TypeFamilies #-}
2+
{-# OPTIONS_GHC -Wno-orphans #-}
3+
4+
module Cardano.Rpc.Proto.Api.UtxoRpc.Query
5+
( module Proto.Utxorpc.V1alpha.Query.Query
6+
, module Proto.Utxorpc.V1alpha.Query.Query_Fields
7+
, module Proto.Utxorpc.V1alpha.Cardano.Cardano
8+
, module Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields
9+
)
10+
where
11+
12+
import Network.GRPC.Common
13+
import Network.GRPC.Common.Protobuf
14+
15+
import Proto.Utxorpc.V1alpha.Cardano.Cardano
16+
import Proto.Utxorpc.V1alpha.Cardano.Cardano_Fields hiding
17+
( values
18+
, vec'values
19+
)
20+
import Proto.Utxorpc.V1alpha.Query.Query
21+
import Proto.Utxorpc.V1alpha.Query.Query_Fields
22+
23+
type instance RequestMetadata (Protobuf QueryService meth) = NoMetadata
24+
25+
type instance ResponseInitialMetadata (Protobuf QueryService meth) = NoMetadata
26+
27+
type instance ResponseTrailingMetadata (Protobuf QueryService meth) = NoMetadata

‎cardano-rpc/src/Cardano/Rpc/Server.hs‎

Lines changed: 39 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -16,15 +16,20 @@ where
1616

1717
import Cardano.Api
1818
import Cardano.Rpc.Proto.Api.Node qualified as Rpc
19+
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
1920
import Cardano.Rpc.Server.Config
21+
import Cardano.Rpc.Server.Internal.Env
2022
import Cardano.Rpc.Server.Internal.Monad
23+
import Cardano.Rpc.Server.Internal.Orphans ()
24+
import Cardano.Rpc.Server.Internal.UtxoRpc.Query
2125

2226
import RIO
2327

2428
import Control.Tracer
2529
import Data.ProtoLens (defMessage)
2630
import Data.ProtoLens.Field (field)
2731
import Network.GRPC.Common
32+
import Network.GRPC.Server
2833
import Network.GRPC.Server.Protobuf
2934
import Network.GRPC.Server.Run
3035
import Network.GRPC.Server.StreamType
@@ -47,37 +52,59 @@ methodsNodeRpc
4752
=> Methods m (ProtobufMethodsOf Rpc.Node)
4853
methodsNodeRpc = Method (mkNonStreaming getEraMethod) NoMoreMethods
4954

55+
methodsUtxoRpc
56+
:: MonadRpc e m
57+
=> Methods m (ProtobufMethodsOf UtxoRpc.QueryService)
58+
methodsUtxoRpc =
59+
Method (mkNonStreaming readParamsMethod) NoMoreMethods
60+
5061
runRpcServer
5162
:: Tracer IO String
5263
-> IO (RpcConfig, NetworkMagic)
5364
-- ^ action which reloads RPC configuration
5465
-> IO ()
55-
runRpcServer tracer loadRpcConfig = handleExceptions $ do
56-
( RpcConfig
66+
runRpcServer tracer loadRpcConfig = handleFatalExceptions $ do
67+
( rpcConfig@RpcConfig
5768
{ isEnabled = Identity isEnabled
5869
, rpcSocketPath = Identity (File rpcSocketPathFp)
70+
, nodeSocketPath = Identity nodeSocketPath
5971
}
60-
, _networkMagic
72+
, networkMagic
6173
) <-
6274
loadRpcConfig
6375
let config =
6476
ServerConfig
6577
{ serverInsecure = Just $ InsecureUnix rpcSocketPathFp
6678
, serverSecure = Nothing
6779
}
80+
rpcEnv =
81+
RpcEnv
82+
{ config = rpcConfig
83+
, tracer = natTracer liftIO tracer
84+
, rpcLocalNodeConnectInfo = mkLocalNodeConnectInfo nodeSocketPath networkMagic
85+
}
6886

6987
-- TODO this is logged by node configuration already, so it would make sense to log it again when
7088
-- configuration gets reloaded
71-
-- putTrace $ "RPC configuration: " <> show rpcConfig
89+
-- traceWith $ "RPC configuration: " <> show rpcConfig
7290

7391
when isEnabled $
74-
runServerWithHandlers def config $
75-
mconcat
76-
[ fromMethods methodsNodeRpc
77-
]
92+
runRIO rpcEnv $
93+
withRunInIO $ \runInIO ->
94+
runServerWithHandlers serverParams config . fmap (hoistSomeRpcHandler runInIO) $
95+
mconcat
96+
[ fromMethods methodsNodeRpc
97+
, fromMethods methodsUtxoRpc
98+
]
7899
where
79-
handleExceptions :: (HasCallStack => IO ()) -> IO ()
80-
handleExceptions = handleAny $ \e ->
81-
putTrace $ "RPC server fatal error: " <> displayException e
100+
serverParams :: ServerParams
101+
serverParams = def{serverTopLevel = topLevelHandler}
102+
103+
-- Top level hook for request handlers, handle exceptions
104+
topLevelHandler :: RequestHandler () -> RequestHandler ()
105+
topLevelHandler h unmask req resp = catchAny (h unmask req resp) $ \e ->
106+
traceWith tracer $ "Exception when processing RPC request:\n" <> displayException e
82107

83-
putTrace = traceWith tracer
108+
handleFatalExceptions :: (HasCallStack => IO ()) -> IO ()
109+
handleFatalExceptions = handleAny $ \e ->
110+
traceWith tracer $ "RPC server fatal error: " <> displayException e

‎cardano-rpc/src/Cardano/Rpc/Server/Internal/Monad.hs‎

Lines changed: 43 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,19 +2,60 @@
22
{-# LANGUAGE DataKinds #-}
33
{-# LANGUAGE DerivingVia #-}
44
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
56
{-# LANGUAGE GADTs #-}
67
{-# LANGUAGE MultiParamTypeClasses #-}
8+
{-# LANGUAGE NamedFieldPuns #-}
79
{-# LANGUAGE QuantifiedConstraints #-}
810
{-# LANGUAGE RankNTypes #-}
911
{-# LANGUAGE ScopedTypeVariables #-}
12+
{-# LANGUAGE TypeApplications #-}
1013

1114
module Cardano.Rpc.Server.Internal.Monad
12-
( MonadRpc
15+
( Has (..)
16+
, MonadRpc
17+
, grab
18+
, putTrace
1319
)
1420
where
1521

1622
import Cardano.Api
23+
import Cardano.Rpc.Server.Internal.Env
1724

1825
import RIO
1926

20-
type MonadRpc e m = (HasCallStack, MonadIO m)
27+
import Control.Tracer (Tracer, traceWith)
28+
29+
-- | Provides a value of type 'field' from the value 'env'
30+
-- Used in conjunction with 'MonadReader env m' allows to easily access fields from the environment.
31+
class Has field env where
32+
obtain :: env -> field
33+
34+
instance Has a a where
35+
obtain = id
36+
37+
instance Has LocalNodeConnectInfo RpcEnv where
38+
obtain RpcEnv{rpcLocalNodeConnectInfo} = rpcLocalNodeConnectInfo
39+
40+
instance MonadIO m => Has (Tracer m String) RpcEnv where
41+
obtain RpcEnv{tracer} = tracer
42+
43+
-- | Obtain the field from the environment
44+
grab
45+
:: forall field env m
46+
. (Has field env, MonadReader env m)
47+
=> m field
48+
grab = asks $ obtain @field
49+
{-# INLINE grab #-}
50+
51+
-- | Using tracer from the environment, print the trace
52+
putTrace :: (Has (Tracer m t) e, MonadReader e m) => t -> m ()
53+
putTrace t = grab >>= (`traceWith` t)
54+
55+
type MonadRpc e m =
56+
( Has (Tracer m String) e
57+
, Has LocalNodeConnectInfo e
58+
, HasCallStack
59+
, MonadReader e m
60+
, MonadUnliftIO m
61+
)

‎cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs‎

Lines changed: 51 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,51 @@
1+
{-# LANGUAGE FlexibleInstances #-}
2+
{-# LANGUAGE MultiParamTypeClasses #-}
3+
{-# LANGUAGE OverloadedLabels #-}
4+
{-# OPTIONS_GHC -Wno-orphans #-}
5+
6+
module Cardano.Rpc.Server.Internal.Orphans () where
7+
8+
import Cardano.Api.Block (ChainPoint (..), Hash (..), SlotNo (..))
9+
import Cardano.Api.Era (Inject (..))
10+
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
11+
12+
import Cardano.Ledger.Plutus qualified as L
13+
14+
import RIO
15+
16+
import Data.ByteString.Short qualified as SBS
17+
import Data.ProtoLens (defMessage)
18+
import Data.Ratio (Ratio, denominator, numerator, (%))
19+
import Network.GRPC.Spec
20+
21+
instance Inject (Proto UtxoRpc.RationalNumber) (Ratio Integer) where
22+
inject r = r ^. #numerator . to fromIntegral % r ^. #denominator . to fromIntegral
23+
24+
instance Inject (Ratio Integer) (Proto UtxoRpc.RationalNumber) where
25+
inject r =
26+
defMessage
27+
& #numerator .~ fromIntegral (numerator r)
28+
& #denominator .~ fromIntegral (denominator r)
29+
30+
instance Inject (Proto UtxoRpc.ExUnits) L.ExUnits where
31+
inject r =
32+
L.ExUnits
33+
{ L.exUnitsMem = r ^. #memory . to fromIntegral
34+
, L.exUnitsSteps = r ^. #steps . to fromIntegral
35+
}
36+
37+
instance Inject L.ExUnits (Proto UtxoRpc.ExUnits) where
38+
inject L.ExUnits{L.exUnitsMem = mem, L.exUnitsSteps = steps} =
39+
defMessage
40+
& #memory .~ fromIntegral mem
41+
& #steps .~ fromIntegral steps
42+
43+
instance Inject ChainPoint (Proto UtxoRpc.ChainPoint) where
44+
inject chainPoint = do
45+
let (slotNo, blockHash) =
46+
case chainPoint of
47+
ChainPointAtGenesis -> (0, mempty)
48+
ChainPoint (SlotNo slot) (HeaderHash hash) -> (slot, SBS.fromShort hash)
49+
defMessage
50+
& #slot .~ slotNo
51+
& #hash .~ blockHash

0 commit comments

Comments
 (0)