Skip to content

Commit

Permalink
Merge #4504
Browse files Browse the repository at this point in the history
4504: GHC 9.2.4 preparations r=deepfire a=newhoggy

These changes move the code towards `ghc-9.2.4` compatibility.

Co-authored-by: John Ky <john.ky@iohk.io>
  • Loading branch information
iohk-bors[bot] and newhoggy committed Oct 12, 2022
2 parents f01d540 + 9062cc3 commit 17bbfb7
Show file tree
Hide file tree
Showing 42 changed files with 132 additions and 146 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ assumeMapCosts _proxy = stepFunction [
, ( 744 , 4) -- 744 entries at 4 bytes.
]
where
firstEntry = case shelleyBasedEra @ era of
firstEntry = case shelleyBasedEra @era of
ShelleyBasedEraShelley -> 37
ShelleyBasedEraAllegra -> 39
ShelleyBasedEraMary -> 39
Expand Down Expand Up @@ -128,11 +128,11 @@ dummyTxSizeInEra metadata = case createAndValidateTransactionBody dummyTx of
}

dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
dummyTxSize _p m = (dummyTxSizeInEra @ era) $ metadataInEra m
dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m

metadataInEra :: forall era . IsShelleyBasedEra era => Maybe TxMetadata -> TxMetadataInEra era
metadataInEra Nothing = TxMetadataNone
metadataInEra (Just m) = case txMetadataSupportedInEra (cardanoEra @ era) of
metadataInEra (Just m) = case txMetadataSupportedInEra (cardanoEra @era) of
Nothing -> error "unreachable"
Just e -> TxMetadataInEra e m

Expand All @@ -143,7 +143,7 @@ mkMetadata size
then Left $ "Error : metadata must be 0 or at least " ++ show minSize ++ " bytes in this era."
else Right $ metadataInEra $ Just metadata
where
minSize = case shelleyBasedEra @ era of
minSize = case shelleyBasedEra @era of
ShelleyBasedEraShelley -> 37
ShelleyBasedEraAllegra -> 39
ShelleyBasedEraMary -> 39
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -186,7 +186,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
txToIdSize = (Mempool.txId &&& txInBlockSize) . toGenTx

toGenTx :: tx -> GenTx CardanoBlock
toGenTx tx = case shelleyBasedEra @ era of
toGenTx tx = case shelleyBasedEra @era of
ShelleyBasedEraShelley -> toConsensusGenTx $ TxInMode tx ShelleyEraInCardanoMode
ShelleyBasedEraAllegra -> toConsensusGenTx $ TxInMode tx AllegraEraInCardanoMode
ShelleyBasedEraMary -> toConsensusGenTx $ TxInMode tx MaryEraInCardanoMode
Expand Down
14 changes: 7 additions & 7 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -112,7 +112,7 @@ addFund era wallet txIn lovelace keyName = do
fundKey <- getName keyName
let
mkOutValue :: forall era. IsShelleyBasedEra era => AsType era -> ActionM (InAnyCardanoEra TxOutValue)
mkOutValue = \_ -> return $ InAnyCardanoEra (cardanoEra @ era) (lovelaceToTxOutValue lovelace)
mkOutValue = \_ -> return $ InAnyCardanoEra (cardanoEra @era) (lovelaceToTxOutValue lovelace)
outValue <- withEra era mkOutValue
addFundToWallet wallet txIn outValue fundKey

Expand Down Expand Up @@ -145,7 +145,7 @@ getConnectClient = do
tracers <- get BenchTracers
(Testnet networkMagic) <- getUser TNetworkId
protocol <- get Protocol
void $ return $(btSubmission2_ tracers)
void $ return $ btSubmission2_ tracers -- TODO this line looks strange
ioManager <- askIOManager
return $ benchmarkConnectTxSubmit
ioManager
Expand Down Expand Up @@ -354,8 +354,8 @@ selectCollateralFunds (Just walletName) = do
collateralFunds <- liftIO ( askWalletRef cw FundQueue.toList ) >>= \case
[] -> throwE $ WalletError "selectCollateralFunds: emptylist"
l -> return l
case collateralSupportedInEra (cardanoEra @ era) of
Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @ era)
case collateralSupportedInEra (cardanoEra @era) of
Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @era)
Just p -> return (TxInsCollateral p $ map getFundTxIn collateralFunds, collateralFunds)

