Skip to content

Commit 63f5c1d

Browse files
carbolymercarbolymer
authored
Merge pull request #1098 from IntersectMBO/mgalazyn/proto-lens-ghc-9.12
gRPC: GHC 9.12 support
2 parents 0e10e8a + 936deb7 commit 63f5c1d

11 files changed

Lines changed: 289 additions & 212 deletions

File tree

‎.github/workflows/haskell.yml‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -85,11 +85,11 @@ jobs:
8585
use-sodium-vrf: true # default is true
8686

8787
- name: "[Linux] Install grpc dependencies"
88-
if: runner.os == 'Linux' && matrix.ghc != '9.12'
88+
if: runner.os == 'Linux'
8989
run: sudo apt install libsnappy-dev protobuf-compiler
9090

9191
- name: "[Windows] Install grpc dependencies"
92-
if: runner.os == 'Windows' && matrix.ghc != '9.12'
92+
if: runner.os == 'Windows'
9393
run: |
9494
/usr/bin/pacman --noconfirm -S mingw-w64-x86_64-snappy mingw-w64-x86_64-protobuf
9595
cat <<EOF >> $GITHUB_ENV
@@ -98,7 +98,7 @@ jobs:
9898
EOF
9999
100100
- name: "[macOS] Install grpc dependencies"
101-
if: runner.os == 'macOS' && matrix.ghc != '9.12'
101+
if: runner.os == 'macOS'
102102
run: |
103103
brew install snappy protobuf
104104
SNAPPY_PREFIX=$(brew --prefix snappy)
@@ -118,23 +118,23 @@ jobs:
118118

119119

120120
- name: '[Linux] [cardano-rpc] Install buf'
121-
if: runner.os == 'Linux' && matrix.ghc != '9.12'
121+
if: runner.os == 'Linux'
122122
run: |
123123
curl -sSL "https://github.com/bufbuild/buf/releases/latest/download/buf-Linux-x86_64" -o "/usr/local/bin/buf"
124124
chmod +x /usr/local/bin/buf
125125
126126
- name: '[Linux] [cardano-rpc] Install proto-lens-protoc'
127-
if: runner.os == 'Linux' && matrix.ghc != '9.12'
127+
if: runner.os == 'Linux'
128128
run: |
129129
cabal install proto-lens-protoc --installdir=$HOME/.local/bin
130130
131131
- name: '[Linux] [cardano-rpc] Generate protobuf code'
132-
if: runner.os == 'Linux' && matrix.ghc != '9.12'
132+
if: runner.os == 'Linux'
133133
working-directory: cardano-rpc
134134
run: buf generate proto
135135

136136
- name: '[Linux] [cardano-rpc] Check that generated files from proto definitions are up to date'
137-
if: runner.os == 'Linux' && matrix.ghc != '9.12'
137+
if: runner.os == 'Linux'
138138
run: |
139139
git add cardano-rpc/gen
140140
if ! git diff --staged --quiet -- cardano-rpc/gen; then

‎.github/workflows/hls.yml‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -114,8 +114,6 @@ jobs:
114114
- name: Test HLS works
115115
if: steps.check_trivial_changes.outputs.CHECK_HLS_WORKS > 0
116116
run: |
117-
# TODO remove after reenabling cardano-rpc
118-
rm -r cardano-rpc/
119117
# workaround for https://github.com/haskell/haskell-language-server/issues/3735
120118
cat <<EOF > hie.yaml
121119
cradle:

‎cabal.project‎

Lines changed: 32 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ packages:
2020
cardano-api
2121
cardano-api-gen
2222
cardano-wasm
23-
-- cardano-rpc
23+
cardano-rpc
2424

2525
extra-packages: Cabal
2626

@@ -51,10 +51,18 @@ write-ghc-environment-files: always
5151
jobs: $ncpus
5252
semaphore: True
5353

54-
if impl (ghc >= 9.12)
55-
constraints:
56-
-- haskell.nix patch does not work for 1.6.8
57-
, any.crypton-x509-system < 1.6.8
54+
55+
constraints:
56+
-- haskell.nix patch does not work for 1.6.8
57+
, any.crypton-x509-system < 1.6.8
58+
59+
if impl(ghc >= 9.12)
60+
allow-newer:
61+
-- we need newer io-classes: https://github.com/input-output-hk/typed-protocols/tree/coot/io-classes-1.9
62+
, io-classes:time
63+
, ouroboros-network:time
64+
, nothunks:time
65+
, network-mux:time
5866

5967
-- WASM compilation specific
6068

@@ -159,6 +167,25 @@ if arch(wasm32)
159167
package digest
160168
flags: -pkg-config
161169

