Skip to content

gRPC: GHC 9.12 support #1098

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
carbolymer wants to merge 2 commits into
base: master
Choose a base branch
from
Draft

gRPC: GHC 9.12 support #1098

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
05a9977
GHC 9.12 support
carbolymer Jan 30, 2026
c876680
Remove usage of overloaded labels
carbolymer Feb 3, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/haskell.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ jobs:
strategy:
fail-fast: false
matrix:
ghc: ["9.6", "9.10"]
ghc: ["9.6", "9.10", "9.12"]
cabal: ["3.14"]
sys:
- { os: windows-latest, shell: 'C:/msys64/usr/bin/bash.exe -e {0}' }
Expand Down
29 changes: 29 additions & 0 deletions cabal.project
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,10 +51,14 @@ write-ghc-environment-files: always
jobs: $ncpus
semaphore: True


if impl (ghc >= 9.12)
allow-newer:
-- https://github.com/kapralVV/Unique/issues/11
, Unique:hashable
, proto-lens-arbitrary:QuickCheck
, io-classes
, typed-protocols


-- WASM compilation specific
Expand Down Expand Up @@ -160,6 +164,31 @@ if arch(wasm32)
package digest
flags: -pkg-config

-- GHC 9.12 support https://github.com/google/proto-lens/pull/519
source-repository-package
type: git
location: https://github.com/tonyalaribe/proto-lens
tag: da3a3c7d8f43b7b22a3325a6706eb2aad98f41be
--sha256: sha256-Ac3hhsisXIyGyfscnM036tQF8ctru+22zfOlHYJecTs=
subdir:
discrimination-ieee754
proto-lens-arbitrary
proto-lens-benchmarks
proto-lens-discrimination
proto-lens-optparse
proto-lens-protobuf-types
proto-lens-protoc
proto-lens-runtime
proto-lens-setup
proto-lens-tests-dep
proto-lens-tests

-- unreleased master of https://github.com/google/ghc-source-gen
source-repository-package
type: git
location: https://github.com/google/ghc-source-gen.git
tag: 79ecc01213131da03a7198fc377606ce72ac037a
--sha256: sha256-TsPEK0I5c9FYqZp0lAzQNogqEv1LPMzdjFO9EtOm/Ls=

-- IMPORTANT
-- Do NOT add more source-repository-package stanzas here unless they are strictly
Expand Down
6 changes: 3 additions & 3 deletions cardano-api/cardano-api.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,15 +38,15 @@ common project-config
-Wunused-packages

common maybe-unix
if !(os(windows)|| arch(wasm32))
if !(os(windows) || arch(wasm32))
build-depends: unix

common maybe-Win32
if os(windows)
build-depends: Win32

common text
if os(osx)&& arch(aarch64)
if os(osx) && arch(aarch64)
build-depends: text >=1.2.5.0
else
build-depends: text >=2.0
Expand Down Expand Up @@ -193,7 +193,7 @@ library
time,
transformers,
transformers-except ^>=0.1.3,
typed-protocols ^>=1.0,
typed-protocols >=1.0,
validation,
vector,
yaml,
Expand Down
5 changes: 2 additions & 3 deletions cardano-rpc/src/Cardano/Rpc/Server/Internal/Node.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand Down Expand Up @@ -33,7 +32,7 @@ import Network.GRPC.Spec
import Proto.Google.Protobuf.Empty

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

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

pure $
def
& #json .~ BL.toStrict pparamsJson
& Rpc.json .~ BL.toStrict pparamsJson
29 changes: 16 additions & 13 deletions cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
Expand All @@ -15,6 +15,7 @@ import Cardano.Api.Ledger qualified as L
import Cardano.Api.Pretty
import Cardano.Api.Serialise.Raw
import Cardano.Api.Tx
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc

import RIO hiding (toList)
Expand All @@ -31,35 +32,37 @@ import Network.GRPC.Spec

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

-- x = U5c.numerator :: _

instance Inject (Proto UtxoRpc.RationalNumber) Rational where
inject r = r ^. #numerator . to fromIntegral % r ^. #denominator . to fromIntegral
inject r = r ^. U5c.numerator . to fromIntegral % r ^. UtxoRpc.denominator . to fromIntegral

-- NB. this clips value in Integer -> Int64/Word64 conversion here
instance Inject Rational (Proto UtxoRpc.RationalNumber) where
inject r =
defMessage
& #numerator .~ fromIntegral (numerator r)
& #denominator .~ fromIntegral (denominator r)
& U5c.numerator .~ fromIntegral (numerator r)
& U5c.denominator .~ fromIntegral (denominator r)