dumpToFile :: FilePath -> TxInMode CardanoMode -> ActionM ()
Expand All @@ -375,7 +375,7 @@ interpretPayMode payMode = do
fundKey <- getName keyName
walletRef <- getName destWallet
return ( createAndStore (mkUTxOVariant networkId fundKey) (mkWalletFundStore walletRef)
, Text.unpack $ serialiseAddress $ Utils.keyAddress @ era networkId fundKey)
, Text.unpack $ serialiseAddress $ Utils.keyAddress @era networkId fundKey)
PayToScript scriptSpec destWallet -> do
walletRef <- getName destWallet
(witness, script, scriptData, _scriptFee) <- makePlutusContext scriptSpec
Expand Down Expand Up @@ -483,8 +483,8 @@ makePlutusContext scriptSpec = do

PlutusScript PlutusScriptV1 script' = script
scriptWitness :: ScriptWitness WitCtxTxIn era
scriptWitness = case scriptLanguageSupportedInEra (cardanoEra @ era) (PlutusScriptLanguage PlutusScriptV1) of
Nothing -> error $ "runPlutusBenchmark: Plutus V1 scriptlanguage not supported : in era" ++ show (cardanoEra @ era)
scriptWitness = case scriptLanguageSupportedInEra (cardanoEra @era) (PlutusScriptLanguage PlutusScriptV1) of
Nothing -> error $ "runPlutusBenchmark: Plutus V1 scriptlanguage not supported : in era" ++ show (cardanoEra @era)
Just scriptLang -> PlutusScriptWitness
scriptLang
PlutusScriptV1
Expand Down
1 change: 1 addition & 0 deletions bench/tx-generator/test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ tests = testGroup "cardano-tx-generator"
sizedMetadata
]