170+
-- GHC 9.12 support https://github.com/google/proto-lens/pull/519
171+
source-repository-package
172+
type: git
173+
location: https://github.com/carbolymer/proto-lens
174+
tag: 732ff478957507bdbdaf72606281df3fcb6b0121
175+
--sha256: sha256-DR2hxFDNMICcueggBObhi+L5bKeake/Mj4N0078P3SA=
176+
subdir:
177+
discrimination-ieee754
178+
proto-lens-arbitrary
179+
proto-lens-benchmarks
180+
proto-lens-discrimination
181+
proto-lens-optparse
182+
proto-lens-protobuf-types
183+
proto-lens-protoc
184+
proto-lens-runtime
185+
proto-lens-setup
186+
proto-lens-tests-dep
187+
proto-lens-tests
188+
proto-lens
162189

163190
-- IMPORTANT
164191
-- Do NOT add more source-repository-package stanzas here unless they are strictly

‎cardano-api/cardano-api.cabal‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -165,11 +165,11 @@ library
165165
network-mux,
166166
nothunks,
167167
ordered-containers,
168-
ouroboros-consensus >=0.30.0.1 && <0.31,
168+
ouroboros-consensus ^>=0.30.0.1,
169169
ouroboros-consensus-cardano ^>=0.26,
170170
ouroboros-consensus-diffusion ^>=0.26,
171171
ouroboros-consensus-protocol ^>=0.13,
172-
ouroboros-network >=0.22.6.0 && <0.23,
172+
ouroboros-network ^>=0.22.6.0,
173173
ouroboros-network-api >=0.15,
174174
ouroboros-network-framework,
175175
ouroboros-network-protocols >=0.15,
@@ -193,7 +193,7 @@ library
193193
time,
194194
transformers,
195195
transformers-except ^>=0.1.3,
196-
typed-protocols ^>=1.0,
196+
typed-protocols >=1.0,
197197
validation,
198198
vector,
199199
yaml,
@@ -319,7 +319,7 @@ library gen
319319
Test.Hedgehog.Roundtrip.CBOR
320320

321321
build-depends:
322-
QuickCheck <2.16,
322+
QuickCheck <2.18,
323323
aeson >=1.5.6.0,
324324
base16-bytestring,
325325
bytestring,
@@ -354,7 +354,7 @@ test-suite cardano-api-test
354354
buildable: False
355355
build-depends:
356356
FailT,
357-
QuickCheck <2.16,
357+
QuickCheck <2.18,
358358
aeson >=1.5.6.0,
359359
base16-bytestring,
360360
bytestring,

‎cardano-rpc/cardano-rpc.cabal‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -38,9 +38,6 @@ common project-config
3838
-Wredundant-constraints
3939
-Wunused-packages
4040