instance Inject (Proto UtxoRpc.ExUnits) L.ExUnits where
inject r =
L.ExUnits
{ L.exUnitsMem = r ^. #memory . to fromIntegral
, L.exUnitsSteps = r ^. #steps . to fromIntegral
{ L.exUnitsMem = r ^. U5c.memory . to fromIntegral
, L.exUnitsSteps = r ^. U5c.steps . to fromIntegral
}

instance Inject L.ExUnits (Proto UtxoRpc.ExUnits) where
inject L.ExUnits{L.exUnitsMem = mem, L.exUnitsSteps = steps} =
defMessage
& #memory .~ fromIntegral mem
& #steps .~ fromIntegral steps
& U5c.memory .~ fromIntegral mem
& U5c.steps .~ fromIntegral steps

-- | Note that conversion is not total in the other direction
instance Inject TxIn (Proto UtxoRpc.TxoRef) where
inject (TxIn txId' (TxIx txIx)) =
defMessage
& #hash .~ serialiseToRawBytes txId'
& #index .~ fromIntegral txIx
& U5c.hash .~ serialiseToRawBytes txId'
& U5c.index .~ fromIntegral txIx

instance Message a => Default (Proto a) where
def = defMessage
Expand All @@ -71,12 +74,12 @@ instance Inject Integer (Proto UtxoRpc.BigInt) where
inject @Int64 $ fromIntegral int
| int < 0 =
-- https://www.rfc-editor.org/rfc/rfc8949.html#name-bignums see 3.4.3 for negative integers
defMessage & #bigNInt .~ serialiseToRawBytes (fromIntegral @_ @Natural (-1 - int))
defMessage & U5c.bigNInt .~ serialiseToRawBytes (fromIntegral @_ @Natural (-1 - int))
| otherwise =
defMessage & #bigUInt .~ serialiseToRawBytes (fromIntegral @_ @Natural int)
defMessage & U5c.bigUInt .~ serialiseToRawBytes (fromIntegral @_ @Natural int)

instance Inject Int64 (Proto UtxoRpc.BigInt) where
inject int = defMessage & #int .~ int
inject int = defMessage & U5c.int .~ int

instance Inject L.Coin (Proto UtxoRpc.BigInt) where
inject = inject . fromIntegral @_ @Integer
Expand Down
22 changes: 11 additions & 11 deletions cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Query.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand All @@ -17,6 +16,7 @@ where

import Cardano.Api
import Cardano.Api.Experimental.Era
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Error
import Cardano.Rpc.Server.Internal.Monad
Expand Down Expand Up @@ -52,20 +52,20 @@ readParamsMethod _req = do

pure $
def
& #ledgerTip .~ mkChainPointMsg chainPoint blockNo
& #values . #cardano .~ obtainCommonConstraints eon (protocolParamsToUtxoRpcPParams eon pparams)
& U5c.ledgerTip .~ mkChainPointMsg chainPoint blockNo
& U5c.values . U5c.cardano .~ obtainCommonConstraints eon (protocolParamsToUtxoRpcPParams eon pparams)

readUtxosMethod
:: MonadRpc e m
=> Proto UtxoRpc.ReadUtxosRequest
-> m (Proto UtxoRpc.ReadUtxosResponse)
readUtxosMethod req = do
utxoFilter <-
if not (null $ req ^. #keys)
then QueryUTxOByTxIn . fromList <$> mapM txoRefToTxIn (req ^. #keys)
if not (null $ req ^. U5c.keys)
then QueryUTxOByTxIn . fromList <$> mapM txoRefToTxIn (req ^. U5c.keys)
-- TODO: reimplement this part as SearchUtxosRequest
-- \| Just addressesProto <- req ^. #maybe'cardanoAddresses ->
-- QueryUTxOByAddress . fromList <$> mapM readAddress (addressesProto ^. #items)
-- \| Just addressesProto <- req ^. U5c.maybe'cardanoAddresses ->
-- QueryUTxOByAddress . fromList <$> mapM readAddress (addressesProto ^. U5c.items)
else pure QueryUTxOWhole

nodeConnInfo <- grab
Expand All @@ -81,13 +81,13 @@ readUtxosMethod req = do

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

-- TODO: reimplement this part as SearchUtxosRequest
-- readAddress :: MonadRpc e m => ByteString -> m AddressAny
Expand Down
6 changes: 3 additions & 3 deletions cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Submit.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand All @@ -16,6 +15,7 @@ where

import Cardano.Api
import Cardano.Api.Network.IPC qualified as Net.Tx
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as U5c
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Error
import Cardano.Rpc.Server.Internal.Monad
Expand All @@ -42,11 +42,11 @@ submitTxMethod req = do
putTraceThrowEither
. first TraceRpcSubmitTxDecodingError
. deserialiseTx eon
$ req ^. #tx . #raw
$ req ^. U5c.tx . U5c.raw

txId' <- submitTx eon tx

pure $ def & #ref .~ serialiseToRawBytes txId'
pure $ def & U5c.ref .~ serialiseToRawBytes txId'
where
deserialiseTx :: ShelleyBasedEra era -> ByteString -> Either DecoderError (Tx era)
deserialiseTx sbe = shelleyBasedEraConstraints sbe $ deserialiseFromCBOR asType
Expand Down
Loading
Loading