sizedMetadata :: TestTree
sizedMetadata = testGroup "properties of the CBOR encoding relevant for generating sized metadat"
[ testCase "Shelley metadata map costs" $ assertBool "metadata map costs" prop_mapCostsShelley
, testCase "Shelley metadata ByteString costs" $ assertBool "metadata ByteString costs" prop_bsCostsShelley
Expand Down
2 changes: 0 additions & 2 deletions cardano-api/cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -201,10 +201,8 @@ test-suite cardano-api-test
type: exitcode-stdio-1.0

build-depends: aeson >= 1.5.6.0
, bytestring
, cardano-api
, cardano-api:gen
, cardano-binary
, cardano-data
, cardano-crypto
, cardano-crypto-class
Expand Down
2 changes: 1 addition & 1 deletion cardano-api/src/Cardano/Api/LedgerEvent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ instance
instance All ConvertLedgerEvent xs => ConvertLedgerEvent (HardForkBlock xs) where
toLedgerEvent =
hcollapse
. hcmap (Proxy @ ConvertLedgerEvent) (K . toLedgerEvent)
. hcmap (Proxy @ConvertLedgerEvent) (K . toLedgerEvent)
. getOneEraLedgerEvent
. unwrapLedgerEvent

Expand Down
4 changes: 2 additions & 2 deletions cardano-api/src/Cardano/Api/LedgerState.hs
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@ import Data.SOP.Strict (NP (..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Text.Lazy (toStrict)
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Builder (toLazyText)
import Data.Word
import qualified Data.Yaml as Yaml
Expand Down Expand Up @@ -1294,7 +1294,7 @@ instance Error LeadershipError where
displayError LeaderErrDecodeLedgerStateFailure =
"Failed to successfully decode ledger state"
displayError (LeaderErrDecodeProtocolStateFailure (_, decErr)) =
"Failed to successfully decode protocol state: " <> Text.unpack (toStrict . toLazyText $ build decErr)
"Failed to successfully decode protocol state: " <> Text.unpack (LT.toStrict . toLazyText $ build decErr)
displayError LeaderErrGenesisSlot =
"Leadership schedule currently cannot be calculated from genesis"
displayError (LeaderErrStakePoolHasNoStake poolId) =
Expand Down
3 changes: 1 addition & 2 deletions cardano-api/src/Cardano/Api/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -292,7 +292,7 @@ instance IsCardanoEra era => ToJSON (UTxO era) where
toJSON (UTxO m) = toJSON m
toEncoding (UTxO m) = toEncoding m

instance (IsCardanoEra era, IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era))
instance (IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era))
=> FromJSON (UTxO era) where
parseJSON = withObject "UTxO" $ \hm -> do
let l = HMS.toList $ KeyMap.toHashMapText hm
Expand Down Expand Up @@ -381,7 +381,6 @@ newtype CurrentEpochState era = CurrentEpochState (Shelley.EpochState (ShelleyLe

decodeCurrentEpochState
:: forall era. Ledger.Era (ShelleyLedgerEra era)
=> Share (Core.TxOut (ShelleyLedgerEra era)) ~ Interns (Shelley.Credential 'Shelley.Staking (Ledger.Crypto (ShelleyLedgerEra era)))
=> FromSharedCBOR (Core.TxOut (ShelleyLedgerEra era))
=> Share (Core.TxOut (ShelleyLedgerEra era)) ~ Interns (Shelley.Credential 'Shelley.Staking (Ledger.Crypto (ShelleyLedgerEra era)))
=> FromCBOR (Core.PParams (ShelleyLedgerEra era))
Expand Down
12 changes: 6 additions & 6 deletions cardano-api/src/Cardano/Api/TxSubmit/ErrorRender.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,15 +39,15 @@ renderTxValidationError tve =
"Tx Validation: " <>
case tve of
TxValidationLovelaceError txt e ->
sformat ("Lovelace error "% stext %": "% build) txt e
sformat ("Lovelace error " % stext % ": " % build) txt e
TxValidationFeeTooSmall tx expected actual ->
sformat ("Tx "% build %" fee "% build %"too low, expected "% build) tx actual expected
sformat ("Tx " % build % " fee " % build % "too low, expected " % build) tx actual expected
TxValidationWitnessWrongSignature wit pmid sig ->
sformat ("Bad witness "% build %" for signature "% stext %" protocol magic id "% stext) wit (textShow sig) (textShow pmid)
sformat ("Bad witness " % build % " for signature " % stext % " protocol magic id " % stext) wit (textShow sig) (textShow pmid)
TxValidationWitnessWrongKey wit addr ->
sformat ("Bad witness "% build %" for address "% build) wit addr
sformat ("Bad witness " % build % " for address " % build) wit addr
TxValidationMissingInput tx ->
sformat ("Validation cannot find input tx "% build) tx
sformat ("Validation cannot find input tx " % build) tx
-- Fields are <expected> <actual>
TxValidationNetworkMagicMismatch expected actual ->
mconcat [ "Bad network magic ", textShow actual, ", expected ", textShow expected ]
Expand All @@ -62,6 +62,6 @@ renderUTxOError :: UTxOError -> Text
renderUTxOError ue =
"UTxOError: " <>
case ue of
UTxOMissingInput tx -> sformat ("Lookup of tx "% build %" failed") tx
UTxOMissingInput tx -> sformat ("Lookup of tx " % build % " failed") tx
UTxOOverlappingUnion -> "Union or two overlapping UTxO sets"

2 changes: 1 addition & 1 deletion cardano-api/src/Cardano/Api/TxSubmit/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ convertJson st =
renderTxSubmitStatus :: TxSubmitStatus -> Text
renderTxSubmitStatus st =
case st of
TxSubmitOk tx -> sformat ("Tx "% build %" submitted successfully") tx
TxSubmitOk tx -> sformat ("Tx " % build % " submitted successfully") tx
TxSubmitDecodeHex -> "Provided data was hex encoded and this webapi expects raw binary"
TxSubmitEmpty -> "Provided transaction has zero length"
TxSubmitDecodeFail err -> sformat build err
Expand Down
6 changes: 3 additions & 3 deletions cardano-api/test/Test/Cardano/Api/Crypto.hs
Original file line number Diff line number Diff line change
Expand Up @@ -69,13 +69,13 @@ testDSIGNAlgorithm _ n =
, testGroup "size"
[ testProperty "VerKey" $ prop_size_serialise @(VerKeyDSIGN v)
rawSerialiseVerKeyDSIGN
(sizeVerKeyDSIGN (Proxy @ v))
(sizeVerKeyDSIGN (Proxy @v))
, testProperty "SignKey" $ prop_size_serialise @(SignKeyDSIGN v)
rawSerialiseSignKeyDSIGN
(sizeSignKeyDSIGN (Proxy @ v))
(sizeSignKeyDSIGN (Proxy @v))
, testProperty "Sig" $ prop_size_serialise @(SigDSIGN v)
rawSerialiseSigDSIGN
(sizeSigDSIGN (Proxy @ v))
(sizeSigDSIGN (Proxy @v))
]

, testGroup "direct CBOR"
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/app/cardano-cli.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
#define UNIX
#endif

import Cardano.Prelude hiding (option)
import Cardano.Prelude

import Control.Monad.Trans.Except.Exit (orDie)
import qualified Options.Applicative as Opt
Expand Down
1 change: 0 additions & 1 deletion cardano-cli/cardano-cli.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -171,7 +171,6 @@ test-suite cardano-cli-test

build-depends: aeson
, bech32 >= 1.1.0
, bytestring
, base16-bytestring
, cardano-api
, cardano-api:gen
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/src/Cardano/CLI/Byron/Delegation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ module Cardano.CLI.Byron.Delegation
)
where

import Cardano.Prelude hiding (option, show, trace)
import Cardano.Prelude hiding (show, trace)

import Control.Monad.Trans.Except.Extra (left)
import qualified Data.ByteString.Lazy as LB
Expand Down
3 changes: 2 additions & 1 deletion cardano-cli/src/Cardano/CLI/Byron/Genesis.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ module Cardano.CLI.Byron.Genesis
)
where

import Cardano.Prelude hiding (option, show, trace)
import Cardano.Prelude hiding (show, trace)
import Prelude (String)

import Control.Monad.Trans.Except.Extra (firstExceptT, left, right)
Expand All @@ -23,6 +23,7 @@ import Data.Time (UTCTime)
import Formatting.Buildable

import Cardano.Api (Key (..), NetworkId, textShow, writeSecrets)

import Cardano.Api.Byron (ByronKey, SerialiseAsRawBytes (..), SigningKey (..),
toByronRequiresNetworkMagic)
import System.Directory (createDirectory, doesPathExist)
Expand Down
8 changes: 4 additions & 4 deletions cardano-cli/src/Cardano/CLI/Byron/Key.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ module Cardano.CLI.Byron.Key
)
where

import Cardano.Prelude hiding (option, show, trace, (%))
import Cardano.Prelude hiding (show, trace, (%))
import Prelude (show)

import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left,
Expand Down Expand Up @@ -70,9 +70,9 @@ newtype NewVerificationKeyFile =
-- its hash and formatted view.
prettyPublicKey :: VerificationKey ByronKey-> Text
prettyPublicKey (ByronVerificationKey vk) =
sformat ( " public key hash: "% build %
"\npublic key (base64): "% Crypto.fullVerificationKeyF %
"\n public key (hex): "% Crypto.fullVerificationKeyHexF)
sformat ( " public key hash: " % build %
"\npublic key (base64): " % Crypto.fullVerificationKeyF %
"\n public key (hex): " % Crypto.fullVerificationKeyHexF)
(Common.addressHash vk) vk vk

byronWitnessToVerKey :: SomeByronSigningKey -> VerificationKey ByronKey
Expand Down
Loading

0 comments on commit 17bbfb7

Please sign in to comment.