41-
if impl(ghc >=9.12)
42-
buildable: False
43-
4441
library
4542
import: project-config
4643
hs-source-dirs: src

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

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@
33
{-# LANGUAGE DerivingVia #-}
44
{-# LANGUAGE FlexibleContexts #-}
55
{-# LANGUAGE GADTs #-}
6-
{-# LANGUAGE OverloadedLabels #-}
76
{-# LANGUAGE QuantifiedConstraints #-}
87
{-# LANGUAGE RankNTypes #-}
98
{-# LANGUAGE ScopedTypeVariables #-}
@@ -33,7 +32,7 @@ import Network.GRPC.Spec
3332
import Proto.Google.Protobuf.Empty
3433

3534
getEraMethod :: MonadRpc e m => Proto Empty -> m (Proto Rpc.CurrentEra)
36-
getEraMethod _ = pure . Proto $ defMessage & #era .~ Rpc.Conway
35+
getEraMethod _ = pure . Proto $ defMessage & Rpc.era .~ Rpc.Conway
3736

3837
getProtocolParamsJsonMethod :: MonadRpc e m => Proto Empty -> m (Proto Rpc.ProtocolParamsJson)
3938
getProtocolParamsJsonMethod _ = do
@@ -52,4 +51,4 @@ getProtocolParamsJsonMethod _ = do
5251

5352
pure $
5453
def
55-
& #json .~ BL.toStrict pparamsJson
54+
& Rpc.json .~ BL.toStrict pparamsJson

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

Lines changed: 24 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE FlexibleInstances #-}
23
{-# LANGUAGE GADTs #-}
34
{-# LANGUAGE MultiParamTypeClasses #-}
4-
{-# LANGUAGE OverloadedLabels #-}
55
{-# LANGUAGE RankNTypes #-}
66
{-# LANGUAGE ScopedTypeVariables #-}
77
{-# LANGUAGE TypeApplications #-}
@@ -15,7 +15,7 @@ import Cardano.Api.Ledger qualified as L
1515
import Cardano.Api.Pretty
1616
import Cardano.Api.Serialise.Raw
1717
import Cardano.Api.Tx
18-
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
18+
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
1919

2020
import RIO hiding (toList)
2121

@@ -31,54 +31,56 @@ import Network.GRPC.Spec
3131

3232
-- It's easier to use 'Proto a' wrappers for RPC types, because it makes lens automatically available.
3333

34-
instance Inject (Proto UtxoRpc.RationalNumber) Rational where
35-
inject r = r ^. #numerator . to fromIntegral % r ^. #denominator . to fromIntegral
34+
-- x = U5c.numerator :: _
35+
36+
instance Inject (Proto U5c.RationalNumber) Rational where
37+
inject r = r ^. U5c.numerator . to fromIntegral % r ^. U5c.denominator . to fromIntegral
3638

3739
-- NB. this clips value in Integer -> Int64/Word64 conversion here
38-
instance Inject Rational (Proto UtxoRpc.RationalNumber) where
40+
instance Inject Rational (Proto U5c.RationalNumber) where
3941
inject r =
4042
defMessage
41-
& #numerator .~ fromIntegral (numerator r)
42-
& #denominator .~ fromIntegral (denominator r)
43+
& U5c.numerator .~ fromIntegral (numerator r)
44+
& U5c.denominator .~ fromIntegral (denominator r)
4345

44-
instance Inject (Proto UtxoRpc.ExUnits) L.ExUnits where
46+
instance Inject (Proto U5c.ExUnits) L.ExUnits where
4547
inject r =
4648
L.ExUnits
47-
{ L.exUnitsMem = r ^. #memory . to fromIntegral
48-
, L.exUnitsSteps = r ^. #steps . to fromIntegral
49+
{ L.exUnitsMem = r ^. U5c.memory . to fromIntegral
50+
, L.exUnitsSteps = r ^. U5c.steps . to fromIntegral
4951
}
5052

51-
instance Inject L.ExUnits (Proto UtxoRpc.ExUnits) where
53+
instance Inject L.ExUnits (Proto U5c.ExUnits) where
5254
inject L.ExUnits{L.exUnitsMem = mem, L.exUnitsSteps = steps} =
5355
defMessage
54-
& #memory .~ fromIntegral mem
55-
& #steps .~ fromIntegral steps
56+
& U5c.memory .~ fromIntegral mem
57+
& U5c.steps .~ fromIntegral steps
5658

5759
-- | Note that conversion is not total in the other direction
58-
instance Inject TxIn (Proto UtxoRpc.TxoRef) where
60+
instance Inject TxIn (Proto U5c.TxoRef) where
5961
inject (TxIn txId' (TxIx txIx)) =
6062
defMessage
61-
& #hash .~ serialiseToRawBytes txId'
62-
& #index .~ fromIntegral txIx
63+
& U5c.hash .~ serialiseToRawBytes txId'
64+
& U5c.index .~ fromIntegral txIx
6365

6466
instance Message a => Default (Proto a) where
6567
def = defMessage
6668

67-
instance Inject Integer (Proto UtxoRpc.BigInt) where
69+
instance Inject Integer (Proto U5c.BigInt) where
6870
inject int
6971
| int <= fromIntegral (maxBound @Int64)
7072
&& int >= fromIntegral (minBound @Int64) =
7173
inject @Int64 $ fromIntegral int
7274
| int < 0 =
7375
-- https://www.rfc-editor.org/rfc/rfc8949.html#name-bignums see 3.4.3 for negative integers
74-
defMessage & #bigNInt .~ serialiseToRawBytes (fromIntegral @_ @Natural (-1 - int))
76+
defMessage & U5c.bigNInt .~ serialiseToRawBytes (fromIntegral @_ @Natural (-1 - int))
7577
| otherwise =
76-
defMessage & #bigUInt .~ serialiseToRawBytes (fromIntegral @_ @Natural int)
78+
defMessage & U5c.bigUInt .~ serialiseToRawBytes (fromIntegral @_ @Natural int)
7779

78-
instance Inject Int64 (Proto UtxoRpc.BigInt) where
79-
inject int = defMessage & #int .~ int
80+
instance Inject Int64 (Proto U5c.BigInt) where
81+
inject int = defMessage & U5c.int .~ int
8082

81-
instance Inject L.Coin (Proto UtxoRpc.BigInt) where
83+
instance Inject L.Coin (Proto U5c.BigInt) where
8284
inject = inject . fromIntegral @_ @Integer
8385

8486
-----------

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

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@
33
{-# LANGUAGE DerivingVia #-}
44
{-# LANGUAGE FlexibleContexts #-}
55
{-# LANGUAGE GADTs #-}
6-
{-# LANGUAGE OverloadedLabels #-}
76
{-# LANGUAGE QuantifiedConstraints #-}
87
{-# LANGUAGE RankNTypes #-}
98
{-# LANGUAGE ScopedTypeVariables #-}
@@ -17,6 +16,7 @@ where
1716

1817
import Cardano.Api
1918
import Cardano.Api.Experimental.Era
19+
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
2020
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
2121
import Cardano.Rpc.Server.Internal.Error
2222
import Cardano.Rpc.Server.Internal.Monad
@@ -52,20 +52,20 @@ readParamsMethod _req = do
5252

5353
pure $
5454
def
55-
& #ledgerTip .~ mkChainPointMsg chainPoint blockNo
56-
& #values . #cardano .~ obtainCommonConstraints eon (protocolParamsToUtxoRpcPParams eon pparams)
55+
& U5c.ledgerTip .~ mkChainPointMsg chainPoint blockNo
56+
& U5c.values . U5c.cardano .~ obtainCommonConstraints eon (protocolParamsToUtxoRpcPParams eon pparams)
5757

5858
readUtxosMethod
5959
:: MonadRpc e m
6060
=> Proto UtxoRpc.ReadUtxosRequest
6161
-> m (Proto UtxoRpc.ReadUtxosResponse)
6262
readUtxosMethod req = do
6363
utxoFilter <-
64-
if not (null $ req ^. #keys)
65-
then QueryUTxOByTxIn . fromList <$> mapM txoRefToTxIn (req ^. #keys)
64+
if not (null $ req ^. U5c.keys)
65+
then QueryUTxOByTxIn . fromList <$> mapM txoRefToTxIn (req ^. U5c.keys)
6666
-- TODO: reimplement this part as SearchUtxosRequest
67-
-- \| Just addressesProto <- req ^. #maybe'cardanoAddresses ->
68-
-- QueryUTxOByAddress . fromList <$> mapM readAddress (addressesProto ^. #items)
67+
-- \| Just addressesProto <- req ^. U5c.maybe'cardanoAddresses ->
68+
-- QueryUTxOByAddress . fromList <$> mapM readAddress (addressesProto ^. U5c.items)
6969
else pure QueryUTxOWhole
7070

7171
nodeConnInfo <- grab
@@ -81,13 +81,13 @@ readUtxosMethod req = do
8181

8282
pure $
8383
defMessage
84-
& #ledgerTip .~ mkChainPointMsg chainPoint blockNo
85-
& #items .~ obtainCommonConstraints eon (utxoToUtxoRpcAnyUtxoData utxo)
84+
& U5c.ledgerTip .~ mkChainPointMsg chainPoint blockNo
85+
& U5c.items .~ obtainCommonConstraints eon (utxoToUtxoRpcAnyUtxoData utxo)
8686
where
8787
txoRefToTxIn :: MonadRpc e m => Proto UtxoRpc.TxoRef -> m TxIn
8888
txoRefToTxIn r = do
89-
txId' <- throwEither $ deserialiseFromRawBytes AsTxId $ r ^. #hash
90-
pure $ TxIn txId' (TxIx . fromIntegral $ r ^. #index)
89+
txId' <- throwEither $ deserialiseFromRawBytes AsTxId $ r ^. U5c.hash
90+
pure $ TxIn txId' (TxIx . fromIntegral $ r ^. U5c.index)
9191

9292
-- TODO: reimplement this part as SearchUtxosRequest
9393
-- readAddress :: MonadRpc e m => ByteString -> m AddressAny

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,6 @@
44
{-# LANGUAGE FlexibleContexts #-}
55
{-# LANGUAGE GADTs #-}
66
{-# LANGUAGE LambdaCase #-}
7-
{-# LANGUAGE OverloadedLabels #-}
87
{-# LANGUAGE QuantifiedConstraints #-}
98
{-# LANGUAGE RankNTypes #-}
109
{-# LANGUAGE ScopedTypeVariables #-}
@@ -16,6 +15,7 @@ where
1615

1716
import Cardano.Api
1817
import Cardano.Api.Network.IPC qualified as Net.Tx
18+
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as U5c
1919
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as UtxoRpc
2020
import Cardano.Rpc.Server.Internal.Error
2121
import Cardano.Rpc.Server.Internal.Monad
@@ -42,11 +42,11 @@ submitTxMethod req = do
4242
putTraceThrowEither
4343
. first TraceRpcSubmitTxDecodingError
4444
. deserialiseTx eon
45-
$ req ^. #tx . #raw
45+
$ req ^. U5c.tx . U5c.raw
4646

4747
txId' <- submitTx eon tx
4848

49-
pure $ def & #ref .~ serialiseToRawBytes txId'
49+
pure $ def & U5c.ref .~ serialiseToRawBytes txId'
5050
where
5151
deserialiseTx :: ShelleyBasedEra era -> ByteString -> Either DecoderError (Tx era)
5252
deserialiseTx sbe = shelleyBasedEraConstraints sbe $ deserialiseFromCBOR asType

0 commit comments

Comments
 (0)