diff --git a/flake.nix b/flake.nix index 6bf1c9d..e41fb50 100644 --- a/flake.nix +++ b/flake.nix @@ -55,6 +55,8 @@ devshells.default = internal.devShell.new; + checks.hlint = internal.hlintCheck; + treefmt = {pkgs, ...}: { projectRootFile = "flake.nix"; programs = { diff --git a/nix/internal.nix b/nix/internal.nix index 7ca4b97..1247be6 100644 --- a/nix/internal.nix +++ b/nix/internal.nix @@ -123,6 +123,17 @@ assert builtins.elem targetSystem ["x86_64-linux" "aarch64-linux" "aarch64-darwi }; }) .defaultNix; + cardano-node-devshell = cardano-node-flake'.devShells.${buildSystem}.default; + cardano-node-inputs = lib.filter lib.isDerivation ( + (cardano-node-devshell.buildInputs or []) + ++ (cardano-node-devshell.nativeBuildInputs or []) + ++ (cardano-node-devshell.propagatedBuildInputs or []) + ++ (cardano-node-devshell.propagatedNativeBuildInputs or []) + ); + # Extract an individual package from the cardano-node devshell inputs + # so we can expose it as a devshell command with its own menu entry. + cardano-node-findInput = pred: label: + lib.findFirst pred (throw "devshell input '${label}' not found") cardano-node-inputs; in rec { defaultPackage = testgen-hs; cardano-node-flake = cardano-node-flake'; @@ -139,13 +150,6 @@ in rec { inherit (cardano-node-packages) cardano-node cardano-cli; devShell = let - cardano-node-devshell = cardano-node-flake.devShells.${buildSystem}.default; - cardano-node-inputs = lib.filter lib.isDerivation ( - (cardano-node-devshell.buildInputs or []) - ++ (cardano-node-devshell.nativeBuildInputs or []) - ++ (cardano-node-devshell.propagatedBuildInputs or []) - ++ (cardano-node-devshell.propagatedNativeBuildInputs or []) - ); cardano-node-env = pkgs.buildEnv { name = "cardano-node-devshell-env"; paths = cardano-node-inputs; @@ -153,12 +157,7 @@ in rec { }; cardano-node-ghc-libdir = cardano-node-devshell.NIX_GHC_LIBDIR or ""; - # Extract an individual package from the cardano-node devshell inputs - # so we can expose it as a devshell command with its own menu entry. - findInput = pred: label: - lib.findFirst pred (throw "devshell input '${label}' not found") cardano-node-inputs; - - haskell-language-server = findInput (p: (p.pname or "") == "haskell-language-server-exe-haskell-language-server") "haskell-language-server"; + haskell-language-server = cardano-node-findInput (p: (p.pname or "") == "haskell-language-server-exe-haskell-language-server") "haskell-language-server"; # Shim so that editors looking for haskell-language-server-wrapper find it # on PATH; the devshell already sets the correct GHC. @@ -271,12 +270,12 @@ in rec { commands = [ { name = "ghc"; - package = findInput (p: lib.hasPrefix "ghc-shell-for-packages" (p.name or "")) "ghc"; + package = cardano-node-findInput (p: lib.hasPrefix "ghc-shell-for-packages" (p.name or "")) "ghc"; category = "haskell"; } { name = "cabal"; - package = findInput (p: (p.pname or "") == "cabal-install-exe-cabal") "cabal"; + package = cardano-node-findInput (p: (p.pname or "") == "cabal-install-exe-cabal") "cabal"; category = "haskell"; } { @@ -284,6 +283,11 @@ in rec { package = haskell-language-server; category = "haskell"; } + { + name = "hlint"; + package = cardano-node-findInput (p: (p.pname or "") == "hlint-exe-hlint") "hlint"; + category = "haskell"; + } ]; devshell = { packages = [ @@ -342,6 +346,17 @@ in rec { targetSystem }; + hlintCheck = let + hlint = cardano-node-findInput (p: (p.pname or "") == "hlint-exe-hlint") "hlint"; + in + pkgs.runCommand "hlint" { + nativeBuildInputs = [hlint]; + src = ../testgen-hs; + } '' + hlint "$src" + touch $out + ''; + nix-bundle-exe = import inputs.nix-bundle-exe {inherit pkgs;}; nix-bundle-exe--same-dir = let diff --git a/testgen-hs/CLI.hs b/testgen-hs/CLI.hs index f65345f..2678128 100644 --- a/testgen-hs/CLI.hs +++ b/testgen-hs/CLI.hs @@ -61,45 +61,40 @@ opts = commandParser :: Parser Command commandParser = subparser - ( mempty - <> ( command - "generate" - ( info - ( Generate - <$> optionsParser - <**> helper - ) - (progDesc "Generate random CBOR test cases") - ) - ) - <> ( command - "deserialize" - ( info - ( Deserialize - <$> argument (eitherReader parseHex) (metavar "CBOR_HEX") - <**> helper - ) - (progDesc "Deserialize CBOR of ‘HardForkApplyTxErr’ that you got from cardano-node") - ) - ) - <> ( command - "deserialize-stream" - ( info - ( pure DeserializeStream - <**> helper - ) - (progDesc "Deserialize an STDIN stream of multiple lines of base16-encoded CBOR of ‘HardForkApplyTxErr’") - ) - ) - <> ( command - "evaluate-stream" - ( info - ( pure EvaluateStream - <**> helper - ) - (progDesc "Evaluate an STDIN stream of Txs with Utxos") - ) - ) + ( command + "generate" + ( info + ( Generate + <$> optionsParser + <**> helper + ) + (progDesc "Generate random CBOR test cases") + ) + <> command + "deserialize" + ( info + ( Deserialize + <$> argument (eitherReader parseHex) (metavar "CBOR_HEX") + <**> helper + ) + (progDesc "Deserialize CBOR of 'HardForkApplyTxErr' that you got from cardano-node") + ) + <> command + "deserialize-stream" + ( info + ( pure DeserializeStream + <**> helper + ) + (progDesc "Deserialize an STDIN stream of multiple lines of base16-encoded CBOR of 'HardForkApplyTxErr'") + ) + <> command + "evaluate-stream" + ( info + ( pure EvaluateStream + <**> helper + ) + (progDesc "Evaluate an STDIN stream of Txs with Utxos") + ) ) optionsParser :: Parser GenerateOptions @@ -122,7 +117,7 @@ optionsParser = <> short 'g' <> metavar "SIZE" <> value 300 - <> help "Set the relative ‘size’ of the test cases" + <> help "Set the relative 'size' of the test cases" ) ) <*> ( NumCases @@ -147,8 +142,7 @@ positive = do typeCommandParser :: Parser TypeCommand typeCommandParser = subparser - ( mempty - <> mkTypeCommand Tx'ConwayDummy + ( mkTypeCommand Tx'ConwayDummy <> mkTypeCommand ApplyTxErr'Byron <> mkTypeCommand ApplyTxErr'Shelley <> mkTypeCommand ApplyTxErr'Allegra diff --git a/testgen-hs/Evaluation.hs b/testgen-hs/Evaluation.hs index ab4afe8..340e178 100644 --- a/testgen-hs/Evaluation.hs +++ b/testgen-hs/Evaluation.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-orphans #-} diff --git a/testgen-hs/Generators.hs b/testgen-hs/Generators.hs index a234fef..c1e87f3 100644 --- a/testgen-hs/Generators.hs +++ b/testgen-hs/Generators.hs @@ -192,13 +192,12 @@ instance OurCBOR Tx'Conway where ------- HardForkApplyTxErr ----------------------------------------------------- hfcEnvelope :: OCHCM.HardForkApplyTxErr (OCCB.CardanoEras OCCB.StandardCrypto) -> C.Encoding -hfcEnvelope wrapped = +hfcEnvelope = OCNS.encodeNodeToClient @(OCCB.HardForkBlock (OCCB.CardanoEras OCCB.StandardCrypto)) @(OCHCM.HardForkApplyTxErr (OCCB.CardanoEras OCCB.StandardCrypto)) codecConfig OCCN.CardanoNodeToClientVersion12 - wrapped where byronEpochSlots = CCS.EpochSlots 21600 -- probably safe to hardcode in Conway…? codecConfig = OCNPI.pClientInfoCodecConfig (OCCN.protocolClientInfoCardano byronEpochSlots) diff --git a/testgen-hs/SynthEvalTx.hs b/testgen-hs/SynthEvalTx.hs index 1411cf0..0d6d42e 100644 --- a/testgen-hs/SynthEvalTx.hs +++ b/testgen-hs/SynthEvalTx.hs @@ -77,8 +77,8 @@ genTxUTxO = do pure (tx, stubUTxO tx) eval'Conway :: - (Cardano.Ledger.Core.Tx (Cardano.Ledger.Api.Era.ConwayEra)) -> - UTxO (Cardano.Ledger.Api.Era.ConwayEra) -> + Cardano.Ledger.Core.Tx Cardano.Ledger.Api.Era.ConwayEra -> + UTxO Cardano.Ledger.Api.Era.ConwayEra -> EpochInfo (Either Text) -> SystemStart -> J.Value @@ -87,17 +87,17 @@ eval'Conway tx utxo epochInfo systemStart = Just v -> v Nothing -> error "ogmiosSuccess produced invalid JSON" where - redeemerReport :: RedeemerReport (Cardano.Ledger.Api.Era.ConwayEra) + redeemerReport :: RedeemerReport Cardano.Ledger.Api.Era.ConwayEra redeemerReport = evalTxExUnits protocolParams tx utxo epochInfo systemStart -- | Version of eval'Conway that uses dummy epoch info and system start -eval'ConwayDummy :: (Cardano.Ledger.Core.Tx (Cardano.Ledger.Api.Era.ConwayEra)) -> UTxO Cardano.Ledger.Api.Era.ConwayEra -> J.Value +eval'ConwayDummy :: Cardano.Ledger.Core.Tx Cardano.Ledger.Api.Era.ConwayEra -> UTxO Cardano.Ledger.Api.Era.ConwayEra -> J.Value eval'ConwayDummy tx utxo = case J.decode (AesonEncoding.encodingToLazyByteString (ogmiosSuccess redeemerReport)) of Just v -> v Nothing -> error "ogmiosSuccess produced invalid JSON" where - redeemerReport :: RedeemerReport (Cardano.Ledger.Api.Era.ConwayEra) + redeemerReport :: RedeemerReport Cardano.Ledger.Api.Era.ConwayEra redeemerReport = evalTxExUnits protocolParams tx utxo dummyEpochInfo dummySystemStart -- | Collect every input the Tx spends, in any role. @@ -137,7 +137,7 @@ dummySystemStart = protocolParamsJSON :: BS.ByteString protocolParamsJSON = $(embedFile =<< makeRelativeToProject "protocol-params-preview.json") -protocolParams :: PParams (Cardano.Ledger.Api.Era.ConwayEra) +protocolParams :: PParams Cardano.Ledger.Api.Era.ConwayEra protocolParams = case eitherDecodeStrict' protocolParamsJSON of Left err -> error $ "Embedded protocol-parameters JSON is malformed:\n" <> err