From 9f0d2b1f32488167385fd378001c1304c552d0cf Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Fri, 11 Mar 2022 11:20:56 +0100 Subject: [PATCH 01/15] Update dependencies and pins. - The `cardano-base`, `cardano-ledger`, `plutus` and `ouroboros-network` dependencies have been updated to recent versions. - Since the downstream libraries have been updated to more recent index-state and hackage revisions, we synchronise this here. - As a consequence of this update, we switch to a newer version of `aeson`, necessitating updates in `ekg-json` and `hedgehog-extras`. - We switch to ghc8107, to be in sync with other packages. --- cabal.project | 30 +++++++++++++++++---------- flake.lock | 55 +++++++++++++++++++++++++++++++------------------ flake.nix | 10 ++++++++- nix/haskell.nix | 2 +- 4 files changed, 64 insertions(+), 33 deletions(-) diff --git a/cabal.project b/cabal.project index a2fa5fb7f45..23c7404d322 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,4 @@ -index-state: 2021-12-07T00:00:00Z +index-state: 2022-02-18T00:00:00Z packages: cardano-api @@ -152,17 +152,23 @@ source-repository-package tag: 7497a29cb998721a9068d5725d49461f2bba0e7a --sha256: 1gvsrg925vynwgqwplgjmp53vj953qyh3wbdf34pw21c8r47w35r +source-repository-package + type: git + location: https://github.com/vshabanov/ekg-json + tag: 00ebe7211c981686e65730b7144fbf5350462608 + --sha256: sha256-VT8Ur585TCn03P2TVi6t92v2Z6tl8vKijICjse6ocv8= + source-repository-package type: git location: https://github.com/input-output-hk/hedgehog-extras - tag: edf6945007177a638fbeb8802397f3a6f4e47c14 - --sha256: 0wc7qzkc7j4ns2rz562h6qrx2f8xyq7yjcb7zidnj7f6j0pcd0i9 + tag: 678b9661750ccbe8a86aa5f56442cb30904ed0bc + --sha256: 0rbqb7a64aya1qizlr3im06hdydg9zr6sl3i8bvqqlf7kpa647sd source-repository-package type: git location: https://github.com/input-output-hk/cardano-base - tag: 41545ba3ac6b3095966316a99883d678b5ab8da8 - --sha256: 0icq9y3nnl42fz536da84414av36g37894qnyw4rk3qkalksqwir + tag: 20bd513b7ac9dcf0749f0ceb1df3d6b07a1b57c8 + --sha256: 0pkcd3k2fpk76igfyaf7cqrcglnjs3rs9pka68wpkyp6z7qkixmz subdir: base-deriving-via binary @@ -184,11 +190,12 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/cardano-ledger - tag: 3df3ca8db4d52952cb750e8859b71f0a371323af - --sha256: 0jacfhqnj76cyjwdxz05h7rqmdasgxp9skd01f5y61xraz746x21 + tag: 030c3b12f128f22b9d721a31b6b5ae1b75211d68 + --sha256: 0h9qbdik8fnzv33582pvvhkjyv3wwlnshrwvwalh0yl4mmqdcz8x subdir: eras/alonzo/impl eras/alonzo/test-suite + eras/babbage/impl eras/byron/chain/executable-spec eras/byron/crypto eras/byron/crypto/test @@ -248,8 +255,8 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/ouroboros-network - tag: 48e498cfea694b89f99fd92ae7a86b9fcd5f29f0 - --sha256: 1klgvlfcd1kxgjicws964k2xkxr79xf3vvgkbx4x7cyn4xfng166 + tag: 83744fe3b752fd8200de2ea1416e34c576c74f35 + --sha256: sha256-qOA2cF757RNYW1QkhfdPjdUee2Qa/BVaNv181w8eCmw= subdir: io-sim io-classes @@ -271,8 +278,8 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/plutus - tag: fc5fe94d3d9525d032bcbc79ff0e1ebcfd8ef143 - --sha256: 1gnzhns44rzvf9cw84jaqajqqbi9xdcpyy2sapa890vwf796nigv + tag: 4417dfea15746596f51f313ef231fb9ecb1d02fc + --sha256: 0nx7jbql3mmd64f0kjxrv9azzyc61b6sm2xh5dil910lw891szwh subdir: plutus-core plutus-ledger-api @@ -317,5 +324,6 @@ package cardano-ledger-alonzo-test tests: False allow-newer: + *:aeson, monoidal-containers:aeson, size-based:template-haskell diff --git a/flake.lock b/flake.lock index cf43962cb7a..65dce98a906 100644 --- a/flake.lock +++ b/flake.lock @@ -671,14 +671,14 @@ "type": "github" } }, - "hackage_2": { + "hackageNix": { "flake": false, "locked": { - "lastModified": 1643073363, - "narHash": "sha256-66oSXQKEDIOSQ2uKAS9facCX/Zuh/jFgyFDtxEqN9sk=", + "lastModified": 1646961339, + "narHash": "sha256-hsXNxSugSyOALfOt0I+mXrKioJ/nWX49/RhF/88N6D0=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "4ef9bd3a32316ce236164c7ebff00ebeb33236e2", + "rev": "5dea95d408c29b56a14faae378ae4e39d63126f4", "type": "github" }, "original": { @@ -687,7 +687,7 @@ "type": "github" } }, - "hackage_3": { + "hackage_2": { "flake": false, "locked": { "lastModified": 1643073363, @@ -703,7 +703,7 @@ "type": "github" } }, - "hackage_4": { + "hackage_3": { "flake": false, "locked": { "lastModified": 1639098768, @@ -728,7 +728,9 @@ "cardano-shell": "cardano-shell", "flake-utils": "flake-utils", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", - "hackage": "hackage", + "hackage": [ + "hackageNix" + ], "hpc-coveralls": "hpc-coveralls", "nix-tools": "nix-tools", "nixpkgs": [ @@ -742,11 +744,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1643073543, - "narHash": "sha256-g2l/KDWzMRTFRugNVcx3CPZeyA5BNcH9/zDiqFpprB4=", + "lastModified": 1646278384, + "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "14f740c7c8f535581c30b1697018e389680e24cb", + "rev": "7e06e14ae1b894445254fe41288bfa7dd4ccbc6f", "type": "github" }, "original": { @@ -764,7 +766,7 @@ "cardano-shell": "cardano-shell_2", "flake-utils": "flake-utils_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", - "hackage": "hackage_2", + "hackage": "hackage", "hpc-coveralls": "hpc-coveralls_2", "nix-tools": "nix-tools_2", "nixpkgs": [ @@ -802,7 +804,7 @@ "cardano-shell": "cardano-shell_3", "flake-utils": "flake-utils_3", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_3", - "hackage": "hackage_3", + "hackage": "hackage_2", "hpc-coveralls": "hpc-coveralls_3", "nix-tools": "nix-tools_3", "nixpkgs": [ @@ -841,7 +843,7 @@ "cardano-shell": "cardano-shell_4", "flake-utils": "flake-utils_4", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_4", - "hackage": "hackage_4", + "hackage": "hackage_3", "hpc-coveralls": "hpc-coveralls_4", "nix-tools": "nix-tools_4", "nixpkgs": [ @@ -942,11 +944,11 @@ ] }, "locked": { - "lastModified": 1645693195, - "narHash": "sha256-UDemE2MFEi/L8Xmwi1/FuKU9ka3QqDye6k7rVW6ryeE=", + "lastModified": 1646330344, + "narHash": "sha256-EbhMDeneH26wDi+x5kz8nfru/dE9JZ241hJed4a8lz8=", "owner": "input-output-hk", "repo": "iohk-nix", - "rev": "29c9a3b6704b5c0df3bb4a3e65240749883c50a0", + "rev": "0a0126d8fb1bdc61ce1fd2ef61cf396de800fdad", "type": "github" }, "original": { @@ -1488,6 +1490,21 @@ "type": "indirect" } }, + "nixpkgs_4": { + "locked": { + "lastModified": 1644486793, + "narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", + "type": "github" + }, + "original": { + "owner": "nixos", + "repo": "nixpkgs.nix", + "type": "github" + } + }, "old-ghc-nix": { "flake": false, "locked": { @@ -1655,16 +1672,14 @@ "cardano-node-workbench": "cardano-node-workbench", "customConfig": "customConfig", "flake-compat": "flake-compat", + "hackageNix": "hackageNix", "haskellNix": "haskellNix", "hostNixpkgs": [ "nixpkgs" ], "iohkNix": "iohkNix", "membench": "membench", - "nixpkgs": [ - "haskellNix", - "nixpkgs-2105" - ], + "nixpkgs": "nixpkgs_4", "plutus-example": "plutus-example_2", "utils": "utils_4" } diff --git a/flake.nix b/flake.nix index 92a39b542b0..a85b69e5616 100644 --- a/flake.nix +++ b/flake.nix @@ -3,11 +3,19 @@ inputs = { # IMPORTANT: report any change to nixpkgs channel in nix/default.nix: - nixpkgs.follows = "haskellNix/nixpkgs-2105"; + nixpkgs = { + url = "github:nixos/nixpkgs.nix"; + }; hostNixpkgs.follows = "nixpkgs"; + hackageNix = { + url = "github:input-output-hk/hackage.nix"; + inputs.nixpkgs.follows = "nixpkgs"; + flake = false; + }; haskellNix = { url = "github:input-output-hk/haskell.nix"; inputs.nixpkgs.follows = "nixpkgs"; + inputs.hackage.follows = "hackageNix"; }; utils.url = "github:numtide/flake-utils"; iohkNix = { diff --git a/nix/haskell.nix b/nix/haskell.nix index 1f2597bd941..5d3ab7e8122 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -32,7 +32,7 @@ haskell-nix.cabalProject' ({ pkgs # removes socket files && lib.elem type [ "regular" "directory" "symlink" ]; }; - compiler-nix-name = "ghc8105"; + compiler-nix-name = "ghc8107"; cabalProjectLocal = '' allow-newer: terminfo:base '' + lib.optionalString pkgs.stdenv.hostPlatform.isWindows '' From 7afcef528ab29cd55ffe107bbbd3e770b5e400d5 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Fri, 11 Mar 2022 16:17:45 +0100 Subject: [PATCH 02/15] Add separate pin for nix-tools. --- flake.lock | 19 +++++++++++-------- flake.nix | 6 +++++- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/flake.lock b/flake.lock index 65dce98a906..520f6940e34 100644 --- a/flake.lock +++ b/flake.lock @@ -732,7 +732,9 @@ "hackageNix" ], "hpc-coveralls": "hpc-coveralls", - "nix-tools": "nix-tools", + "nix-tools": [ + "nixTools" + ], "nixpkgs": [ "nixpkgs" ], @@ -768,7 +770,7 @@ "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", "hackage": "hackage", "hpc-coveralls": "hpc-coveralls_2", - "nix-tools": "nix-tools_2", + "nix-tools": "nix-tools", "nixpkgs": [ "membench", "cardano-node-snapshot", @@ -806,7 +808,7 @@ "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_3", "hackage": "hackage_2", "hpc-coveralls": "hpc-coveralls_3", - "nix-tools": "nix-tools_3", + "nix-tools": "nix-tools_2", "nixpkgs": [ "membench", "cardano-node-snapshot", @@ -845,7 +847,7 @@ "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_4", "hackage": "hackage_3", "hpc-coveralls": "hpc-coveralls_4", - "nix-tools": "nix-tools_4", + "nix-tools": "nix-tools_3", "nixpkgs": [ "membench", "cardano-node-snapshot", @@ -1176,14 +1178,14 @@ "type": "github" } }, - "nix-tools_4": { + "nixTools": { "flake": false, "locked": { - "lastModified": 1636018067, - "narHash": "sha256-ng306fkuwr6V/malWtt3979iAC4yMVDDH2ViwYB6sQE=", + "lastModified": 1644395812, + "narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=", "owner": "input-output-hk", "repo": "nix-tools", - "rev": "ed5bd7215292deba55d6ab7a4e8c21f8b1564dda", + "rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1", "type": "github" }, "original": { @@ -1679,6 +1681,7 @@ ], "iohkNix": "iohkNix", "membench": "membench", + "nixTools": "nixTools", "nixpkgs": "nixpkgs_4", "plutus-example": "plutus-example_2", "utils": "utils_4" diff --git a/flake.nix b/flake.nix index a85b69e5616..b8e03a42721 100644 --- a/flake.nix +++ b/flake.nix @@ -9,13 +9,17 @@ hostNixpkgs.follows = "nixpkgs"; hackageNix = { url = "github:input-output-hk/hackage.nix"; - inputs.nixpkgs.follows = "nixpkgs"; flake = false; }; + nixTools = { + url = "github:input-output-hk/nix-tools"; + flake = false; + }; haskellNix = { url = "github:input-output-hk/haskell.nix"; inputs.nixpkgs.follows = "nixpkgs"; inputs.hackage.follows = "hackageNix"; + inputs.nix-tools.follows = "nixTools"; }; utils.url = "github:numtide/flake-utils"; iohkNix = { From 88179321d3525aae23689113c30f8aa9a312ef6f Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Tue, 15 Mar 2022 13:46:21 +0100 Subject: [PATCH 03/15] Update with aeson-2.0 changes. --- .../locli/src/Cardano/Analysis/ChainFilter.hs | 2 - bench/locli/src/Cardano/Unlog/LogObject.hs | 15 +- .../src/Cardano/Benchmarking/Tracer.hs | 108 ++--- cabal.project | 4 +- cardano-api/gen/Gen/Cardano/Api/Metadata.hs | 10 +- cardano-api/src/Cardano/Api/Orphans.hs | 4 - cardano-api/src/Cardano/Api/Query.hs | 3 +- cardano-api/src/Cardano/Api/Script.hs | 4 +- cardano-api/src/Cardano/Api/ScriptData.hs | 30 +- cardano-api/src/Cardano/Api/TxBody.hs | 15 +- cardano-api/src/Cardano/Api/TxMetadata.hs | 42 +- cardano-api/src/Cardano/Api/Value.hs | 14 +- cardano-cli/src/Cardano/CLI/Run/Friendly.hs | 3 +- cardano-cli/src/Cardano/CLI/Shelley/Output.hs | 6 +- .../src/Cardano/CLI/Shelley/Run/Genesis.hs | 2 +- .../Test/Golden/Shelley/Genesis/Create.hs | 5 +- cardano-node/cardano-node.cabal | 1 - .../src/Cardano/Node/TraceConstraints.hs | 6 +- .../src/Cardano/Node/Tracing/Era/Byron.hs | 72 +-- .../src/Cardano/Node/Tracing/Era/HardFork.hs | 28 +- .../src/Cardano/Node/Tracing/Era/Shelley.hs | 275 +++++------ .../src/Cardano/Node/Tracing/Formatting.hs | 10 +- .../Tracing/Tracers/BlockReplayProgress.hs | 2 +- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 200 ++++---- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 161 +++---- .../Cardano/Node/Tracing/Tracers/Diffusion.hs | 54 +-- .../Tracing/Tracers/ForgingThreadStats.hs | 4 +- .../Node/Tracing/Tracers/NodeToClient.hs | 66 +-- .../Node/Tracing/Tracers/NodeToNode.hs | 40 +- .../Cardano/Node/Tracing/Tracers/NonP2P.hs | 26 +- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 198 ++++---- .../src/Cardano/Node/Tracing/Tracers/Peer.hs | 8 +- .../Cardano/Node/Tracing/Tracers/Shutdown.hs | 12 +- .../Cardano/Node/Tracing/Tracers/Startup.hs | 32 +- cardano-node/src/Cardano/Tracing/Config.hs | 3 +- .../Cardano/Tracing/OrphanInstances/Byron.hs | 72 +-- .../Tracing/OrphanInstances/Consensus.hs | 302 ++++++------ .../Tracing/OrphanInstances/HardFork.hs | 28 +- .../Tracing/OrphanInstances/Network.hs | 432 +++++++++--------- .../Tracing/OrphanInstances/Shelley.hs | 277 +++++------ cardano-node/src/Cardano/Tracing/Peer.hs | 21 +- cardano-node/src/Cardano/Tracing/Tracers.hs | 3 +- .../TxSubmit/Tracing/ToObjectOrphans.hs | 9 +- cardano-testnet/src/Testnet/Byron.hs | 2 +- cardano-testnet/src/Testnet/Cardano.hs | 2 +- cardano-testnet/src/Testnet/Shelley.hs | 2 +- .../examples/Examples/Configuration.hs | 4 +- .../examples/Examples/TestObjects.hs | 26 +- .../src/Cardano/Logging/FrequencyLimiter.hs | 6 +- trace-dispatcher/src/Cardano/Logging/Types.hs | 6 +- .../test/Cardano/Logging/Test/Types.hs | 30 +- .../src/Cardano/Logging/Resources/Types.hs | 2 +- 52 files changed, 1353 insertions(+), 1336 deletions(-) diff --git a/bench/locli/src/Cardano/Analysis/ChainFilter.hs b/bench/locli/src/Cardano/Analysis/ChainFilter.hs index 1e45a01e850..aece98b1511 100644 --- a/bench/locli/src/Cardano/Analysis/ChainFilter.hs +++ b/bench/locli/src/Cardano/Analysis/ChainFilter.hs @@ -41,8 +41,6 @@ data BlockCond | BSizeLEq Word64 deriving (FromJSON, Generic, NFData, Show, ToJSON) -deriving instance NFData EpochNo - data SlotCond = SlotGEq SlotNo | SlotLEq SlotNo diff --git a/bench/locli/src/Cardano/Unlog/LogObject.hs b/bench/locli/src/Cardano/Unlog/LogObject.hs index 9c659e4452e..a497d0a75c9 100644 --- a/bench/locli/src/Cardano/Unlog/LogObject.hs +++ b/bench/locli/src/Cardano/Unlog/LogObject.hs @@ -18,7 +18,6 @@ import Data.Aeson.Types (Parser) import Data.Aeson qualified as AE import Data.Aeson.Types qualified as AE import Data.ByteString.Lazy qualified as LBS -import Data.HashMap.Strict qualified as HM import Data.Text qualified as LText import Data.Text.Short qualified as Text import Data.Text.Short (ShortText, fromText, toText) @@ -32,6 +31,8 @@ import Ouroboros.Network.Block (BlockNo(..), SlotNo(..)) import Cardano.Logging.Resources.Types import Data.Accum (zeroUTCTime) +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Aeson.Key as Aeson type Text = ShortText @@ -86,12 +87,6 @@ data LogObject instance ToJSON LogObject -instance ToJSON ShortText where - toJSON = String . toText - -instance FromJSON ShortText where - parseJSON = AE.withText "String" $ pure . fromText - instance Print ShortText where hPutStr h = hPutStr h . toText hPutStrLn h = hPutStrLn h . toText @@ -316,15 +311,15 @@ instance FromJSON LogObject where unwrap wrappedKeyPred unwrapKey v = do kind <- (fromText <$>) <$> v .:? "kind" wrapped :: Maybe Text <- - (fromText <$>) <$> v .:? toText wrappedKeyPred - unwrapped :: Maybe Object <- v .:? toText unwrapKey + (fromText <$>) <$> v .:? Aeson.fromText (toText wrappedKeyPred) + unwrapped :: Maybe Object <- v .:? Aeson.fromText (toText unwrapKey) case (kind, wrapped, unwrapped) of (Nothing, Just _, Just x) -> (,) <$> pure x <*> (fromText <$> x .: "kind") (Just kind0, _, _) -> pure (v, kind0) _ -> fail $ "Unexpected LogObject .data: " <> show v extendObject :: Text -> Value -> Value -> Value -extendObject k v (Object hm) = Object $ hm <> HM.singleton (toText k) v +extendObject k v (Object hm) = Object $ hm <> KeyMap.singleton (Aeson.fromText $ toText k) v extendObject k _ _ = error . Text.unpack $ "Summary key '" <> k <> "' does not serialise to an Object." parsePartialResourceStates :: Value -> Parser (Resources Word64) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index 665691b42e6..f0c4d6090f9 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -29,7 +29,6 @@ import Prelude (Show(..), String) import Data.Aeson (ToJSON (..), (.=), encode) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy.Char8 as BSL (unpack) -import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import Data.Time.Clock (DiffTime, NominalDiffTime, getCurrentTime) @@ -42,7 +41,7 @@ import Cardano.Prelude hiding (TypeError, show) import Cardano.BM.Tracing -import Cardano.BM.Data.Tracer (emptyObject, mkObject, trStructured) +import Cardano.BM.Data.Tracer (trStructured) import Network.Mux (WithMuxBearer(..)) @@ -62,6 +61,7 @@ import Ouroboros.Network.NodeToNode (RemoteConnectionId, NodeToNodeVer import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Cardano.Benchmarking.Types +import qualified Data.Aeson.KeyMap as KeyMap data BenchTracers = BenchTracers @@ -189,24 +189,24 @@ data NodeToNodeSubmissionTrace | EndOfProtocol instance ToObject NodeToNodeSubmissionTrace where - toObject MinimalVerbosity = const emptyObject -- do not log + toObject MinimalVerbosity = const mempty -- do not log toObject _ = \case ReqIdsBlocking (Ack ack) (Req req) -> - mkObject [ "kind" .= A.String "ReqIdsBlocking" + mconcat [ "kind" .= A.String "ReqIdsBlocking" , "ack" .= A.toJSON ack , "req" .= A.toJSON req ] - IdsListBlocking sent -> mkObject [ "kind" .= A.String "IdsListBlocking" + IdsListBlocking sent -> mconcat [ "kind" .= A.String "IdsListBlocking" , "sent" .= A.toJSON sent ] ReqIdsPrompt (Ack ack) (Req req) -> - mkObject [ "kind" .= A.String "ReqIdsPrompt" + mconcat [ "kind" .= A.String "ReqIdsPrompt" , "ack" .= A.toJSON ack , "req" .= A.toJSON req ] - IdsListPrompt sent -> mkObject [ "kind" .= A.String "IdsListPrompt" + IdsListPrompt sent -> mconcat [ "kind" .= A.String "IdsListPrompt" , "sent" .= A.toJSON sent ] - EndOfProtocol -> mkObject [ "kind" .= A.String "EndOfProtocol" ] - ReqTxs req -> mkObject [ "kind" .= A.String "ReqTxs" + EndOfProtocol -> mconcat [ "kind" .= A.String "EndOfProtocol" ] + ReqTxs req -> mconcat [ "kind" .= A.String "ReqTxs" , "req" .= A.toJSON req ] - TxList sent -> mkObject [ "kind" .= A.String "TxList" + TxList sent -> mconcat [ "kind" .= A.String "TxList" , "sent" .= A.toJSON sent ] @@ -228,24 +228,24 @@ data TraceLowLevelSubmit deriving stock (Show) instance ToObject TraceLowLevelSubmit where - toObject MinimalVerbosity _ = emptyObject -- do not log + toObject MinimalVerbosity _ = mempty -- do not log toObject NormalVerbosity t = case t of - TraceLowLevelSubmitting -> mkObject ["kind" .= A.String "TraceLowLevelSubmitting"] - TraceLowLevelAccepted -> mkObject ["kind" .= A.String "TraceLowLevelAccepted"] - TraceLowLevelRejected m -> mkObject [ "kind" .= A.String "TraceLowLevelRejected" + TraceLowLevelSubmitting -> mconcat ["kind" .= A.String "TraceLowLevelSubmitting"] + TraceLowLevelAccepted -> mconcat ["kind" .= A.String "TraceLowLevelAccepted"] + TraceLowLevelRejected m -> mconcat [ "kind" .= A.String "TraceLowLevelRejected" , "message" .= A.String (T.pack m) ] toObject MaximalVerbosity t = case t of TraceLowLevelSubmitting -> - mkObject [ "kind" .= A.String "TraceLowLevelSubmitting" + mconcat [ "kind" .= A.String "TraceLowLevelSubmitting" ] TraceLowLevelAccepted -> - mkObject [ "kind" .= A.String "TraceLowLevelAccepted" + mconcat [ "kind" .= A.String "TraceLowLevelAccepted" ] TraceLowLevelRejected errMsg -> - mkObject [ "kind" .= A.String "TraceLowLevelRejected" + mconcat [ "kind" .= A.String "TraceLowLevelRejected" , "errMsg" .= A.String (T.pack errMsg) ] @@ -268,12 +268,12 @@ instance Transformable Text IO SendRecvTxSubmission2 where let obj = toObject verb arg updatedObj = - if obj == emptyObject + if obj == mempty then obj else -- Add a timestamp in 'ToObject'-representation. - HM.insert "time" (A.String (T.pack . show $ currentTime)) obj - tracer = if obj == emptyObject then nullTracer else tr + KeyMap.insert "time" (A.String (T.pack . show $ currentTime)) obj + tracer = if obj == mempty then nullTracer else tr meta <- mkLOMeta (getSeverityAnnotation arg) (getPrivacyAnnotation arg) traceWith tracer (mempty, LogObject mempty meta (LogStructured updatedObj)) @@ -284,9 +284,9 @@ instance HasSeverityAnnotation TxId instance HasPrivacyAnnotation TxId instance ToObject TxId where - toObject MinimalVerbosity _ = emptyObject -- do not log - toObject NormalVerbosity _ = mkObject [ "kind" .= A.String "GenTxId"] - toObject MaximalVerbosity txid = mkObject [ "kind" .= A.String "GenTxId" + toObject MinimalVerbosity _ = mempty -- do not log + toObject NormalVerbosity _ = mconcat [ "kind" .= A.String "GenTxId"] + toObject MaximalVerbosity txid = mconcat [ "kind" .= A.String "GenTxId" , "txId" .= toJSON txid ] @@ -300,83 +300,83 @@ type SendRecvConnect = WithMuxBearer CBOR.Term)) instance ToObject (TraceBenchTxSubmit TxId) where - toObject MinimalVerbosity _ = emptyObject -- do not log + toObject MinimalVerbosity _ = mempty -- do not log toObject NormalVerbosity t = case t of - TraceBenchTxSubRecv _ -> mkObject ["kind" .= A.String "TraceBenchTxSubRecv"] - TraceBenchTxSubStart _ -> mkObject ["kind" .= A.String "TraceBenchTxSubStart"] - TraceBenchTxSubServAnn _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServAnn"] - TraceBenchTxSubServReq _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServReq"] - TraceBenchTxSubServAck _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServAck"] - TraceBenchTxSubServDrop _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServDrop"] - TraceBenchTxSubServOuts _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServOuts"] - TraceBenchTxSubServUnav _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServUnav"] - TraceBenchTxSubServFed _ _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServFed"] - TraceBenchTxSubServCons _ -> mkObject ["kind" .= A.String "TraceBenchTxSubServCons"] - TraceBenchTxSubIdle -> mkObject ["kind" .= A.String "TraceBenchTxSubIdle"] - TraceBenchTxSubRateLimit _ -> mkObject ["kind" .= A.String "TraceBenchTxSubRateLimit"] - TraceBenchTxSubSummary _ -> mkObject ["kind" .= A.String "TraceBenchTxSubSummary"] - TraceBenchTxSubDebug _ -> mkObject ["kind" .= A.String "TraceBenchTxSubDebug"] - TraceBenchTxSubError _ -> mkObject ["kind" .= A.String "TraceBenchTxSubError"] + TraceBenchTxSubRecv _ -> mconcat ["kind" .= A.String "TraceBenchTxSubRecv"] + TraceBenchTxSubStart _ -> mconcat ["kind" .= A.String "TraceBenchTxSubStart"] + TraceBenchTxSubServAnn _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServAnn"] + TraceBenchTxSubServReq _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServReq"] + TraceBenchTxSubServAck _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServAck"] + TraceBenchTxSubServDrop _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServDrop"] + TraceBenchTxSubServOuts _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServOuts"] + TraceBenchTxSubServUnav _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServUnav"] + TraceBenchTxSubServFed _ _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServFed"] + TraceBenchTxSubServCons _ -> mconcat ["kind" .= A.String "TraceBenchTxSubServCons"] + TraceBenchTxSubIdle -> mconcat ["kind" .= A.String "TraceBenchTxSubIdle"] + TraceBenchTxSubRateLimit _ -> mconcat ["kind" .= A.String "TraceBenchTxSubRateLimit"] + TraceBenchTxSubSummary _ -> mconcat ["kind" .= A.String "TraceBenchTxSubSummary"] + TraceBenchTxSubDebug _ -> mconcat ["kind" .= A.String "TraceBenchTxSubDebug"] + TraceBenchTxSubError _ -> mconcat ["kind" .= A.String "TraceBenchTxSubError"] toObject MaximalVerbosity t = case t of TraceBenchTxSubRecv txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubRecv" + mconcat [ "kind" .= A.String "TraceBenchTxSubRecv" , "txIds" .= toJSON txIds ] TraceBenchTxSubStart txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubStart" + mconcat [ "kind" .= A.String "TraceBenchTxSubStart" , "txIds" .= toJSON txIds ] TraceBenchTxSubServAnn txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServAnn" + mconcat [ "kind" .= A.String "TraceBenchTxSubServAnn" , "txIds" .= toJSON txIds ] TraceBenchTxSubServReq txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServReq" + mconcat [ "kind" .= A.String "TraceBenchTxSubServReq" , "txIds" .= toJSON txIds ] TraceBenchTxSubServAck txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServAck" + mconcat [ "kind" .= A.String "TraceBenchTxSubServAck" , "txIds" .= toJSON txIds ] TraceBenchTxSubServDrop txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServDrop" + mconcat [ "kind" .= A.String "TraceBenchTxSubServDrop" , "txIds" .= toJSON txIds ] TraceBenchTxSubServOuts txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServOuts" + mconcat [ "kind" .= A.String "TraceBenchTxSubServOuts" , "txIds" .= toJSON txIds ] TraceBenchTxSubServUnav txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServUnav" + mconcat [ "kind" .= A.String "TraceBenchTxSubServUnav" , "txIds" .= toJSON txIds ] TraceBenchTxSubServFed txIds ix -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServFed" + mconcat [ "kind" .= A.String "TraceBenchTxSubServFed" , "txIds" .= toJSON txIds , "index" .= toJSON ix ] TraceBenchTxSubServCons txIds -> - mkObject [ "kind" .= A.String "TraceBenchTxSubServCons" + mconcat [ "kind" .= A.String "TraceBenchTxSubServCons" , "txIds" .= toJSON txIds ] TraceBenchTxSubIdle -> - mkObject [ "kind" .= A.String "TraceBenchTxSubIdle" + mconcat [ "kind" .= A.String "TraceBenchTxSubIdle" ] TraceBenchTxSubRateLimit limit -> - mkObject [ "kind" .= A.String "TraceBenchTxSubRateLimit" + mconcat [ "kind" .= A.String "TraceBenchTxSubRateLimit" , "limit" .= toJSON limit ] TraceBenchTxSubSummary summary -> - mkObject [ "kind" .= A.String "TraceBenchTxSubSummary" + mconcat [ "kind" .= A.String "TraceBenchTxSubSummary" , "summary" .= toJSON summary ] TraceBenchTxSubDebug s -> - mkObject [ "kind" .= A.String "TraceBenchTxSubDebug" + mconcat [ "kind" .= A.String "TraceBenchTxSubDebug" , "msg" .= A.String (T.pack s) ] TraceBenchTxSubError s -> - mkObject [ "kind" .= A.String "TraceBenchTxSubError" + mconcat [ "kind" .= A.String "TraceBenchTxSubError" , "msg" .= A.String s ] diff --git a/cabal.project b/cabal.project index 23c7404d322..e9ce10f0168 100644 --- a/cabal.project +++ b/cabal.project @@ -234,8 +234,8 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: 808724ff8a19a33d0ed06f9ef59fbd900b08553c - --sha256: 0298dpl29gxzs9as9ha6y0w18hqwc00ipa3hzkxv7nlfrjjz8hmz + tag: eb7854d1337637b8672af1227b276aa33a658f47 + --sha256: 1ll81hlhkhj96f5v6lswjkq2h8f7zcmdrj2azqhi4ylzafn026r3 subdir: contra-tracer iohk-monitoring diff --git a/cardano-api/gen/Gen/Cardano/Api/Metadata.hs b/cardano-api/gen/Gen/Cardano/Api/Metadata.hs index f78fd6245c7..353c8dc8548 100644 --- a/cardano-api/gen/Gen/Cardano/Api/Metadata.hs +++ b/cardano-api/gen/Gen/Cardano/Api/Metadata.hs @@ -20,6 +20,7 @@ import qualified Data.Text.Encoding as Text import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Internal.Gen as Gen import qualified Hedgehog.Range as Range +import qualified Data.Aeson.Key as Aeson -- ---------------------------------------------------------------------------- -- Generators @@ -30,7 +31,7 @@ genJsonForTxMetadata mapping = Gen.sized $ \sz -> Aeson.object <$> Gen.list (Range.linear 0 (fromIntegral sz)) - ((,) <$> (Text.pack . show <$> Gen.word64 Range.constantBounded) + ((,) <$> (Aeson.fromString . show <$> Gen.word64 Range.constantBounded) <*> genJsonForTxMetadataValue mapping) genJsonForTxMetadataValue :: TxMetadataJsonSchema -> Gen Aeson.Value @@ -76,10 +77,13 @@ genJsonForTxMetadataValue TxMetadataJsonNoSchema = genJsonValue genJsonList = Gen.sized $ \sz -> Gen.list (Range.linear 0 (fromIntegral sz)) genJsonValue - genJsonMap :: Gen [(Text, Aeson.Value)] + genJsonKey :: Gen Aeson.Key + genJsonKey = fmap Aeson.fromText genJsonText + + genJsonMap :: Gen [(Aeson.Key, Aeson.Value)] genJsonMap = Gen.sized $ \sz -> Gen.list (Range.linear 0 (fromIntegral sz)) $ - (,) <$> genJsonText <*> genJsonValue + (,) <$> genJsonKey <*> genJsonValue genJsonForTxMetadataValue TxMetadataJsonDetailedSchema = genJsonValue diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs index e757929e290..29813f7f3a7 100644 --- a/cardano-api/src/Cardano/Api/Orphans.hs +++ b/cardano-api/src/Cardano/Api/Orphans.hs @@ -19,8 +19,6 @@ import qualified Data.Aeson as Aeson import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText) import Data.BiMap (BiMap (..), Bimap) import qualified Data.ByteString.Base16 as B16 -import Data.Compact.SplitMap -import qualified Data.Compact.SplitMap as SplitMap import Data.Compact.VMap (VB, VMap, VP) import qualified Data.Compact.VMap as VMap import qualified Data.Map.Strict as Map @@ -222,8 +220,6 @@ instance Crypto.Crypto crypto => ToJSON (Shelley.PState crypto) where , "fPParams pState" .= Shelley._fPParams pState , "retiring pState" .= Shelley._retiring pState ] -instance (Ord k, ToJSONKey k, ToJSON v) => ToJSON (SplitMap k v) where - toJSON = toJSON . SplitMap.toMap instance ( Consensus.ShelleyBasedEra era , ToJSON (Core.TxOut era) diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index 4a601a1e587..4bdad3321f8 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -122,6 +122,7 @@ import Cardano.Api.Value import Data.Word (Word64) import qualified Cardano.Protocol.TPraos.API as TPraos import qualified Data.Compact.SplitMap as SplitMap +import qualified Data.Aeson.KeyMap as KeyMap -- ---------------------------------------------------------------------------- -- Queries @@ -280,7 +281,7 @@ instance IsCardanoEra era => ToJSON (UTxO era) where instance (IsCardanoEra era, IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era)) => FromJSON (UTxO era) where parseJSON = withObject "UTxO" $ \hm -> do - let l = HMS.toList hm + let l = HMS.toList $ KeyMap.toHashMapText hm res <- mapM toTxIn l pure . UTxO $ Map.fromList res where diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 9a1924fbe0f..c0b08042c6e 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -112,7 +112,6 @@ import Numeric.Natural (Natural) import Data.Aeson (Value (..), object, (.:), (.=)) import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Encoding as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.Sequence.Strict as Seq import Data.Vector (Vector) @@ -333,12 +332,11 @@ instance Aeson.FromJSONKey AnyPlutusScriptVersion where fromJSONKey = Aeson.FromJSONKeyTextParser parsePlutusScriptVersion instance Aeson.ToJSONKey AnyPlutusScriptVersion where - toJSONKey = Aeson.ToJSONKeyText toText toAesonEncoding + toJSONKey = Aeson.toJSONKeyText toText where toText :: AnyPlutusScriptVersion -> Text toText (AnyPlutusScriptVersion PlutusScriptV1) = "PlutusScriptV1" toText (AnyPlutusScriptVersion PlutusScriptV2) = "PlutusScriptV2" - toAesonEncoding = Aeson.text . toText toAlonzoLanguage :: AnyPlutusScriptVersion -> Alonzo.Language toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Alonzo.PlutusV1 diff --git a/cardano-api/src/Cardano/Api/ScriptData.hs b/cardano-api/src/Cardano/Api/ScriptData.hs index 03d905ef579..a16493404f0 100644 --- a/cardano-api/src/Cardano/Api/ScriptData.hs +++ b/cardano-api/src/Cardano/Api/ScriptData.hs @@ -43,7 +43,6 @@ import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Char as Char -import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List import Data.Maybe (fromMaybe) import qualified Data.Scientific as Scientific @@ -80,6 +79,8 @@ import qualified Cardano.Binary as CBOR import Cardano.Api.SerialiseUsing import Cardano.Api.TxMetadata (pBytes, pSigned, parseAll) import Codec.Serialise.Class (Serialise(..)) +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Aeson.Key as Aeson -- ---------------------------------------------------------------------------- -- Script data @@ -385,11 +386,12 @@ scriptDataToJsonNoSchema = conv -- Script data allows any value as a key, not just string as JSON does. -- For simple types we just convert them to string directly. -- For structured keys we render them as JSON and use that as the string. - convKey :: ScriptData -> Text - convKey (ScriptDataNumber n) = Text.pack (show n) - convKey (ScriptDataBytes bs) = bytesPrefix + convKey :: ScriptData -> Aeson.Key + convKey (ScriptDataNumber n) = Aeson.fromText $ Text.pack (show n) + convKey (ScriptDataBytes bs) = Aeson.fromText $ bytesPrefix <> Text.decodeLatin1 (Base16.encode bs) - convKey v = Text.Lazy.toStrict + convKey v = Aeson.fromText + . Text.Lazy.toStrict . Aeson.Text.encodeToLazyText . conv $ v @@ -428,7 +430,8 @@ scriptDataFromJsonNoSchema = conv fmap ScriptDataMap . traverse (\(k,v) -> (,) (convKey k) <$> conv v) . List.sortOn fst - $ HashMap.toList kvs + . fmap (first Aeson.toText) + $ KeyMap.toList kvs convKey :: Text -> ScriptData convKey s = @@ -482,7 +485,7 @@ scriptDataFromJsonDetailedSchema = conv conv :: Aeson.Value -> Either ScriptDataJsonSchemaError ScriptData conv (Aeson.Object m) = - case List.sort $ HashMap.toList m of + case List.sort $ KeyMap.toList m of [("int", Aeson.Number d)] -> case Scientific.floatingOrInteger d :: Either Double Integer of Left n -> Left (ScriptDataJsonNumberNotInteger n) @@ -511,9 +514,9 @@ scriptDataFromJsonDetailedSchema = conv $ Vector.toList vs (key, v):_ | key `elem` ["int", "bytes", "list", "map", "constructor"] -> - Left (ScriptDataJsonTypeMismatch key v) + Left (ScriptDataJsonTypeMismatch (Aeson.toText key) v) - kvs -> Left (ScriptDataJsonBadObject kvs) + kvs -> Left (ScriptDataJsonBadObject $ first Aeson.toText <$> kvs) conv v = Left (ScriptDataJsonNotObject v) @@ -521,9 +524,9 @@ scriptDataFromJsonDetailedSchema = conv -> Either ScriptDataJsonSchemaError (ScriptData, ScriptData) convKeyValuePair (Aeson.Object m) - | HashMap.size m == 2 - , Just k <- m HashMap.!? "k" - , Just v <- m HashMap.!? "v" + | KeyMap.size m == 2 + , Just k <- KeyMap.lookup "k" m + , Just v <- KeyMap.lookup "v" m = (,) <$> conv k <*> conv v convKeyValuePair v = Left (ScriptDataJsonBadMapPair v) @@ -575,7 +578,7 @@ instance Error ScriptDataJsonSchemaError where "JSON object does not match the schema.\nExpected a single field named " ++ "\"int\", \"bytes\", \"string\", \"list\" or \"map\".\n" ++ "Unexpected object field(s): " - ++ LBS.unpack (Aeson.encode (Aeson.object v)) + ++ LBS.unpack (Aeson.encode (KeyMap.fromList $ first Aeson.fromText <$> v)) displayError (ScriptDataJsonBadMapPair v) = "Expected a list of key/value pair { \"k\": ..., \"v\": ... } objects." ++ "\nUnexpected value: " ++ LBS.unpack (Aeson.encode v) @@ -583,4 +586,3 @@ instance Error ScriptDataJsonSchemaError where "The value in the field " ++ show k ++ " does not have the type " ++ "required by the schema.\nUnexpected value: " ++ LBS.unpack (Aeson.encode v) - diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 4a47b080d17..a356144b604 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -146,6 +146,7 @@ import Prelude import Control.Monad (guard) import Data.Aeson (object, withObject, withText, (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Aeson import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText) import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (first) @@ -154,7 +155,6 @@ import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as LBS import Data.Foldable (for_, toList) import Data.Function (on) -import qualified Data.HashMap.Strict as HMS import Data.List (intercalate, sortBy) import qualified Data.List.NonEmpty as NonEmpty import Data.Map.Strict (Map) @@ -244,6 +244,7 @@ import Cardano.Api.Value import Cardano.Api.ValueParser import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Crypto (StandardCrypto) +import qualified Data.Aeson.KeyMap as KeyMap {- HLINT ignore "Redundant flip" -} {- HLINT ignore "Use section" -} @@ -1072,13 +1073,13 @@ instance IsCardanoEra era => FromJSON (TxOutValue era) where ll <- o .: "lovelace" pure $ TxOutAdaOnly onlyAda $ selectLovelace ll Right maSupported -> do - let l = HMS.toList o + let l = KeyMap.toList o vals <- mapM decodeAssetId l pure $ TxOutValue maSupported $ mconcat vals where - decodeAssetId :: (Text, Aeson.Value) -> Aeson.Parser Value + decodeAssetId :: (Aeson.Key, Aeson.Value) -> Aeson.Parser Value decodeAssetId (polid, Aeson.Object assetNameHm) = do - let polId = fromString $ Text.unpack polid + let polId = fromString . Text.unpack $ Aeson.toText polid aNameQuantity <- decodeAssets assetNameHm pure . valueFromList $ map (first $ AssetId polId) aNameQuantity @@ -1093,11 +1094,11 @@ instance IsCardanoEra era => FromJSON (TxOutValue era) where decodeAssets :: Aeson.Object -> Aeson.Parser [(AssetName, Quantity)] decodeAssets assetNameHm = - let l = HMS.toList assetNameHm + let l = KeyMap.toList assetNameHm in mapM (\(aName, q) -> (,) <$> parseAssetName aName <*> decodeQuantity q) l - parseAssetName :: Text -> Aeson.Parser AssetName - parseAssetName aName = runParsecParser assetName aName + parseAssetName :: Aeson.Key -> Aeson.Parser AssetName + parseAssetName aName = runParsecParser assetName (Aeson.toText aName) decodeQuantity :: Aeson.Value -> Aeson.Parser Quantity decodeQuantity (Aeson.Number sci) = diff --git a/cardano-api/src/Cardano/Api/TxMetadata.hs b/cardano-api/src/Cardano/Api/TxMetadata.hs index 553d1ab0827..9556040fa7e 100644 --- a/cardano-api/src/Cardano/Api/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/TxMetadata.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} -- | Metadata embedded in transactions -- @@ -57,7 +58,6 @@ import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Map.Lazy as Map.Lazy import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List import qualified Data.Vector as Vector @@ -76,6 +76,8 @@ import Cardano.Api.Eras import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.SerialiseCBOR +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Aeson.Key as Aeson {- HLINT ignore "Use lambda-case" -} @@ -333,11 +335,11 @@ metadataFromJson schema = Aeson.Object m -> fmap (TxMetadata . Map.fromList) . mapM (uncurry metadataKeyPairFromJson) - $ HashMap.toList m + $ KeyMap.toList m _ -> Left TxMetadataJsonToplevelNotMap where - metadataKeyPairFromJson :: Text + metadataKeyPairFromJson :: Aeson.Key -> Aeson.Value -> Either TxMetadataJsonError (Word64, TxMetadataValue) @@ -349,8 +351,8 @@ metadataFromJson schema = (validateMetadataValue v') return (k', v') - convTopLevelKey :: Text -> Either TxMetadataJsonError Word64 - convTopLevelKey k = + convTopLevelKey :: Aeson.Key -> Either TxMetadataJsonError Word64 + convTopLevelKey (Aeson.toText -> k) = case parseAll (pUnsigned <* Atto.endOfInput) k of Just n | n <= fromIntegral (maxBound :: Word64) -> Right (fromIntegral n) @@ -382,7 +384,7 @@ metadataToJson :: TxMetadataJsonSchema metadataToJson schema = \(TxMetadata mdMap) -> Aeson.object - [ (Text.pack (show k), metadataValueToJson v) + [ (Aeson.fromString (show k), metadataValueToJson v) | (k, v) <- Map.toList mdMap ] where metadataValueToJson :: TxMetadataValue -> Aeson.Value @@ -413,12 +415,13 @@ metadataValueToJsonNoSchema = conv -- Metadata allows any value as a key, not just string as JSON does. -- For simple types we just convert them to string directly. -- For structured keys we render them as JSON and use that as the string. - convKey :: TxMetadataValue -> Text - convKey (TxMetaNumber n) = Text.pack (show n) - convKey (TxMetaBytes bs) = bytesPrefix + convKey :: TxMetadataValue -> Aeson.Key + convKey (TxMetaNumber n) = Aeson.fromString (show n) + convKey (TxMetaBytes bs) = Aeson.fromText $ bytesPrefix <> Text.decodeLatin1 (Base16.encode bs) - convKey (TxMetaText txt) = txt - convKey v = Text.Lazy.toStrict + convKey (TxMetaText txt) = Aeson.fromText txt + convKey v = Aeson.fromText + . Text.Lazy.toStrict . Aeson.Text.encodeToLazyText . conv $ v @@ -456,7 +459,8 @@ metadataValueFromJsonNoSchema = conv fmap TxMetaMap . traverse (\(k,v) -> (,) (convKey k) <$> conv v) . List.sortOn fst - $ HashMap.toList kvs + . fmap (first Aeson.toText) + $ KeyMap.toList kvs convKey :: Text -> TxMetadataValue convKey s = @@ -506,7 +510,7 @@ metadataValueFromJsonDetailedSchema = conv conv :: Aeson.Value -> Either TxMetadataJsonSchemaError TxMetadataValue conv (Aeson.Object m) = - case HashMap.toList m of + case KeyMap.toList m of [("int", Aeson.Number d)] -> case Scientific.floatingOrInteger d :: Either Double Integer of Left n -> Left (TxMetadataJsonNumberNotInteger n) @@ -529,9 +533,9 @@ metadataValueFromJsonDetailedSchema = conv $ Vector.toList kvs [(key, v)] | key `elem` ["int", "bytes", "string", "list", "map"] -> - Left (TxMetadataJsonTypeMismatch key v) + Left (TxMetadataJsonTypeMismatch (Aeson.toText key) v) - kvs -> Left (TxMetadataJsonBadObject kvs) + kvs -> Left (TxMetadataJsonBadObject (first Aeson.toText <$> kvs)) conv v = Left (TxMetadataJsonNotObject v) @@ -539,9 +543,9 @@ metadataValueFromJsonDetailedSchema = conv -> Either TxMetadataJsonSchemaError (TxMetadataValue, TxMetadataValue) convKeyValuePair (Aeson.Object m) - | HashMap.size m == 2 - , Just k <- m HashMap.!? "k" - , Just v <- m HashMap.!? "v" + | KeyMap.size m == 2 + , Just k <- KeyMap.lookup "k" m + , Just v <- KeyMap.lookup "v" m = (,) <$> conv k <*> conv v convKeyValuePair v = Left (TxMetadataJsonBadMapPair v) @@ -601,7 +605,7 @@ instance Error TxMetadataJsonSchemaError where "JSON object does not match the schema.\nExpected a single field named " ++ "\"int\", \"bytes\", \"string\", \"list\" or \"map\".\n" ++ "Unexpected object field(s): " - ++ LBS.unpack (Aeson.encode (Aeson.object v)) + ++ LBS.unpack (Aeson.encode (Aeson.object $ first Aeson.fromText <$> v)) displayError (TxMetadataJsonBadMapPair v) = "Expected a list of key/value pair { \"k\": ..., \"v\": ... } objects." ++ "\nUnexpected value: " ++ LBS.unpack (Aeson.encode v) diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 8c5f5043d75..25f7c5ac15b 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} -- | Currency values -- @@ -58,11 +59,11 @@ import Prelude import Data.Aeson (FromJSON, FromJSONKey, ToJSON, object, parseJSON, toJSON, withObject) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Aeson import Data.Aeson.Types (Parser, ToJSONKey) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC -import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Merge.Strict as Map import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -84,6 +85,7 @@ import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseRaw import Cardano.Api.SerialiseUsing import Cardano.Api.Utils (note) +import qualified Data.Aeson.KeyMap as KeyMap -- ---------------------------------------------------------------------------- @@ -345,19 +347,19 @@ valueFromNestedRep (ValueNestedRep bundles) = instance ToJSON ValueNestedRep where toJSON (ValueNestedRep bundles) = object $ map toPair bundles where - toPair :: ValueNestedBundle -> (Text, Aeson.Value) + toPair :: ValueNestedBundle -> (Aeson.Key, Aeson.Value) toPair (ValueNestedBundleAda q) = ("lovelace", toJSON q) - toPair (ValueNestedBundle pid assets) = (renderPolicyId pid, toJSON assets) + toPair (ValueNestedBundle pid assets) = (Aeson.fromText $ renderPolicyId pid, toJSON assets) instance FromJSON ValueNestedRep where parseJSON = withObject "ValueNestedRep" $ \obj -> ValueNestedRep <$> sequenceA [ parsePid keyValTuple - | keyValTuple <- HashMap.toList obj ] + | keyValTuple <- KeyMap.toList obj ] where - parsePid :: (Text, Aeson.Value) -> Parser ValueNestedBundle + parsePid :: (Aeson.Key, Aeson.Value) -> Parser ValueNestedBundle parsePid ("lovelace", q) = ValueNestedBundleAda <$> parseJSON q - parsePid (pid, quantityBundleJson) = do + parsePid (Aeson.toText -> pid, quantityBundleJson) = do sHash <- note ("Expected hex encoded PolicyId but got: " <> Text.unpack pid) $ deserialiseFromRawBytesHex AsScriptHash $ Text.encodeUtf8 pid diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs index c9b92ff408b..ac1c579dcdf 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -30,6 +30,7 @@ import Cardano.Ledger.Crypto (Crypto) import qualified Cardano.Ledger.Shelley.API as Shelley import Cardano.CLI.Helpers (textShow) +import qualified Data.Aeson.Key as Aeson yamlConfig :: Yaml.Config yamlConfig = Yaml.defConfig & setConfCompare compare @@ -305,7 +306,7 @@ friendlyValue v = [ case bundle of ValueNestedBundleAda q -> "lovelace" .= q ValueNestedBundle policy assets -> - friendlyPolicyId policy .= friendlyAssets assets + Aeson.fromText (friendlyPolicyId policy) .= friendlyAssets assets | bundle <- bundles ] where diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs b/cardano-cli/src/Cardano/CLI/Shelley/Output.hs index 0fb0d5f84e6..e20853bfabc 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Output.hs @@ -26,6 +26,7 @@ import Data.Word import Cardano.CLI.Shelley.Orphans () import Cardano.Ledger.Shelley.Scripts () import Cardano.Slotting.Time (SystemStart (..)) +import qualified Data.Aeson.Key as Aeson data QueryKesPeriodInfoOutput = QueryKesPeriodInfoOutput @@ -85,11 +86,11 @@ data QueryTipLocalStateOutput = QueryTipLocalStateOutput } deriving Show -- | A key-value pair difference list for encoding a JSON object. -(..=) :: (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv] +(..=) :: (KeyValue kv, ToJSON v) => Aeson.Key -> v -> [kv] -> [kv] (..=) n v = (n .= v:) -- | A key-value pair difference list for encoding a JSON object where Nothing encodes absence of the key-value pair. -(..=?) :: (KeyValue kv, ToJSON v) => Text -> Maybe v -> [kv] -> [kv] +(..=?) :: (KeyValue kv, ToJSON v) => Aeson.Key -> Maybe v -> [kv] -> [kv] (..=?) n mv = case mv of Just v -> (n .= v:) Nothing -> id @@ -214,4 +215,3 @@ renderScriptCosts eUnitPrices scriptMapping executionCostMapping = Left err -> Left (PlutusScriptCostErrExecError sWitInd scriptHash err) : accum Nothing -> Left (PlutusScriptCostErrPlutusScriptNotFound sWitInd) : accum ) [] executionCostMapping - diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs index b406c519e53..88d18adcec6 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs @@ -18,7 +18,7 @@ module Cardano.CLI.Shelley.Run.Genesis import Cardano.Prelude hiding (unlines) import Prelude (id, unlines) -import Data.Aeson +import Data.Aeson hiding (Key) import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.Binary.Get as Bin diff --git a/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs b/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs index a2f7c9f65a4..80f9ec7211d 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs @@ -11,11 +11,12 @@ import Prelude (String) import Test.OptParse as OP import qualified Data.Aeson as J +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Aeson.Key as J import qualified Data.Aeson.Types as J import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Lazy as HM import qualified Data.Set as S -import qualified Data.Text as T import qualified Data.Time.Clock as DT import qualified Hedgehog as H import qualified Hedgehog.Extras.Stock.Time as H @@ -35,7 +36,7 @@ parseSystemStart :: J.Value -> J.Parser String parseSystemStart = J.withObject "Object" $ \o -> o J..: "systemStart" parseHashMap :: J.Value -> J.Parser (HM.HashMap String J.Value) -parseHashMap (J.Object hm) = pure $ HM.fromList $ fmap (first T.unpack) (HM.toList hm) +parseHashMap (J.Object hm) = pure $ HM.fromList $ fmap (first J.toString) (KeyMap.toList hm) parseHashMap v = J.typeMismatch "Object" v parseDelegateCount :: J.Value -> J.Parser Int diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 538f62ec1b4..ac9e0486642 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -186,7 +186,6 @@ library , transformers , transformers-except , typed-protocols - , unordered-containers , yaml executable cardano-node diff --git a/cardano-node/src/Cardano/Node/TraceConstraints.hs b/cardano-node/src/Cardano/Node/TraceConstraints.hs index 94e5ef742e1..a79f208dcfd 100644 --- a/cardano-node/src/Cardano/Node/TraceConstraints.hs +++ b/cardano-node/src/Cardano/Node/TraceConstraints.hs @@ -15,7 +15,7 @@ import Cardano.Node.Queries (ConvertTxId, GetKESInfo (..), import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Rules.Bbody (AlonzoBbodyPredFail) import Cardano.Ledger.Alonzo.Rules.Utxo (UtxoPredicateFailure) -import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoPredFail) +import Cardano.Ledger.Alonzo.Rules.Utxow (UtxowPredicateFail) import Cardano.Ledger.Crypto (StandardCrypto) import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, @@ -58,7 +58,7 @@ type TraceConstraints blk = , ToObject (ForgeStateUpdateError blk) , ToObject (UtxoPredicateFailure (AlonzoEra StandardCrypto)) , ToObject (AlonzoBbodyPredFail (AlonzoEra StandardCrypto)) - , ToObject (AlonzoPredFail (AlonzoEra StandardCrypto)) + , ToObject (UtxowPredicateFail (AlonzoEra StandardCrypto)) , LogFormatting (LedgerUpdate blk) , LogFormatting (LedgerWarning blk) @@ -73,5 +73,5 @@ type TraceConstraints blk = , LogFormatting (ForgeStateUpdateError blk) , LogFormatting (UtxoPredicateFailure (AlonzoEra StandardCrypto)) , LogFormatting (AlonzoBbodyPredFail (AlonzoEra StandardCrypto)) - , LogFormatting (AlonzoPredFail (AlonzoEra StandardCrypto)) + , LogFormatting (UtxowPredicateFail (AlonzoEra StandardCrypto)) ) diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs index 66b7c69e5ee..45dce1124ed 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Byron.hs @@ -47,36 +47,36 @@ import Cardano.Crypto.Signing (VerificationKey) instance LogFormatting ApplyMempoolPayloadErr where forMachine _dtal (MempoolTxErr utxoValidationErr) = - mkObject + mconcat [ "kind" .= String "MempoolTxErr" , "error" .= String (show utxoValidationErr) ] forMachine _dtal (MempoolDlgErr delegScheduleError) = - mkObject + mconcat [ "kind" .= String "MempoolDlgErr" , "error" .= String (show delegScheduleError) ] forMachine _dtal (MempoolUpdateProposalErr iFaceErr) = - mkObject + mconcat [ "kind" .= String "MempoolUpdateProposalErr" , "error" .= String (show iFaceErr) ] forMachine _dtal (MempoolUpdateVoteErr iFaceErrr) = - mkObject + mconcat [ "kind" .= String "MempoolUpdateVoteErr" , "error" .= String (show iFaceErrr) ] instance LogFormatting ByronLedgerUpdate where forMachine dtal (ByronUpdatedProtocolUpdates protocolUpdates) = - mkObject + mconcat [ "kind" .= String "ByronUpdatedProtocolUpdates" , "protocolUpdates" .= map (forMachine dtal) protocolUpdates ] instance LogFormatting ProtocolUpdate where forMachine dtal (ProtocolUpdate updateVersion updateState) = - mkObject + mconcat [ "kind" .= String "ProtocolUpdate" , "protocolUpdateVersion" .= updateVersion , "protocolUpdateState" .= forMachine dtal updateState @@ -85,112 +85,112 @@ instance LogFormatting ProtocolUpdate where instance LogFormatting UpdateState where forMachine _dtal updateState = case updateState of UpdateRegistered slot -> - mkObject + mconcat [ "kind" .= String "UpdateRegistered" , "slot" .= slot ] UpdateActive votes -> - mkObject + mconcat [ "kind" .= String "UpdateActive" , "votes" .= map (Text.pack . show) (Set.toList votes) ] UpdateConfirmed slot -> - mkObject + mconcat [ "kind" .= String "UpdateConfirmed" , "slot" .= slot ] UpdateStablyConfirmed endorsements -> - mkObject + mconcat [ "kind" .= String "UpdateStablyConfirmed" , "endorsements" .= map (Text.pack . show) (Set.toList endorsements) ] UpdateCandidate slot epoch -> - mkObject + mconcat [ "kind" .= String "UpdateCandidate" , "slot" .= slot , "epoch" .= epoch ] UpdateStableCandidate transitionEpoch -> - mkObject + mconcat [ "kind" .= String "UpdateStableCandidate" , "transitionEpoch" .= transitionEpoch ] instance LogFormatting (GenTx ByronBlock) where forMachine dtal tx = - mkObject $ + mconcat $ ( "txid" .= txId tx ) : [ "tx" .= condense tx | dtal == DDetailed ] instance LogFormatting ChainValidationError where forMachine _dtal ChainValidationBoundaryTooLarge = - mkObject + mconcat [ "kind" .= String "ChainValidationBoundaryTooLarge" ] forMachine _dtal ChainValidationBlockAttributesTooLarge = - mkObject + mconcat [ "kind" .= String "ChainValidationBlockAttributesTooLarge" ] forMachine _dtal (ChainValidationBlockTooLarge _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationBlockTooLarge" ] forMachine _dtal ChainValidationHeaderAttributesTooLarge = - mkObject + mconcat [ "kind" .= String "ChainValidationHeaderAttributesTooLarge" ] forMachine _dtal (ChainValidationHeaderTooLarge _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationHeaderTooLarge" ] forMachine _dtal (ChainValidationDelegationPayloadError err) = - mkObject + mconcat [ "kind" .= String err ] forMachine _dtal (ChainValidationInvalidDelegation _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationInvalidDelegation" ] forMachine _dtal (ChainValidationGenesisHashMismatch _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationGenesisHashMismatch" ] forMachine _dtal (ChainValidationExpectedGenesisHash _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationExpectedGenesisHash" ] forMachine _dtal (ChainValidationExpectedHeaderHash _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationExpectedHeaderHash" ] forMachine _dtal (ChainValidationInvalidHash _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationInvalidHash" ] forMachine _dtal (ChainValidationMissingHash _) = - mkObject + mconcat [ "kind" .= String "ChainValidationMissingHash" ] forMachine _dtal (ChainValidationUnexpectedGenesisHash _) = - mkObject + mconcat [ "kind" .= String "ChainValidationUnexpectedGenesisHash" ] forMachine _dtal (ChainValidationInvalidSignature _) = - mkObject + mconcat [ "kind" .= String "ChainValidationInvalidSignature" ] forMachine _dtal (ChainValidationDelegationSchedulingError _) = - mkObject + mconcat [ "kind" .= String "ChainValidationDelegationSchedulingError" ] forMachine _dtal (ChainValidationProtocolMagicMismatch _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationProtocolMagicMismatch" ] forMachine _dtal ChainValidationSignatureLight = - mkObject + mconcat [ "kind" .= String "ChainValidationSignatureLight" ] forMachine _dtal (ChainValidationTooManyDelegations _) = - mkObject + mconcat [ "kind" .= String "ChainValidationTooManyDelegations" ] forMachine _dtal (ChainValidationUpdateError _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationUpdateError" ] forMachine _dtal (ChainValidationUTxOValidationError _) = - mkObject + mconcat [ "kind" .= String "ChainValidationUTxOValidationError" ] forMachine _dtal (ChainValidationProofValidationError _) = - mkObject + mconcat [ "kind" .= String "ChainValidationProofValidationError" ] instance LogFormatting (Header ByronBlock) where forMachine _dtal b = - mkObject $ + mconcat $ [ "kind" .= String "ByronBlock" , "hash" .= condense (blockHash b) , "slotNo" .= condense (blockSlot b) @@ -208,7 +208,7 @@ instance LogFormatting (Header ByronBlock) where instance LogFormatting ByronOtherHeaderEnvelopeError where forMachine _dtal (UnexpectedEBBInSlot slot) = - mkObject + mconcat [ "kind" .= String "UnexpectedEBBInSlot" , "slot" .= slot ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs index d876fac81c7..0a138e060eb 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs @@ -79,7 +79,7 @@ instance All (Compose LogFormatting GenTx) xs => LogFormatting (GenTx (HardForkB instance All (LogFormatting `Compose` WrapApplyTxErr) xs => LogFormatting (HardForkApplyTxErr xs) where forMachine dtal (HardForkApplyTxErrFromEra err) = forMachine dtal err forMachine _dtal (HardForkApplyTxErrWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkApplyTxErrWrongEra" , "currentEra" .= ledgerEraName , "txEra" .= otherEraName @@ -105,7 +105,7 @@ instance All (LogFormatting `Compose` WrapLedgerErr) xs => LogFormatting (HardFo forMachine dtal (HardForkLedgerErrorFromEra err) = forMachine dtal err forMachine _dtal (HardForkLedgerErrorWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkLedgerErrorWrongEra" , "currentEra" .= ledgerEraName , "blockEra" .= otherEraName @@ -134,7 +134,7 @@ instance ( All (LogFormatting `Compose` WrapLedgerWarning) xs HardForkWarningInEra err -> forMachine dtal err HardForkWarningTransitionMismatch toEra eraParams epoch -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionMismatch" , "toEra" .= condense toEra , "eraParams" .= forMachine dtal eraParams @@ -142,20 +142,20 @@ instance ( All (LogFormatting `Compose` WrapLedgerWarning) xs ] HardForkWarningTransitionInFinalEra fromEra epoch -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionInFinalEra" , "fromEra" .= condense fromEra , "transitionEpoch" .= epoch ] HardForkWarningTransitionUnconfirmed toEra -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionUnconfirmed" , "toEra" .= condense toEra ] HardForkWarningTransitionReconfirmed fromEra toEra prevEpoch newEpoch -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionReconfirmed" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -174,7 +174,7 @@ instance LogFormatting (LedgerWarning blk) => LogFormatting (WrapLedgerWarning b instance LogFormatting EraParams where forMachine _dtal EraParams{ eraEpochSize, eraSlotLength, eraSafeZone} = - mkObject + mconcat [ "epochSize" .= unEpochSize eraEpochSize , "slotLength" .= getSlotLength eraSlotLength , "safeZone" .= eraSafeZone @@ -194,7 +194,7 @@ instance ( All (LogFormatting `Compose` WrapLedgerUpdate) xs HardForkUpdateInEra err -> forMachine dtal err HardForkUpdateTransitionConfirmed fromEra toEra epoch -> - mkObject + mconcat [ "kind" .= String "HardForkUpdateTransitionConfirmed" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -202,7 +202,7 @@ instance ( All (LogFormatting `Compose` WrapLedgerUpdate) xs ] HardForkUpdateTransitionDone fromEra toEra epoch -> - mkObject + mconcat [ "kind" .= String "HardForkUpdateTransitionDone" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -210,7 +210,7 @@ instance ( All (LogFormatting `Compose` WrapLedgerUpdate) xs ] HardForkUpdateTransitionRolledBack fromEra toEra -> - mkObject + mconcat [ "kind" .= String "HardForkUpdateTransitionRolledBack" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -234,7 +234,7 @@ instance All (LogFormatting `Compose` WrapEnvelopeErr) xs => LogFormatting (Hard forMachine dtal (HardForkEnvelopeErrFromEra err) = forMachine dtal err forMachine _dtal (HardForkEnvelopeErrWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkEnvelopeErrWrongEra" , "currentEra" .= ledgerEraName , "blockEra" .= otherEraName @@ -260,7 +260,7 @@ instance All (LogFormatting `Compose` WrapValidationErr) xs => LogFormatting (Ha forMachine dtal (HardForkValidationErrFromEra err) = forMachine dtal err forMachine _dtal (HardForkValidationErrWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkValidationErrWrongEra" , "currentEra" .= ledgerEraName , "blockEra" .= otherEraName @@ -305,7 +305,7 @@ instance LogFormatting (CannotForge blk) => LogFormatting (WrapCannotForge blk) instance All (LogFormatting `Compose` WrapForgeStateInfo) xs => LogFormatting (OneEraForgeStateInfo xs) where forMachine dtal forgeStateInfo = - mkObject + mconcat [ "kind" .= String "HardForkForgeStateInfo" , "forgeStateInfo" .= toJSON forgeStateInfo' ] @@ -331,7 +331,7 @@ instance LogFormatting (ForgeStateInfo blk) => LogFormatting (WrapForgeStateInfo instance All (LogFormatting `Compose` WrapForgeStateUpdateError) xs => LogFormatting (OneEraForgeStateUpdateError xs) where forMachine dtal forgeStateUpdateError = - mkObject + mconcat [ "kind" .= String "HardForkForgeStateUpdateError" , "forgeStateUpdateError" .= toJSON forgeStateUpdateError' ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs index 2378b4f75d4..32bd427ba51 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs @@ -18,7 +18,6 @@ module Cardano.Node.Tracing.Era.Shelley () where import Data.Aeson (ToJSON (..), Value (..), (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson -import qualified Data.HashMap.Strict as HMS import qualified Data.Set as Set import qualified Data.Text as Text @@ -52,7 +51,7 @@ import qualified Cardano.Ledger.Alonzo as Alonzo import Cardano.Ledger.Alonzo.Rules.Bbody (AlonzoBbodyPredFail) import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo import qualified Cardano.Ledger.Alonzo.Rules.Utxos as Alonzo -import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoPredFail (..)) +import Cardano.Ledger.Alonzo.Rules.Utxow (UtxowPredicateFail (..)) import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.AuxiliaryData as Core import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) @@ -94,6 +93,7 @@ import Cardano.Protocol.TPraos.Rules.Prtcl PrtlSeqFailure (WrongBlockNoPrtclSeq, WrongBlockSequencePrtclSeq, WrongSlotIntervalPrtclSeq)) import Cardano.Protocol.TPraos.Rules.Tickn (TicknPredicateFailure) import Cardano.Tracing.OrphanInstances.Shelley () +import qualified Data.Aeson.Key as Aeson {- HLINT ignore "Use :" -} @@ -106,12 +106,12 @@ instance ( ToJSON (SupportsMempool.TxId (GenTx (ShelleyBlock era))) , ShelleyBasedEra era) => LogFormatting (GenTx (ShelleyBlock era)) where forMachine dtal tx = - mkObject $ + mconcat $ ( "txid" .= txId tx ) : [ "tx" .= condense tx | dtal == DDetailed ] instance ShelleyBasedEra era => LogFormatting (Header (ShelleyBlock era)) where - forMachine _dtal b = mkObject + forMachine _dtal b = mconcat [ "kind" .= String "ShelleyBlock" , "hash" .= condense (blockHash b) , "slotNo" .= condense (blockSlot b) @@ -125,17 +125,17 @@ instance ( ShelleyBasedEra era , LogFormatting (PredicateFailure (Core.EraRule "LEDGER" era)) ) => LogFormatting (ApplyTxError era) where forMachine dtal (ApplyTxError predicateFailures) = - HMS.unions $ map (forMachine dtal) predicateFailures + mconcat $ map (forMachine dtal) predicateFailures instance Core.Crypto era => LogFormatting (TPraosCannotForge era) where forMachine _dtal (TPraosCannotForgeKeyNotUsableYet wallClockPeriod keyStartPeriod) = - mkObject + mconcat [ "kind" .= String "TPraosCannotForgeKeyNotUsableYet" , "keyStart" .= keyStartPeriod , "wallClock" .= wallClockPeriod ] forMachine _dtal (TPraosCannotForgeWrongVRF genDlgVRFHash coreNodeVRFHash) = - mkObject + mconcat [ "kind" .= String "TPraosCannotLeadWrongVRF" , "expected" .= genDlgVRFHash , "actual" .= coreNodeVRFHash @@ -149,13 +149,13 @@ instance LogFormatting HotKey.KESInfo where kesPeriodsUntilExpiry = max 0 (oCertExpiryKesPeriod - currKesPeriod) in if kesPeriodsUntilExpiry > 7 - then mkObject + then mconcat [ "kind" .= String "KESInfo" , "startPeriod" .= startKesPeriod , "endPeriod" .= currKesPeriod , "evolution" .= endKesPeriod ] - else mkObject + else mconcat [ "kind" .= String "ExpiryLogMessage" , "keyExpiresIn" .= kesPeriodsUntilExpiry , "startPeriod" .= startKesPeriod @@ -212,13 +212,13 @@ instance LogFormatting HotKey.KESInfo where instance LogFormatting HotKey.KESEvolutionError where forMachine dtal (HotKey.KESCouldNotEvolve kesInfo targetPeriod) = - mkObject + mconcat [ "kind" .= String "KESCouldNotEvolve" , "kesInfo" .= forMachine dtal kesInfo , "targetPeriod" .= targetPeriod ] forMachine dtal (HotKey.KESKeyAlreadyPoisoned kesInfo targetPeriod) = - mkObject + mconcat [ "kind" .= String "KESKeyAlreadyPoisoned" , "kesInfo" .= forMachine dtal kesInfo , "targetPeriod" .= targetPeriod @@ -230,7 +230,7 @@ instance ( ShelleyBasedEra era , LogFormatting (PredicateFailure (Core.EraRule "BBODY" era)) ) => LogFormatting (ShelleyLedgerError era) where forMachine dtal (BBodyError (BlockTransitionError fs)) = - mkObject [ "kind" .= String "BBodyError" + mconcat [ "kind" .= String "BBodyError" , "failures" .= map (forMachine dtal) fs ] @@ -238,50 +238,50 @@ instance ( ShelleyBasedEra era , ToJSON (Core.PParamsDelta era) ) => LogFormatting (ShelleyLedgerUpdate era) where forMachine dtal (ShelleyUpdatedProtocolUpdates updates) = - mkObject [ "kind" .= String "ShelleyUpdatedProtocolUpdates" + mconcat [ "kind" .= String "ShelleyUpdatedProtocolUpdates" , "updates" .= map (forMachine dtal) updates ] instance (Ledger.Era era, ToJSON (Core.PParamsDelta era)) => LogFormatting (ProtocolUpdate era) where forMachine dtal ProtocolUpdate{protocolUpdateProposal, protocolUpdateState} = - mkObject [ "proposal" .= forMachine dtal protocolUpdateProposal + mconcat [ "proposal" .= forMachine dtal protocolUpdateProposal , "state" .= forMachine dtal protocolUpdateState ] instance ToJSON (Core.PParamsDelta era) => LogFormatting (UpdateProposal era) where forMachine _dtal UpdateProposal{proposalParams, proposalVersion, proposalEpoch} = - mkObject [ "params" .= proposalParams + mconcat [ "params" .= proposalParams , "version" .= proposalVersion , "epoch" .= proposalEpoch ] instance Core.Crypto crypto => LogFormatting (UpdateState crypto) where forMachine _dtal UpdateState{proposalVotes, proposalReachedQuorum} = - mkObject [ "proposal" .= proposalVotes + mconcat [ "proposal" .= proposalVotes , "reachedQuorum" .= proposalReachedQuorum ] instance Core.Crypto crypto => LogFormatting (ChainTransitionError crypto) where forMachine dtal (ChainTransitionError fs) = - mkObject [ "kind" .= String "ChainTransitionError" + mconcat [ "kind" .= String "ChainTransitionError" , "failures" .= map (forMachine dtal) fs ] instance LogFormatting ChainPredicateFailure where forMachine _dtal (HeaderSizeTooLargeCHAIN hdrSz maxHdrSz) = - mkObject [ "kind" .= String "HeaderSizeTooLarge" + mconcat [ "kind" .= String "HeaderSizeTooLarge" , "headerSize" .= hdrSz , "maxHeaderSize" .= maxHdrSz ] forMachine _dtal (BlockSizeTooLargeCHAIN blkSz maxBlkSz) = - mkObject [ "kind" .= String "BlockSizeTooLarge" + mconcat [ "kind" .= String "BlockSizeTooLarge" , "blockSize" .= blkSz , "maxBlockSize" .= maxBlkSz ] forMachine _dtal (ObsoleteNodeCHAIN currentPtcl supportedPtcl) = - mkObject [ "kind" .= String "ObsoleteNode" + mconcat [ "kind" .= String "ObsoleteNode" , "explanation" .= String explanation , "currentProtocol" .= currentPtcl , "supportedProtocol" .= supportedPtcl ] @@ -294,17 +294,17 @@ instance LogFormatting ChainPredicateFailure where instance LogFormatting (PrtlSeqFailure crypto) where forMachine _dtal (WrongSlotIntervalPrtclSeq (SlotNo lastSlot) (SlotNo currSlot)) = - mkObject [ "kind" .= String "WrongSlotInterval" + mconcat [ "kind" .= String "WrongSlotInterval" , "lastSlot" .= lastSlot , "currentSlot" .= currSlot ] forMachine _dtal (WrongBlockNoPrtclSeq lab currentBlockNo) = - mkObject [ "kind" .= String "WrongBlockNo" + mconcat [ "kind" .= String "WrongBlockNo" , "lastAppliedBlockNo" .= showLastAppBlockNo lab , "currentBlockNo" .= (String . textShow $ unBlockNo currentBlockNo) ] forMachine _dtal (WrongBlockSequencePrtclSeq lastAppliedHash currentHash) = - mkObject [ "kind" .= String "WrongBlockSequence" + mconcat [ "kind" .= String "WrongBlockSequence" , "lastAppliedBlockHash" .= String (textShow lastAppliedHash) , "currentBlockHash" .= String (textShow currentHash) ] @@ -316,12 +316,12 @@ instance ( ShelleyBasedEra era , LogFormatting (PredicateFailure (Core.EraRule "LEDGERS" era)) ) => LogFormatting (BbodyPredicateFailure era) where forMachine _dtal (WrongBlockBodySizeBBODY actualBodySz claimedBodySz) = - mkObject [ "kind" .= String "WrongBlockBodySizeBBODY" + mconcat [ "kind" .= String "WrongBlockBodySizeBBODY" , "actualBlockBodySize" .= actualBodySz , "claimedBlockBodySize" .= claimedBodySz ] forMachine _dtal (InvalidBodyHashBBODY actualHash claimedHash) = - mkObject [ "kind" .= String "InvalidBodyHashBBODY" + mconcat [ "kind" .= String "InvalidBodyHashBBODY" , "actualBodyHash" .= textShow actualHash , "claimedBodyHash" .= textShow claimedHash ] @@ -346,42 +346,42 @@ instance ( ShelleyBasedEra era forMachine dtal (UtxowFailure f) = forMachine dtal f forMachine dtal (DelegsFailure f) = forMachine dtal f -instance LogFormatting (AlonzoPredFail (Alonzo.AlonzoEra StandardCrypto)) where +instance LogFormatting (UtxowPredicateFail (Alonzo.AlonzoEra StandardCrypto)) where forMachine dtal (WrappedShelleyEraFailure utxoPredFail) = forMachine dtal utxoPredFail forMachine _ (MissingRedeemers scripts) = - mkObject [ "kind" .= String "MissingRedeemers" + mconcat [ "kind" .= String "MissingRedeemers" , "scripts" .= renderMissingRedeemers scripts ] forMachine _ (MissingRequiredDatums required received) = - mkObject [ "kind" .= String "MissingRequiredDatums" + mconcat [ "kind" .= String "MissingRequiredDatums" , "required" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList required) , "received" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList received) ] forMachine _ (PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams) = - mkObject [ "kind" .= String "PPViewHashesDontMatch" + mconcat [ "kind" .= String "PPViewHashesDontMatch" , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody) , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams) ] forMachine _ (MissingRequiredSigners missingKeyWitnesses) = - mkObject [ "kind" .= String "MissingRequiredSigners" + mconcat [ "kind" .= String "MissingRequiredSigners" , "witnesses" .= Set.toList missingKeyWitnesses ] forMachine _ (UnspendableUTxONoDatumHash txins) = - mkObject [ "kind" .= String "MissingRequiredSigners" + mconcat [ "kind" .= String "MissingRequiredSigners" , "txins" .= Set.toList txins ] forMachine _ (NonOutputSupplimentaryDatums disallowed acceptable) = - mkObject [ "kind" .= String "NonOutputSupplimentaryDatums" + mconcat [ "kind" .= String "NonOutputSupplimentaryDatums" , "disallowed" .= Set.toList disallowed , "acceptable" .= Set.toList acceptable ] forMachine _ (ExtraRedeemers rdmrs) = - mkObject [ "kind" .= String "ExtraRedeemers" + mconcat [ "kind" .= String "ExtraRedeemers" , "rdmrs" .= map (Api.renderScriptWitnessIndex . Api.fromAlonzoRdmrPtr) rdmrs ] @@ -398,7 +398,8 @@ renderMissingRedeemers :: [(Alonzo.ScriptPurpose StandardCrypto, ScriptHash Stan renderMissingRedeemers scripts = Aeson.object $ map renderTuple scripts where renderTuple :: (Alonzo.ScriptPurpose StandardCrypto, ScriptHash StandardCrypto) -> Aeson.Pair - renderTuple (scriptPurpose, sHash) = renderScriptHash sHash .= renderScriptPurpose scriptPurpose + renderTuple (scriptPurpose, sHash) = + Aeson.fromText (renderScriptHash sHash) .= renderScriptPurpose scriptPurpose renderScriptPurpose :: Alonzo.ScriptPurpose StandardCrypto -> Aeson.Value renderScriptPurpose (Alonzo.Minting pid) = @@ -418,44 +419,44 @@ instance ( ShelleyBasedEra era , LogFormatting (PredicateFailure (Core.EraRule "UTXO" era)) ) => LogFormatting (UtxowPredicateFailure era) where forMachine _dtal (InvalidWitnessesUTXOW wits') = - mkObject [ "kind" .= String "InvalidWitnessesUTXOW" + mconcat [ "kind" .= String "InvalidWitnessesUTXOW" , "invalidWitnesses" .= map textShow wits' ] forMachine _dtal (MissingVKeyWitnessesUTXOW (WitHashes wits')) = - mkObject [ "kind" .= String "MissingVKeyWitnessesUTXOW" + mconcat [ "kind" .= String "MissingVKeyWitnessesUTXOW" , "missingWitnesses" .= wits' ] forMachine _dtal (MissingScriptWitnessesUTXOW missingScripts) = - mkObject [ "kind" .= String "MissingScriptWitnessesUTXOW" + mconcat [ "kind" .= String "MissingScriptWitnessesUTXOW" , "missingScripts" .= missingScripts ] forMachine _dtal (ScriptWitnessNotValidatingUTXOW failedScripts) = - mkObject [ "kind" .= String "ScriptWitnessNotValidatingUTXOW" + mconcat [ "kind" .= String "ScriptWitnessNotValidatingUTXOW" , "failedScripts" .= failedScripts ] forMachine dtal (UtxoFailure f) = forMachine dtal f forMachine _dtal (MIRInsufficientGenesisSigsUTXOW genesisSigs) = - mkObject [ "kind" .= String "MIRInsufficientGenesisSigsUTXOW" + mconcat [ "kind" .= String "MIRInsufficientGenesisSigsUTXOW" , "genesisSigs" .= genesisSigs ] forMachine _dtal (MissingTxBodyMetadataHash metadataHash) = - mkObject [ "kind" .= String "MissingTxBodyMetadataHash" + mconcat [ "kind" .= String "MissingTxBodyMetadataHash" , "metadataHash" .= metadataHash ] forMachine _dtal (MissingTxMetadata txBodyMetadataHash) = - mkObject [ "kind" .= String "MissingTxMetadata" + mconcat [ "kind" .= String "MissingTxMetadata" , "txBodyMetadataHash" .= txBodyMetadataHash ] forMachine _dtal (ConflictingMetadataHash txBodyMetadataHash fullMetadataHash) = - mkObject [ "kind" .= String "ConflictingMetadataHash" + mconcat [ "kind" .= String "ConflictingMetadataHash" , "txBodyMetadataHash" .= txBodyMetadataHash , "fullMetadataHash" .= fullMetadataHash ] forMachine _dtal InvalidMetadata = - mkObject [ "kind" .= String "InvalidMetadata" + mconcat [ "kind" .= String "InvalidMetadata" ] forMachine _dtal (ExtraneousScriptWitnessesUTXOW shashes) = - mkObject [ "kind" .= String "ExtraneousScriptWitnessesUTXOW" + mconcat [ "kind" .= String "ExtraneousScriptWitnessesUTXOW" , "scriptHashes" .= Set.map Api.fromShelleyScriptHash shashes ] @@ -466,38 +467,38 @@ instance ( ShelleyBasedEra era ) => LogFormatting (UtxoPredicateFailure era) where forMachine _dtal (BadInputsUTxO badInputs) = - mkObject [ "kind" .= String "BadInputsUTxO" + mconcat [ "kind" .= String "BadInputsUTxO" , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] forMachine _dtal (ExpiredUTxO ttl slot) = - mkObject [ "kind" .= String "ExpiredUTxO" + mconcat [ "kind" .= String "ExpiredUTxO" , "ttl" .= ttl , "slot" .= slot ] forMachine _dtal (MaxTxSizeUTxO txsize maxtxsize) = - mkObject [ "kind" .= String "MaxTxSizeUTxO" + mconcat [ "kind" .= String "MaxTxSizeUTxO" , "size" .= txsize , "maxSize" .= maxtxsize ] -- TODO: Add the minimum allowed UTxO value to OutputTooSmallUTxO forMachine _dtal (OutputTooSmallUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooSmallUTxO" + mconcat [ "kind" .= String "OutputTooSmallUTxO" , "outputs" .= badOutputs , "error" .= String "The output is smaller than the allow minimum \ \UTxO value defined in the protocol parameters" ] forMachine _dtal (OutputBootAddrAttrsTooBig badOutputs) = - mkObject [ "kind" .= String "OutputBootAddrAttrsTooBig" + mconcat [ "kind" .= String "OutputBootAddrAttrsTooBig" , "outputs" .= badOutputs , "error" .= String "The Byron address attributes are too big" ] forMachine _dtal InputSetEmptyUTxO = - mkObject [ "kind" .= String "InputSetEmptyUTxO" ] + mconcat [ "kind" .= String "InputSetEmptyUTxO" ] forMachine _dtal (FeeTooSmallUTxO minfee txfee) = - mkObject [ "kind" .= String "FeeTooSmallUTxO" + mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= txfee ] forMachine _dtal (ValueNotConservedUTxO consumed produced) = - mkObject [ "kind" .= String "ValueNotConservedUTxO" + mconcat [ "kind" .= String "ValueNotConservedUTxO" , "consumed" .= consumed , "produced" .= produced , "error" .= renderValueNotConservedErr consumed produced @@ -505,12 +506,12 @@ instance ( ShelleyBasedEra era forMachine dtal (UpdateFailure f) = forMachine dtal f forMachine _dtal (WrongNetwork network addrs) = - mkObject [ "kind" .= String "WrongNetwork" + mconcat [ "kind" .= String "WrongNetwork" , "network" .= network , "addrs" .= addrs ] forMachine _dtal (WrongNetworkWithdrawal network addrs) = - mkObject [ "kind" .= String "WrongNetworkWithdrawal" + mconcat [ "kind" .= String "WrongNetworkWithdrawal" , "network" .= network , "addrs" .= addrs ] @@ -522,57 +523,57 @@ instance ( ShelleyBasedEra era , LogFormatting (PredicateFailure (Core.EraRule "PPUP" era)) ) => LogFormatting (MA.UtxoPredicateFailure era) where forMachine _dtal (MA.BadInputsUTxO badInputs) = - mkObject [ "kind" .= String "BadInputsUTxO" + mconcat [ "kind" .= String "BadInputsUTxO" , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] forMachine _dtal (MA.OutsideValidityIntervalUTxO validityInterval slot) = - mkObject [ "kind" .= String "ExpiredUTxO" + mconcat [ "kind" .= String "ExpiredUTxO" , "validityInterval" .= validityInterval , "slot" .= slot ] forMachine _dtal (MA.MaxTxSizeUTxO txsize maxtxsize) = - mkObject [ "kind" .= String "MaxTxSizeUTxO" + mconcat [ "kind" .= String "MaxTxSizeUTxO" , "size" .= txsize , "maxSize" .= maxtxsize ] forMachine _dtal MA.InputSetEmptyUTxO = - mkObject [ "kind" .= String "InputSetEmptyUTxO" ] + mconcat [ "kind" .= String "InputSetEmptyUTxO" ] forMachine _dtal (MA.FeeTooSmallUTxO minfee txfee) = - mkObject [ "kind" .= String "FeeTooSmallUTxO" + mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= txfee ] forMachine _dtal (MA.ValueNotConservedUTxO consumed produced) = - mkObject [ "kind" .= String "ValueNotConservedUTxO" + mconcat [ "kind" .= String "ValueNotConservedUTxO" , "consumed" .= consumed , "produced" .= produced , "error" .= renderValueNotConservedErr consumed produced ] forMachine _dtal (MA.WrongNetwork network addrs) = - mkObject [ "kind" .= String "WrongNetwork" + mconcat [ "kind" .= String "WrongNetwork" , "network" .= network , "addrs" .= addrs ] forMachine _dtal (MA.WrongNetworkWithdrawal network addrs) = - mkObject [ "kind" .= String "WrongNetworkWithdrawal" + mconcat [ "kind" .= String "WrongNetworkWithdrawal" , "network" .= network , "addrs" .= addrs ] -- TODO: Add the minimum allowed UTxO value to OutputTooSmallUTxO forMachine _dtal (MA.OutputTooSmallUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooSmallUTxO" + mconcat [ "kind" .= String "OutputTooSmallUTxO" , "outputs" .= badOutputs , "error" .= String "The output is smaller than the allow minimum \ \UTxO value defined in the protocol parameters" ] forMachine dtal (MA.UpdateFailure f) = forMachine dtal f forMachine _dtal (MA.OutputBootAddrAttrsTooBig badOutputs) = - mkObject [ "kind" .= String "OutputBootAddrAttrsTooBig" + mconcat [ "kind" .= String "OutputBootAddrAttrsTooBig" , "outputs" .= badOutputs , "error" .= String "The Byron address attributes are too big" ] forMachine _dtal MA.TriesToForgeADA = - mkObject [ "kind" .= String "TriesToForgeADA" ] + mconcat [ "kind" .= String "TriesToForgeADA" ] forMachine _dtal (MA.OutputTooBigUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooBigUTxO" + mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs , "error" .= String "Too many asset ids in the tx output" ] @@ -588,16 +589,16 @@ renderValueNotConservedErr consumed produced = String $ instance Core.Crypto (Ledger.Crypto era) => LogFormatting (PpupPredicateFailure era) where forMachine _dtal (NonGenesisUpdatePPUP proposalKeys genesisKeys) = - mkObject [ "kind" .= String "NonGenesisUpdatePPUP" + mconcat [ "kind" .= String "NonGenesisUpdatePPUP" , "keys" .= proposalKeys Set.\\ genesisKeys ] forMachine _dtal (PPUpdateWrongEpoch currEpoch intendedEpoch votingPeriod) = - mkObject [ "kind" .= String "PPUpdateWrongEpoch" + mconcat [ "kind" .= String "PPUpdateWrongEpoch" , "currentEpoch" .= currEpoch , "intendedEpoch" .= intendedEpoch , "votingPeriod" .= String (show votingPeriod) ] forMachine _dtal (PVCannotFollowPPUP badPv) = - mkObject [ "kind" .= String "PVCannotFollowPPUP" + mconcat [ "kind" .= String "PVCannotFollowPPUP" , "badProtocolVersion" .= badPv ] @@ -606,11 +607,11 @@ instance ( ShelleyBasedEra era , LogFormatting (PredicateFailure (Core.EraRule "DELPL" era)) ) => LogFormatting (DelegsPredicateFailure era) where forMachine _dtal (DelegateeNotRegisteredDELEG targetPool) = - mkObject [ "kind" .= String "DelegateeNotRegisteredDELEG" + mconcat [ "kind" .= String "DelegateeNotRegisteredDELEG" , "targetPool" .= targetPool ] forMachine _dtal (WithdrawalsNotInRewardsDELEGS incorrectWithdrawals) = - mkObject [ "kind" .= String "WithdrawalsNotInRewardsDELEGS" + mconcat [ "kind" .= String "WithdrawalsNotInRewardsDELEGS" , "incorrectWithdrawals" .= incorrectWithdrawals ] forMachine dtal (DelplFailure f) = forMachine dtal f @@ -626,43 +627,43 @@ instance ( LogFormatting (PredicateFailure (Core.EraRule "POOL" era)) instance Crypto.HashAlgorithm (Core.HASH (Ledger.Crypto era)) => LogFormatting (DelegPredicateFailure era) where forMachine _dtal (StakeKeyAlreadyRegisteredDELEG alreadyRegistered) = - mkObject [ "kind" .= String "StakeKeyAlreadyRegisteredDELEG" + mconcat [ "kind" .= String "StakeKeyAlreadyRegisteredDELEG" , "credential" .= String (textShow alreadyRegistered) , "error" .= String "Staking credential already registered" ] forMachine _dtal (StakeKeyInRewardsDELEG alreadyRegistered) = - mkObject [ "kind" .= String "StakeKeyInRewardsDELEG" + mconcat [ "kind" .= String "StakeKeyInRewardsDELEG" , "credential" .= String (textShow alreadyRegistered) , "error" .= String "Staking credential registered in rewards map" ] forMachine _dtal (StakeKeyNotRegisteredDELEG notRegistered) = - mkObject [ "kind" .= String "StakeKeyNotRegisteredDELEG" + mconcat [ "kind" .= String "StakeKeyNotRegisteredDELEG" , "credential" .= String (textShow notRegistered) , "error" .= String "Staking credential not registered" ] forMachine _dtal (StakeKeyNonZeroAccountBalanceDELEG remBalance) = - mkObject [ "kind" .= String "StakeKeyNonZeroAccountBalanceDELEG" + mconcat [ "kind" .= String "StakeKeyNonZeroAccountBalanceDELEG" , "remainingBalance" .= remBalance ] forMachine _dtal (StakeDelegationImpossibleDELEG unregistered) = - mkObject [ "kind" .= String "StakeDelegationImpossibleDELEG" + mconcat [ "kind" .= String "StakeDelegationImpossibleDELEG" , "credential" .= String (textShow unregistered) , "error" .= String "Cannot delegate this stake credential because it is not registered" ] forMachine _dtal WrongCertificateTypeDELEG = - mkObject [ "kind" .= String "WrongCertificateTypeDELEG" ] + mconcat [ "kind" .= String "WrongCertificateTypeDELEG" ] forMachine _dtal (GenesisKeyNotInMappingDELEG (KeyHash genesisKeyHash)) = - mkObject [ "kind" .= String "GenesisKeyNotInMappingDELEG" + mconcat [ "kind" .= String "GenesisKeyNotInMappingDELEG" , "unknownKeyHash" .= String (textShow genesisKeyHash) , "error" .= String "This genesis key is not in the delegation mapping" ] forMachine _dtal (DuplicateGenesisDelegateDELEG (KeyHash genesisKeyHash)) = - mkObject [ "kind" .= String "DuplicateGenesisDelegateDELEG" + mconcat [ "kind" .= String "DuplicateGenesisDelegateDELEG" , "duplicateKeyHash" .= String (textShow genesisKeyHash) , "error" .= String "This genesis key has already been delegated to" ] forMachine _dtal (InsufficientForInstantaneousRewardsDELEG mirpot neededMirAmount reserves) = - mkObject [ "kind" .= String "InsufficientForInstantaneousRewardsDELEG" + mconcat [ "kind" .= String "InsufficientForInstantaneousRewardsDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") @@ -670,22 +671,22 @@ instance Crypto.HashAlgorithm (Core.HASH (Ledger.Crypto era)) , "reserves" .= reserves ] forMachine _dtal (MIRCertificateTooLateinEpochDELEG currSlot boundSlotNo) = - mkObject [ "kind" .= String "MIRCertificateTooLateinEpochDELEG" + mconcat [ "kind" .= String "MIRCertificateTooLateinEpochDELEG" , "currentSlotNo" .= currSlot , "mustBeSubmittedBeforeSlotNo" .= boundSlotNo ] forMachine _dtal (DuplicateGenesisVRFDELEG vrfKeyHash) = - mkObject [ "kind" .= String "DuplicateGenesisVRFDELEG" + mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" , "keyHash" .= vrfKeyHash ] forMachine _dtal MIRTransferNotCurrentlyAllowed = - mkObject [ "kind" .= String "MIRTransferNotCurrentlyAllowed" + mconcat [ "kind" .= String "MIRTransferNotCurrentlyAllowed" ] forMachine _dtal MIRNegativesNotCurrentlyAllowed = - mkObject [ "kind" .= String "MIRNegativesNotCurrentlyAllowed" + mconcat [ "kind" .= String "MIRNegativesNotCurrentlyAllowed" ] forMachine _dtal (InsufficientForTransferDELEG mirpot attempted available) = - mkObject [ "kind" .= String "DuplicateGenesisVRFDELEG" + mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") @@ -693,10 +694,10 @@ instance Crypto.HashAlgorithm (Core.HASH (Ledger.Crypto era)) , "available" .= available ] forMachine _dtal MIRProducesNegativeUpdate = - mkObject [ "kind" .= String "MIRProducesNegativeUpdate" + mconcat [ "kind" .= String "MIRProducesNegativeUpdate" ] forMachine _dtal (MIRNegativeTransfer mirpot coin) = - mkObject [ "kind" .= String "MIRProducesNegativeUpdate" + mconcat [ "kind" .= String "MIRProducesNegativeUpdate" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") @@ -705,24 +706,24 @@ instance Crypto.HashAlgorithm (Core.HASH (Ledger.Crypto era)) instance LogFormatting (PoolPredicateFailure era) where forMachine _dtal (StakePoolNotRegisteredOnKeyPOOL (KeyHash unregStakePool)) = - mkObject [ "kind" .= String "StakePoolNotRegisteredOnKeyPOOL" + mconcat [ "kind" .= String "StakePoolNotRegisteredOnKeyPOOL" , "unregisteredKeyHash" .= String (textShow unregStakePool) , "error" .= String "This stake pool key hash is unregistered" ] forMachine _dtal (StakePoolRetirementWrongEpochPOOL currentEpoch intendedRetireEpoch maxRetireEpoch) = - mkObject [ "kind" .= String "StakePoolRetirementWrongEpochPOOL" + mconcat [ "kind" .= String "StakePoolRetirementWrongEpochPOOL" , "currentEpoch" .= String (textShow currentEpoch) , "intendedRetirementEpoch" .= String (textShow intendedRetireEpoch) , "maxEpochForRetirement" .= String (textShow maxRetireEpoch) ] forMachine _dtal (StakePoolCostTooLowPOOL certCost protCost) = - mkObject [ "kind" .= String "StakePoolCostTooLowPOOL" + mconcat [ "kind" .= String "StakePoolCostTooLowPOOL" , "certificateCost" .= String (textShow certCost) , "protocolParCost" .= String (textShow protCost) , "error" .= String "The stake pool cost is too low" ] forMachine _dtal (PoolMedataHashTooBig poolID hashSize) = - mkObject [ "kind" .= String "PoolMedataHashTooBig" + mconcat [ "kind" .= String "PoolMedataHashTooBig" , "hashSize" .= String (textShow poolID) , "poolID" .= String (textShow hashSize) , "error" .= String "The stake pool metadata hash is too large" @@ -731,22 +732,22 @@ instance LogFormatting (PoolPredicateFailure era) where -- Apparently this should never happen according to the Shelley exec spec forMachine _dtal (WrongCertificateTypePOOL index) = case index of - 0 -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + 0 -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "error" .= String "Wrong certificate type: Delegation certificate" ] - 1 -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + 1 -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "error" .= String "Wrong certificate type: MIR certificate" ] - 2 -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + 2 -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "error" .= String "Wrong certificate type: Genesis certificate" ] - k -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + k -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "certificateType" .= k , "error" .= String "Wrong certificate type: Unknown certificate type" ] forMachine _dtal (WrongNetworkPOOL networkId listedNetworkId poolId) = - mkObject [ "kind" .= String "WrongNetworkPOOL" + mconcat [ "kind" .= String "WrongNetworkPOOL" , "networkId" .= String (textShow networkId) , "listedNetworkId" .= String (textShow listedNetworkId) , "poolId" .= String (textShow poolId) @@ -769,7 +770,7 @@ instance ( LogFormatting (PredicateFailure (Core.EraRule "EPOCH" era)) forMachine dtal (EpochFailure f) = forMachine dtal f forMachine dtal (MirFailure f) = forMachine dtal f forMachine _dtal (CorruptRewardUpdate update) = - mkObject [ "kind" .= String "CorruptRewardUpdate" + mconcat [ "kind" .= String "CorruptRewardUpdate" , "update" .= String (show update) ] @@ -792,7 +793,7 @@ instance LogFormatting (SnapPredicateFailure era) where -- TODO: Need to elaborate more on this error instance LogFormatting (NewppPredicateFailure era) where forMachine _dtal (UnexpectedDepositPot outstandingDeposits depositPot) = - mkObject [ "kind" .= String "UnexpectedDepositPot" + mconcat [ "kind" .= String "UnexpectedDepositPot" , "outstandingDeposits" .= String (textShow outstandingDeposits) , "depositPot" .= String (textShow depositPot) ] @@ -813,51 +814,51 @@ instance Core.Crypto crypto => LogFormatting (PrtclPredicateFailure crypto) wher instance Core.Crypto crypto => LogFormatting (OverlayPredicateFailure crypto) where forMachine _dtal (UnknownGenesisKeyOVERLAY (KeyHash genKeyHash)) = - mkObject [ "kind" .= String "UnknownGenesisKeyOVERLAY" + mconcat [ "kind" .= String "UnknownGenesisKeyOVERLAY" , "unknownKeyHash" .= String (textShow genKeyHash) ] forMachine _dtal (VRFKeyBadLeaderValue seedNonce (SlotNo currSlotNo) prevHashNonce leaderElecVal) = - mkObject [ "kind" .= String "VRFKeyBadLeaderValueOVERLAY" + mconcat [ "kind" .= String "VRFKeyBadLeaderValueOVERLAY" , "seedNonce" .= String (textShow seedNonce) , "currentSlot" .= String (textShow currSlotNo) , "previousHashAsNonce" .= String (textShow prevHashNonce) , "leaderElectionValue" .= String (textShow leaderElecVal) ] forMachine _dtal (VRFKeyBadNonce seedNonce (SlotNo currSlotNo) prevHashNonce blockNonce) = - mkObject [ "kind" .= String "VRFKeyBadNonceOVERLAY" + mconcat [ "kind" .= String "VRFKeyBadNonceOVERLAY" , "seedNonce" .= String (textShow seedNonce) , "currentSlot" .= String (textShow currSlotNo) , "previousHashAsNonce" .= String (textShow prevHashNonce) , "blockNonce" .= String (textShow blockNonce) ] forMachine _dtal (VRFKeyWrongVRFKey issuerHash regVRFKeyHash unregVRFKeyHash) = - mkObject [ "kind" .= String "VRFKeyWrongVRFKeyOVERLAY" + mconcat [ "kind" .= String "VRFKeyWrongVRFKeyOVERLAY" , "poolHash" .= textShow issuerHash , "registeredVRFKeHash" .= textShow regVRFKeyHash , "unregisteredVRFKeyHash" .= textShow unregVRFKeyHash ] --TODO: Pipe slot number with VRFKeyUnknown forMachine _dtal (VRFKeyUnknown (KeyHash kHash)) = - mkObject [ "kind" .= String "VRFKeyUnknownOVERLAY" + mconcat [ "kind" .= String "VRFKeyUnknownOVERLAY" , "keyHash" .= String (textShow kHash) ] forMachine _dtal (VRFLeaderValueTooBig leadElecVal weightOfDelegPool actSlotCoefff) = - mkObject [ "kind" .= String "VRFLeaderValueTooBigOVERLAY" + mconcat [ "kind" .= String "VRFLeaderValueTooBigOVERLAY" , "leaderElectionValue" .= String (textShow leadElecVal) , "delegationPoolWeight" .= String (textShow weightOfDelegPool) , "activeSlotCoefficient" .= String (textShow actSlotCoefff) ] forMachine _dtal (NotActiveSlotOVERLAY notActiveSlotNo) = -- TODO: Elaborate on NotActiveSlot error - mkObject [ "kind" .= String "NotActiveSlotOVERLAY" + mconcat [ "kind" .= String "NotActiveSlotOVERLAY" , "slot" .= String (textShow notActiveSlotNo) ] forMachine _dtal (WrongGenesisColdKeyOVERLAY actual expected) = - mkObject [ "kind" .= String "WrongGenesisColdKeyOVERLAY" + mconcat [ "kind" .= String "WrongGenesisColdKeyOVERLAY" , "actual" .= actual , "expected" .= expected ] forMachine _dtal (WrongGenesisVRFKeyOVERLAY issuer actual expected) = - mkObject [ "kind" .= String "WrongGenesisVRFKeyOVERLAY" + mconcat [ "kind" .= String "WrongGenesisVRFKeyOVERLAY" , "issuer" .= issuer , "actual" .= actual , "expected" .= expected ] @@ -866,14 +867,14 @@ instance Core.Crypto crypto => LogFormatting (OverlayPredicateFailure crypto) wh instance LogFormatting (OcertPredicateFailure crypto) where forMachine _dtal (KESBeforeStartOCERT (KESPeriod oCertstart) (KESPeriod current)) = - mkObject [ "kind" .= String "KESBeforeStartOCERT" + mconcat [ "kind" .= String "KESBeforeStartOCERT" , "opCertKESStartPeriod" .= String (textShow oCertstart) , "currentKESPeriod" .= String (textShow current) , "error" .= String "Your operational certificate's KES start period \ \is before the KES current period." ] forMachine _dtal (KESAfterEndOCERT (KESPeriod current) (KESPeriod oCertstart) maxKESEvolutions) = - mkObject [ "kind" .= String "KESAfterEndOCERT" + mconcat [ "kind" .= String "KESAfterEndOCERT" , "currentKESPeriod" .= String (textShow current) , "opCertKESStartPeriod" .= String (textShow oCertstart) , "maxKESEvolutions" .= String (textShow maxKESEvolutions) @@ -881,25 +882,25 @@ instance LogFormatting (OcertPredicateFailure crypto) where \greater than the max number of KES + the KES current period" ] forMachine _dtal (CounterTooSmallOCERT lastKEScounterUsed currentKESCounter) = - mkObject [ "kind" .= String "CounterTooSmallOCert" + mconcat [ "kind" .= String "CounterTooSmallOCert" , "currentKESCounter" .= String (textShow currentKESCounter) , "lastKESCounter" .= String (textShow lastKEScounterUsed) , "error" .= String "The operational certificate's last KES counter is greater \ \than the current KES counter." ] forMachine _dtal (InvalidSignatureOCERT oCertCounter oCertKESStartPeriod) = - mkObject [ "kind" .= String "InvalidSignatureOCERT" + mconcat [ "kind" .= String "InvalidSignatureOCERT" , "opCertKESStartPeriod" .= String (textShow oCertKESStartPeriod) , "opCertCounter" .= String (textShow oCertCounter) ] forMachine _dtal (InvalidKesSignatureOCERT currKESPeriod startKESPeriod expectedKESEvolutions err) = - mkObject [ "kind" .= String "InvalidKesSignatureOCERT" + mconcat [ "kind" .= String "InvalidKesSignatureOCERT" , "opCertKESStartPeriod" .= String (textShow startKESPeriod) , "opCertKESCurrentPeriod" .= String (textShow currKESPeriod) , "opCertExpectedKESEvolutions" .= String (textShow expectedKESEvolutions) , "error" .= err ] forMachine _dtal (NoCounterForKeyHashOCERT (KeyHash stakePoolKeyHash)) = - mkObject [ "kind" .= String "NoCounterForKeyHashOCERT" + mconcat [ "kind" .= String "NoCounterForKeyHashOCERT" , "stakePoolKeyHash" .= String (textShow stakePoolKeyHash) , "error" .= String "A counter was not found for this stake pool key hash" ] @@ -910,7 +911,7 @@ instance LogFormatting (UpdnPredicateFailure crypto) where instance LogFormatting (UpecPredicateFailure era) where forMachine _dtal (NewPpFailure (UnexpectedDepositPot totalOutstanding depositPot)) = - mkObject [ "kind" .= String "UnexpectedDepositPot" + mconcat [ "kind" .= String "UnexpectedDepositPot" , "totalOutstanding" .= String (textShow totalOutstanding) , "depositPot" .= String (textShow depositPot) ] @@ -921,45 +922,45 @@ instance LogFormatting (UpecPredicateFailure era) where instance LogFormatting (Alonzo.UtxoPredicateFailure (Alonzo.AlonzoEra StandardCrypto)) where forMachine _dtal (Alonzo.BadInputsUTxO badInputs) = - mkObject [ "kind" .= String "BadInputsUTxO" + mconcat [ "kind" .= String "BadInputsUTxO" , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] forMachine _dtal (Alonzo.OutsideValidityIntervalUTxO validtyInterval slot) = - mkObject [ "kind" .= String "ExpiredUTxO" + mconcat [ "kind" .= String "ExpiredUTxO" , "validityInterval" .= validtyInterval , "slot" .= slot ] forMachine _dtal (Alonzo.MaxTxSizeUTxO txsize maxtxsize) = - mkObject [ "kind" .= String "MaxTxSizeUTxO" + mconcat [ "kind" .= String "MaxTxSizeUTxO" , "size" .= txsize , "maxSize" .= maxtxsize ] forMachine _dtal Alonzo.InputSetEmptyUTxO = - mkObject [ "kind" .= String "InputSetEmptyUTxO" ] + mconcat [ "kind" .= String "InputSetEmptyUTxO" ] forMachine _dtal (Alonzo.FeeTooSmallUTxO minfee currentFee) = - mkObject [ "kind" .= String "FeeTooSmallUTxO" + mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= currentFee ] forMachine _dtal (Alonzo.ValueNotConservedUTxO consumed produced) = - mkObject [ "kind" .= String "ValueNotConservedUTxO" + mconcat [ "kind" .= String "ValueNotConservedUTxO" , "consumed" .= consumed , "produced" .= produced , "error" .= renderValueNotConservedErr consumed produced ] forMachine _dtal (Alonzo.WrongNetwork network addrs) = - mkObject [ "kind" .= String "WrongNetwork" + mconcat [ "kind" .= String "WrongNetwork" , "network" .= network , "addrs" .= addrs ] forMachine _dtal (Alonzo.WrongNetworkWithdrawal network addrs) = - mkObject [ "kind" .= String "WrongNetworkWithdrawal" + mconcat [ "kind" .= String "WrongNetworkWithdrawal" , "network" .= network , "addrs" .= addrs ] forMachine _dtal (Alonzo.OutputTooSmallUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooSmallUTxO" + mconcat [ "kind" .= String "OutputTooSmallUTxO" , "outputs" .= badOutputs , "error" .= String "The output is smaller than the allow minimum \ \UTxO value defined in the protocol parameters" @@ -967,67 +968,67 @@ instance LogFormatting (Alonzo.UtxoPredicateFailure (Alonzo.AlonzoEra StandardCr forMachine dtal (Alonzo.UtxosFailure predFailure) = forMachine dtal predFailure forMachine _dtal (Alonzo.OutputBootAddrAttrsTooBig txouts) = - mkObject [ "kind" .= String "OutputBootAddrAttrsTooBig" + mconcat [ "kind" .= String "OutputBootAddrAttrsTooBig" , "outputs" .= txouts , "error" .= String "The Byron address attributes are too big" ] forMachine _dtal Alonzo.TriesToForgeADA = - mkObject [ "kind" .= String "TriesToForgeADA" ] + mconcat [ "kind" .= String "TriesToForgeADA" ] forMachine _dtal (Alonzo.OutputTooBigUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooBigUTxO" + mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs , "error" .= String "Too many asset ids in the tx output" ] forMachine _dtal (Alonzo.InsufficientCollateral computedBalance suppliedFee) = - mkObject [ "kind" .= String "InsufficientCollateral" + mconcat [ "kind" .= String "InsufficientCollateral" , "balance" .= computedBalance , "txfee" .= suppliedFee ] forMachine _dtal (Alonzo.ScriptsNotPaidUTxO utxos) = - mkObject [ "kind" .= String "ScriptsNotPaidUTxO" + mconcat [ "kind" .= String "ScriptsNotPaidUTxO" , "utxos" .= utxos ] forMachine _dtal (Alonzo.ExUnitsTooBigUTxO pParamsMaxExUnits suppliedExUnits) = - mkObject [ "kind" .= String "ExUnitsTooBigUTxO" + mconcat [ "kind" .= String "ExUnitsTooBigUTxO" , "maxexunits" .= pParamsMaxExUnits , "exunits" .= suppliedExUnits ] forMachine _dtal (Alonzo.CollateralContainsNonADA inputs) = - mkObject [ "kind" .= String "CollateralContainsNonADA" + mconcat [ "kind" .= String "CollateralContainsNonADA" , "inputs" .= inputs ] forMachine _dtal (Alonzo.WrongNetworkInTxBody actualNetworkId netIdInTxBody) = - mkObject [ "kind" .= String "WrongNetworkInTxBody" + mconcat [ "kind" .= String "WrongNetworkInTxBody" , "networkid" .= actualNetworkId , "txbodyNetworkId" .= netIdInTxBody ] forMachine _dtal (Alonzo.OutsideForecast slotNum) = - mkObject [ "kind" .= String "OutsideForecast" + mconcat [ "kind" .= String "OutsideForecast" , "slot" .= slotNum ] forMachine _dtal (Alonzo.TooManyCollateralInputs maxCollateralInputs numberCollateralInputs) = - mkObject [ "kind" .= String "TooManyCollateralInputs" + mconcat [ "kind" .= String "TooManyCollateralInputs" , "max" .= maxCollateralInputs , "inputs" .= numberCollateralInputs ] forMachine _dtal Alonzo.NoCollateralInputs = - mkObject [ "kind" .= String "NoCollateralInputs" ] + mconcat [ "kind" .= String "NoCollateralInputs" ] instance LogFormatting (Alonzo.UtxosPredicateFailure (Alonzo.AlonzoEra StandardCrypto)) where forMachine _ (Alonzo.ValidationTagMismatch isValidating reason) = - mkObject [ "kind" .= String "ValidationTagMismatch" + mconcat [ "kind" .= String "ValidationTagMismatch" , "isvalidating" .= isValidating , "reason" .= reason ] forMachine _ (Alonzo.CollectErrors errors) = - mkObject [ "kind" .= String "CollectErrors" + mconcat [ "kind" .= String "CollectErrors" , "errors" .= errors ] forMachine dtal (Alonzo.UpdateFailure pFailure) = forMachine dtal pFailure instance LogFormatting (AlonzoBbodyPredFail (Alonzo.AlonzoEra StandardCrypto)) where - forMachine _ err = mkObject [ "kind" .= String "AlonzoBbodyPredFail" + forMachine _ err = mconcat [ "kind" .= String "AlonzoBbodyPredFail" , "error" .= String (show err) ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Formatting.hs b/cardano-node/src/Cardano/Node/Tracing/Formatting.hs index e2aa0ef2e3d..09d680c4dd1 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Formatting.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Formatting.hs @@ -10,7 +10,7 @@ module Cardano.Node.Tracing.Formatting import Cardano.Prelude () import Data.Aeson (Value (String), toJSON, (.=)) -import Cardano.Logging (LogFormatting (..), mkObject) +import Cardano.Logging (LogFormatting (..)) import Cardano.Prelude hiding (Show, show) import Cardano.Node.Tracing.Render (renderHeaderHashForDetails) @@ -31,16 +31,16 @@ instance LogFormatting () where instance LogFormatting SlotNo where forMachine _dtal slot = - mkObject [ "kind" .= String "SlotNo" + mconcat [ "kind" .= String "SlotNo" , "slot" .= toJSON (unSlotNo slot) ] instance forall blk. ConvertRawHash blk => LogFormatting (Point blk) where forMachine _dtal GenesisPoint = - mkObject + mconcat [ "kind" .= String "GenesisPoint" ] forMachine dtal (BlockPoint slot h) = - mkObject + mconcat [ "kind" .= String "BlockPoint" , "slot" .= toJSON (unSlotNo slot) , "headerHash" .= renderHeaderHashForDetails (Proxy @blk) dtal h @@ -48,7 +48,7 @@ instance forall blk. ConvertRawHash blk instance ConvertRawHash blk => LogFormatting (RealPoint blk) where - forMachine dtal p = mkObject + forMachine dtal p = mconcat [ "kind" .= String "Point" , "slot" .= unSlotNo (realPointSlot p) , "hash" .= renderHeaderHashForDetails (Proxy @blk) dtal (realPointHash p) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs index 597676d4062..b1011b77178 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs @@ -42,7 +42,7 @@ severityReplayBlockStats _ = Info instance LogFormatting ReplayBlockStats where forMachine _dtal ReplayBlockStats {..} = - mkObject + mconcat [ "kind" .= String "ReplayBlockStats" , "progress" .= String (pack $ show rpsProgress) ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index b957f3212eb..fad36a49b90 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -17,7 +17,6 @@ module Cardano.Node.Tracing.Tracers.ChainDB import Data.Aeson (Value (String), toJSON, (.=)) import qualified Data.Aeson as A -import Data.HashMap.Strict (insertWith) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Numeric (showFFloat) @@ -52,6 +51,7 @@ import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb import Ouroboros.Consensus.Util.Condense (condense) import qualified Ouroboros.Network.AnchoredFragment as AF +import qualified Data.Aeson.KeyMap as KeyMap {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-} @@ -71,11 +71,11 @@ withAddedToCurrentChainEmptyLimited tr = do selecting _ _ = pure tr kindContext :: Text -> A.Object -> A.Object -kindContext toAdd = insertWith f "kind" (String toAdd) +kindContext toAdd = runIdentity . KeyMap.alterF f "kind" where - f (String new) (String old) = String (new <> "." <> old) - f (String new) _ = String new - f _ o = o + f Nothing = Identity $ Just (String toAdd) + f (Just (String old)) = Identity $ Just (String (toAdd <> "." <> old)) + f _ = Identity Nothing -------------------------------------------------------------------------------- -- ChainDB Tracer @@ -299,34 +299,34 @@ instance ( LogFormatting (Header blk) "Chain selection run for block previously from future: " <> renderRealPointAsPhrase pt forMachine dtal (ChainDB.IgnoreBlockOlderThanK pt) = - mkObject [ "kind" .= String "IgnoreBlockOlderThanK" + mconcat [ "kind" .= String "IgnoreBlockOlderThanK" , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.IgnoreBlockAlreadyInVolatileDB pt) = - mkObject [ "kind" .= String "IgnoreBlockAlreadyInVolatileDB" + mconcat [ "kind" .= String "IgnoreBlockAlreadyInVolatileDB" , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.IgnoreInvalidBlock pt reason) = - mkObject [ "kind" .= String "IgnoreInvalidBlock" + mconcat [ "kind" .= String "IgnoreInvalidBlock" , "block" .= forMachine dtal pt , "reason" .= showT reason ] forMachine dtal (ChainDB.AddedBlockToQueue pt sz) = - mkObject [ "kind" .= String "AddedBlockToQueue" + mconcat [ "kind" .= String "AddedBlockToQueue" , "block" .= forMachine dtal pt , "queueSize" .= toJSON sz ] forMachine dtal (ChainDB.BlockInTheFuture pt slot) = - mkObject [ "kind" .= String "BlockInTheFuture" + mconcat [ "kind" .= String "BlockInTheFuture" , "block" .= forMachine dtal pt , "slot" .= forMachine dtal slot ] forMachine dtal (ChainDB.StoreButDontChange pt) = - mkObject [ "kind" .= String "StoreButDontChange" + mconcat [ "kind" .= String "StoreButDontChange" , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.TryAddToCurrentChain pt) = - mkObject [ "kind" .= String "TryAddToCurrentChain" + mconcat [ "kind" .= String "TryAddToCurrentChain" , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.TrySwitchToAFork pt _) = - mkObject [ "kind" .= String "TraceAddBlockEvent.TrySwitchToAFork" + mconcat [ "kind" .= String "TraceAddBlockEvent.TrySwitchToAFork" , "block" .= forMachine dtal pt ] forMachine dtal (ChainDB.AddedToCurrentChain events _ base extended) = - mkObject $ + mconcat $ [ "kind" .= String "AddedToCurrentChain" , "newtip" .= renderPointForDetails dtal (AF.headPoint extended) ] @@ -335,7 +335,7 @@ instance ( LogFormatting (Header blk) ++ [ "events" .= toJSON (map (forMachine dtal) events) | not (null events) ] forMachine dtal (ChainDB.SwitchedToAFork events _ old new) = - mkObject $ + mconcat $ [ "kind" .= String "TraceAddBlockEvent.SwitchedToAFork" , "newtip" .= renderPointForDetails dtal (AF.headPoint new) ] @@ -346,11 +346,11 @@ instance ( LogFormatting (Header blk) forMachine dtal (ChainDB.AddBlockValidation ev') = kindContext "AddBlockEvent" $ forMachine dtal ev' forMachine dtal (ChainDB.AddedBlockToVolatileDB pt (BlockNo bn) _) = - mkObject [ "kind" .= String "AddedBlockToVolatileDB" + mconcat [ "kind" .= String "AddedBlockToVolatileDB" , "block" .= forMachine dtal pt , "blockNo" .= showT bn ] forMachine dtal (ChainDB.ChainSelectionForFutureBlock pt) = - mkObject [ "kind" .= String "TChainSelectionForFutureBlock" + mconcat [ "kind" .= String "TChainSelectionForFutureBlock" , "block" .= forMachine dtal pt ] asMetrics (ChainDB.SwitchedToAFork _warnings newTipInfo _oldChain newChain) = @@ -416,18 +416,18 @@ instance ( HasHeader (Header blk) showProgressT (fromIntegral atDiff) (fromIntegral toDiff) <> "%" forMachine dtal (ChainDB.InvalidBlock err pt) = - mkObject [ "kind" .= String "InvalidBlock" + mconcat [ "kind" .= String "InvalidBlock" , "block" .= forMachine dtal pt , "error" .= showT err ] forMachine dtal (ChainDB.ValidCandidate c) = - mkObject [ "kind" .= String "ValidCandidate" + mconcat [ "kind" .= String "ValidCandidate" , "block" .= renderPointForDetails dtal (AF.headPoint c) ] forMachine dtal (ChainDB.CandidateContainsFutureBlocks c hdrs) = - mkObject [ "kind" .= String "CandidateContainsFutureBlocks" + mconcat [ "kind" .= String "CandidateContainsFutureBlocks" , "block" .= renderPointForDetails dtal (AF.headPoint c) , "headers" .= map (renderPointForDetails dtal . headerPoint) hdrs ] forMachine dtal (ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs) = - mkObject [ "kind" .= String "CandidateContainsFutureBlocksExceedingClockSkew" + mconcat [ "kind" .= String "CandidateContainsFutureBlocksExceedingClockSkew" , "block" .= renderPointForDetails dtal (AF.headPoint c) , "headers" .= map (renderPointForDetails dtal . headerPoint) hdrs ] forMachine _dtal (ChainDB.UpdateLedgerDbTraceEvent @@ -435,7 +435,7 @@ instance ( HasHeader (Header blk) (LedgerDB.PushStart start) (LedgerDB.PushGoal goal) (LedgerDB.Pushing curr))) = - mkObject [ "kind" .= String "UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb" + mconcat [ "kind" .= String "UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb" , "startingBlock" .= renderRealPoint start , "currentBlock" .= renderRealPoint curr , "targetBlock" .= renderRealPoint goal @@ -687,10 +687,10 @@ instance ConvertRawHash blk "There are no blocks to copy to the ImmDB" forMachine dtals (ChainDB.CopiedBlockToImmutableDB pt) = - mkObject [ "kind" .= String "CopiedBlockToImmutableDB" + mconcat [ "kind" .= String "CopiedBlockToImmutableDB" , "slot" .= forMachine dtals pt ] forMachine _dtals ChainDB.NoBlocksToCopyToImmutableDB = - mkObject [ "kind" .= String "NoBlocksToCopyToImmutableDB" ] + mconcat [ "kind" .= String "NoBlocksToCopyToImmutableDB" ] docChainDBImmtable :: [DocMsg (ChainDB.TraceCopyToImmutableDBEvent blk)] docChainDBImmtable = [ @@ -725,10 +725,10 @@ instance LogFormatting (ChainDB.TraceGCEvent blk) where "Scheduled a garbage collection for " <> condenseT slot forMachine dtals (ChainDB.PerformedGC slot) = - mkObject [ "kind" .= String "PerformedGC" + mconcat [ "kind" .= String "PerformedGC" , "slot" .= forMachine dtals slot ] forMachine dtals (ChainDB.ScheduledGC slot difft) = - mkObject $ [ "kind" .= String "ScheduledGC" + mconcat $ [ "kind" .= String "ScheduledGC" , "slot" .= forMachine dtals slot ] <> [ "difft" .= String ((Text.pack . show) difft) | dtals >= DDetailed] @@ -790,9 +790,9 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) forMachine dtal (ChainDB.InitChainSelValidation v) = forMachine dtal v forMachine _dtal ChainDB.InitalChainSelected = - mkObject ["kind" .= String "Follower.InitalChainSelected"] + mconcat ["kind" .= String "Follower.InitalChainSelected"] forMachine _dtal ChainDB.StartedInitChainSelection = - mkObject ["kind" .= String "Follower.StartedInitChainSelection"] + mconcat ["kind" .= String "Follower.StartedInitChainSelection"] asMetrics (ChainDB.InitChainSelValidation v) = asMetrics v asMetrics ChainDB.InitalChainSelected = [] @@ -893,29 +893,29 @@ instance ConvertRawHash blk forHuman ChainDB.StartedOpeningLgrDB = "Started opening Ledger DB" forMachine dtal (ChainDB.OpenedDB immTip tip')= - mkObject [ "kind" .= String "OpenedDB" + mconcat [ "kind" .= String "OpenedDB" , "immtip" .= forMachine dtal immTip , "tip" .= forMachine dtal tip' ] forMachine dtal (ChainDB.ClosedDB immTip tip') = - mkObject [ "kind" .= String "TraceOpenEvent.ClosedDB" + mconcat [ "kind" .= String "TraceOpenEvent.ClosedDB" , "immtip" .= forMachine dtal immTip , "tip" .= forMachine dtal tip' ] forMachine dtal (ChainDB.OpenedImmutableDB immTip epoch) = - mkObject [ "kind" .= String "OpenedImmutableDB" + mconcat [ "kind" .= String "OpenedImmutableDB" , "immtip" .= forMachine dtal immTip , "epoch" .= String ((Text.pack . show) epoch) ] forMachine _dtal ChainDB.OpenedVolatileDB = - mkObject [ "kind" .= String "OpenedVolatileDB" ] + mconcat [ "kind" .= String "OpenedVolatileDB" ] forMachine _dtal ChainDB.OpenedLgrDB = - mkObject [ "kind" .= String "OpenedLgrDB" ] + mconcat [ "kind" .= String "OpenedLgrDB" ] forMachine _dtal ChainDB.StartedOpeningDB = - mkObject ["kind" .= String "StartedOpeningDB"] + mconcat ["kind" .= String "StartedOpeningDB"] forMachine _dtal ChainDB.StartedOpeningImmutableDB = - mkObject ["kind" .= String "StartedOpeningImmutableDB"] + mconcat ["kind" .= String "StartedOpeningImmutableDB"] forMachine _dtal ChainDB.StartedOpeningVolatileDB = - mkObject ["kind" .= String "StartedOpeningVolatileDB"] + mconcat ["kind" .= String "StartedOpeningVolatileDB"] forMachine _dtal ChainDB.StartedOpeningLgrDB = - mkObject ["kind" .= String "StartedOpeningLgrDB"] + mconcat ["kind" .= String "StartedOpeningLgrDB"] docChainDBOpenEvent :: [DocMsg (ChainDB.TraceOpenEvent blk)] @@ -996,40 +996,40 @@ instance ( StandardHash blk forHuman ChainDB.SwitchBackToVolatileDB = "SwitchBackToVolatileDB" forMachine _dtal (ChainDB.UnknownRangeRequested unkRange) = - mkObject [ "kind" .= String "UnknownRangeRequested" + mconcat [ "kind" .= String "UnknownRangeRequested" , "range" .= String (showT unkRange) ] forMachine _dtal (ChainDB.StreamFromVolatileDB streamFrom streamTo realPt) = - mkObject [ "kind" .= String "StreamFromVolatileDB" + mconcat [ "kind" .= String "StreamFromVolatileDB" , "from" .= String (showT streamFrom) , "to" .= String (showT streamTo) , "point" .= String (Text.pack . show $ map renderRealPoint realPt) ] forMachine _dtal (ChainDB.StreamFromImmutableDB streamFrom streamTo) = - mkObject [ "kind" .= String "StreamFromImmutableDB" + mconcat [ "kind" .= String "StreamFromImmutableDB" , "from" .= String (showT streamFrom) , "to" .= String (showT streamTo) ] forMachine _dtal (ChainDB.StreamFromBoth streamFrom streamTo realPt) = - mkObject [ "kind" .= String "StreamFromBoth" + mconcat [ "kind" .= String "StreamFromBoth" , "from" .= String (showT streamFrom) , "to" .= String (showT streamTo) , "point" .= String (Text.pack . show $ map renderRealPoint realPt) ] forMachine _dtal (ChainDB.BlockMissingFromVolatileDB realPt) = - mkObject [ "kind" .= String "BlockMissingFromVolatileDB" + mconcat [ "kind" .= String "BlockMissingFromVolatileDB" , "point" .= String (renderRealPoint realPt) ] forMachine _dtal (ChainDB.BlockWasCopiedToImmutableDB realPt) = - mkObject [ "kind" .= String "BlockWasCopiedToImmutableDB" + mconcat [ "kind" .= String "BlockWasCopiedToImmutableDB" , "point" .= String (renderRealPoint realPt) ] forMachine _dtal (ChainDB.BlockGCedFromVolatileDB realPt) = - mkObject [ "kind" .= String "BlockGCedFromVolatileDB" + mconcat [ "kind" .= String "BlockGCedFromVolatileDB" , "point" .= String (renderRealPoint realPt) ] forMachine _dtal ChainDB.SwitchBackToVolatileDB = - mkObject ["kind" .= String "SwitchBackToVolatileDB" + mconcat ["kind" .= String "SwitchBackToVolatileDB" ] instance ( StandardHash blk @@ -1043,11 +1043,11 @@ instance ( StandardHash blk <> showT streamFrom forMachine _dtal (ChainDB.MissingBlock realPt) = - mkObject [ "kind" .= String "MissingBlock" + mconcat [ "kind" .= String "MissingBlock" , "point" .= String (renderRealPoint realPt) ] forMachine _dtal (ChainDB.ForkTooOld streamFrom) = - mkObject [ "kind" .= String "ForkTooOld" + mconcat [ "kind" .= String "ForkTooOld" , "from" .= String (showT streamFrom) ] @@ -1124,14 +1124,14 @@ instance ( StandardHash blk "Invalid snapshot " <> showT snap <> showT failure forMachine dtals (LedgerDB.TookSnapshot snap pt) = - mkObject [ "kind" .= String "TookSnapshot" + mconcat [ "kind" .= String "TookSnapshot" , "snapshot" .= forMachine dtals snap , "tip" .= show pt ] forMachine dtals (LedgerDB.DeletedSnapshot snap) = - mkObject [ "kind" .= String "DeletedSnapshot" + mconcat [ "kind" .= String "DeletedSnapshot" , "snapshot" .= forMachine dtals snap ] forMachine dtals (LedgerDB.InvalidSnapshot snap failure) = - mkObject [ "kind" .= String "TraceLedgerEvent.InvalidSnapshot" + mconcat [ "kind" .= String "TraceLedgerEvent.InvalidSnapshot" , "snapshot" .= forMachine dtals snap , "failure" .= show failure ] @@ -1195,9 +1195,9 @@ instance (StandardHash blk, ConvertRawHash blk) <> "%" forMachine _dtal (LedgerDB.ReplayFromGenesis _replayTo) = - mkObject [ "kind" .= String "ReplayFromGenesis" ] + mconcat [ "kind" .= String "ReplayFromGenesis" ] forMachine dtal (LedgerDB.ReplayFromSnapshot snap tip' _ _) = - mkObject [ "kind" .= String "ReplayFromSnapshot" + mconcat [ "kind" .= String "ReplayFromSnapshot" , "snapshot" .= forMachine dtal snap , "tip" .= show tip' ] forMachine _dtal (LedgerDB.ReplayedBlock @@ -1205,7 +1205,7 @@ instance (StandardHash blk, ConvertRawHash blk) _ledgerEvents _ (LedgerDB.ReplayGoal replayTo)) = - mkObject [ "kind" .= String "ReplayedBlock" + mconcat [ "kind" .= String "ReplayedBlock" , "slot" .= unSlotNo (realPointSlot pt) , "tip" .= withOrigin 0 unSlotNo (pointSlot replayTo) ] @@ -1324,9 +1324,9 @@ namesForChainDBImmutableDBCacheEvent (ImmDB.TracePastChunksExpired {}) = instance (ConvertRawHash blk, StandardHash blk) => LogFormatting (ImmDB.TraceEvent blk) where forMachine _dtal ImmDB.NoValidLastLocation = - mkObject [ "kind" .= String "NoValidLastLocation" ] + mconcat [ "kind" .= String "NoValidLastLocation" ] forMachine _dtal (ImmDB.ValidatedLastLocation chunkNo immTip) = - mkObject [ "kind" .= String "ValidatedLastLocation" + mconcat [ "kind" .= String "ValidatedLastLocation" , "chunkNo" .= String (renderChunkNo chunkNo) , "immTip" .= String (renderTipHash immTip) , "blockNo" .= String (renderTipBlockNo immTip) @@ -1334,25 +1334,25 @@ instance (ConvertRawHash blk, StandardHash blk) forMachine dtal (ImmDB.ChunkValidationEvent traceChunkValidation) = forMachine dtal traceChunkValidation forMachine _dtal (ImmDB.DeletingAfter immTipWithInfo) = - mkObject [ "kind" .= String "DeletingAfter" + mconcat [ "kind" .= String "DeletingAfter" , "immTipHash" .= String (renderWithOrigin renderTipHash immTipWithInfo) , "immTipBlockNo" .= String (renderWithOrigin renderTipBlockNo immTipWithInfo) ] forMachine _dtal ImmDB.DBAlreadyClosed = - mkObject [ "kind" .= String "DBAlreadyClosed" ] + mconcat [ "kind" .= String "DBAlreadyClosed" ] forMachine _dtal ImmDB.DBClosed = - mkObject [ "kind" .= String "DBClosed" ] + mconcat [ "kind" .= String "DBClosed" ] forMachine dtal (ImmDB.TraceCacheEvent cacheEv) = kindContext "TraceCacheEvent" $ forMachine dtal cacheEv forMachine _dtal (ImmDB.ChunkFileDoesntFit expectPrevHash actualPrevHash) = - mkObject [ "kind" .= String "ChunkFileDoesntFit" + mconcat [ "kind" .= String "ChunkFileDoesntFit" , "expectedPrevHash" .= String (renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) expectPrevHash) , "actualPrevHash" .= String (renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) actualPrevHash) ] forMachine _dtal (ImmDB.Migrating txt) = - mkObject [ "kind" .= String "Migrating" + mconcat [ "kind" .= String "Migrating" , "info" .= String txt ] @@ -1402,83 +1402,83 @@ instance (ConvertRawHash blk, StandardHash blk) instance ConvertRawHash blk => LogFormatting (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo) where forMachine _dtal (ImmDB.RewriteSecondaryIndex chunkNo) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.RewriteSecondaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.RewriteSecondaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.RewritePrimaryIndex chunkNo) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.RewritePrimaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.RewritePrimaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.MissingPrimaryIndex chunkNo) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.MissingPrimaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingPrimaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.MissingSecondaryIndex chunkNo) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.MissingSecondaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingSecondaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.InvalidPrimaryIndex chunkNo) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidPrimaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidPrimaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.InvalidSecondaryIndex chunkNo) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidSecondaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidSecondaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrHashMismatch hashPrevBlock prevHashOfBlock)) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch" , "chunkNo" .= String (renderChunkNo chunkNo) , "hashPrevBlock" .= String (Text.decodeLatin1 . toRawHash (Proxy @blk) $ hashPrevBlock) , "prevHashOfBlock" .= String (renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) prevHashOfBlock) ] forMachine dtal (ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrCorrupt pt)) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt" , "chunkNo" .= String (renderChunkNo chunkNo) , "block" .= String (renderPointForDetails dtal pt) ] forMachine _dtal (ImmDB.ValidatedChunk chunkNo _) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.ValidatedChunk" + mconcat [ "kind" .= String "TraceImmutableDBEvent.ValidatedChunk" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.MissingChunkFile chunkNo) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.MissingChunkFile" + mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingChunkFile" , "chunkNo" .= String (renderChunkNo chunkNo) ] forMachine _dtal (ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrRead readIncErr)) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead" , "chunkNo" .= String (renderChunkNo chunkNo) , "error" .= String (showT readIncErr) ] forMachine _dtal (ImmDB.StartedValidatingChunk initialChunk finalChunk) = - mkObject [ "kind" .= String "TraceImmutableDBEvent.StartedValidatingChunk" + mconcat [ "kind" .= String "TraceImmutableDBEvent.StartedValidatingChunk" , "initialChunk" .= renderChunkNo initialChunk , "finalChunk" .= renderChunkNo finalChunk ] instance LogFormatting ImmDB.TraceCacheEvent where forMachine _dtal (ImmDB.TraceCurrentChunkHit chunkNo nbPastChunksInCache) = - mkObject [ "kind" .= String "TraceCurrentChunkHit" + mconcat [ "kind" .= String "TraceCurrentChunkHit" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] forMachine _dtal (ImmDB.TracePastChunkHit chunkNo nbPastChunksInCache) = - mkObject [ "kind" .= String "TracePastChunkHit" + mconcat [ "kind" .= String "TracePastChunkHit" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] forMachine _dtal (ImmDB.TracePastChunkMiss chunkNo nbPastChunksInCache) = - mkObject [ "kind" .= String "TracePastChunkMiss" + mconcat [ "kind" .= String "TracePastChunkMiss" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] forMachine _dtal (ImmDB.TracePastChunkEvict chunkNo nbPastChunksInCache) = - mkObject [ "kind" .= String "TracePastChunkEvict" + mconcat [ "kind" .= String "TracePastChunkEvict" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] forMachine _dtal (ImmDB.TracePastChunksExpired chunkNos nbPastChunksInCache) = - mkObject [ "kind" .= String "TracePastChunksExpired" + mconcat [ "kind" .= String "TracePastChunksExpired" , "chunkNos" .= String (Text.pack . show $ map renderChunkNo chunkNos) , "noPastChunks" .= String (showT nbPastChunksInCache) ] @@ -1592,19 +1592,19 @@ namesForChainDBVolatileDBEvent (VolDb.BlockAlreadyHere {}) = instance StandardHash blk => LogFormatting (VolDB.TraceEvent blk) where forMachine _dtal VolDB.DBAlreadyClosed = - mkObject [ "kind" .= String "DBAlreadyClosed"] + mconcat [ "kind" .= String "DBAlreadyClosed"] forMachine _dtal (VolDB.BlockAlreadyHere blockId) = - mkObject [ "kind" .= String "BlockAlreadyHere" + mconcat [ "kind" .= String "BlockAlreadyHere" , "blockId" .= String (showT blockId) ] forMachine _dtal (VolDB.Truncate pErr fsPath blockOffset) = - mkObject [ "kind" .= String "Truncate" + mconcat [ "kind" .= String "Truncate" , "parserError" .= String (showT pErr) , "file" .= String (showT fsPath) , "blockOffset" .= String (showT blockOffset) ] forMachine _dtal (VolDB.InvalidFileNames fsPaths) = - mkObject [ "kind" .= String "InvalidFileNames" + mconcat [ "kind" .= String "InvalidFileNames" , "files" .= String (Text.pack . show $ map show fsPaths) ] @@ -1638,12 +1638,12 @@ instance ( StandardHash blk ) => LogFormatting (HeaderError blk) where forMachine dtal (HeaderProtocolError err) = - mkObject + mconcat [ "kind" .= String "HeaderProtocolError" , "error" .= forMachine dtal err ] forMachine dtal (HeaderEnvelopeError err) = - mkObject + mconcat [ "kind" .= String "HeaderEnvelopeError" , "error" .= forMachine dtal err ] @@ -1653,19 +1653,19 @@ instance ( StandardHash blk ) => LogFormatting (HeaderEnvelopeError blk) where forMachine _dtal (UnexpectedBlockNo expect act) = - mkObject + mconcat [ "kind" .= String "UnexpectedBlockNo" , "expected" .= condense expect , "actual" .= condense act ] forMachine _dtal (UnexpectedSlotNo expect act) = - mkObject + mconcat [ "kind" .= String "UnexpectedSlotNo" , "expected" .= condense expect , "actual" .= condense act ] forMachine _dtal (UnexpectedPrevHash expect act) = - mkObject + mconcat [ "kind" .= String "UnexpectedPrevHash" , "expected" .= String (Text.pack $ show expect) , "actual" .= String (Text.pack $ show act) @@ -1688,44 +1688,44 @@ instance ( LogFormatting (LedgerError blk) instance LogFormatting LedgerDB.DiskSnapshot where forMachine DDetailed snap = - mkObject [ "kind" .= String "snapshot" + mconcat [ "kind" .= String "snapshot" , "snapshot" .= String (Text.pack $ show snap) ] - forMachine _ _snap = mkObject [ "kind" .= String "snapshot" ] + forMachine _ _snap = mconcat [ "kind" .= String "snapshot" ] instance (Show (PBFT.PBftVerKeyHash c)) => LogFormatting (PBFT.PBftValidationErr c) where forMachine _dtal (PBFT.PBftInvalidSignature text) = - mkObject + mconcat [ "kind" .= String "PBftInvalidSignature" , "error" .= String text ] forMachine _dtal (PBFT.PBftNotGenesisDelegate vkhash _ledgerView) = - mkObject + mconcat [ "kind" .= String "PBftNotGenesisDelegate" , "vk" .= String (Text.pack $ show vkhash) ] forMachine _dtal (PBFT.PBftExceededSignThreshold vkhash numForged) = - mkObject + mconcat [ "kind" .= String "PBftExceededSignThreshold" , "vk" .= String (Text.pack $ show vkhash) , "numForged" .= String (Text.pack (show numForged)) ] forMachine _dtal PBFT.PBftInvalidSlot = - mkObject + mconcat [ "kind" .= String "PBftInvalidSlot" ] instance (Show (PBFT.PBftVerKeyHash c)) => LogFormatting (PBFT.PBftCannotForge c) where forMachine _dtal (PBFT.PBftCannotForgeInvalidDelegation vkhash) = - mkObject + mconcat [ "kind" .= String "PBftCannotForgeInvalidDelegation" , "vk" .= String (Text.pack $ show vkhash) ] forMachine _dtal (PBFT.PBftCannotForgeThresholdExceeded numForged) = - mkObject + mconcat [ "kind" .= String "PBftCannotForgeThresholdExceeded" , "numForged" .= numForged ] @@ -1745,13 +1745,13 @@ instance (ConvertRawHash blk, StandardHash blk) => LogFormatting (ChainDB.TraceF \ stream these blocks too. Point: " <> showT point <> " slot: " <> showT slot forMachine _dtal ChainDB.NewFollower = - mkObject [ "kind" .= String "NewFollower" ] + mconcat [ "kind" .= String "NewFollower" ] forMachine _dtal (ChainDB.FollowerNoLongerInMem _) = - mkObject [ "kind" .= String "FollowerNoLongerInMem" ] + mconcat [ "kind" .= String "FollowerNoLongerInMem" ] forMachine _dtal (ChainDB.FollowerSwitchToMem _ _) = - mkObject [ "kind" .= String "FollowerSwitchToMem" ] + mconcat [ "kind" .= String "FollowerSwitchToMem" ] forMachine _dtal (ChainDB.FollowerNewImmIterator _ _) = - mkObject [ "kind" .= String "FollowerNewImmIterator" ] + mconcat [ "kind" .= String "FollowerNewImmIterator" ] instance ( ConvertRawHash blk , StandardHash blk @@ -1763,12 +1763,12 @@ instance ( ConvertRawHash blk ) => LogFormatting (ChainDB.InvalidBlockReason blk) where forMachine dtal (ChainDB.ValidationError extvalerr) = - mkObject + mconcat [ "kind" .= String "ValidationError" , "error" .= forMachine dtal extvalerr ] forMachine dtal (ChainDB.InFutureExceedsClockSkew point) = - mkObject + mconcat [ "kind" .= String "InFutureExceedsClockSkew" , "point" .= forMachine dtal point ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 076bde60bda..f846858ef60 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -110,13 +110,14 @@ import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize) import Ouroboros.Consensus.Node.Tracers import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey +import qualified Data.Aeson as Aeson instance LogFormatting a => LogFormatting (TraceLabelCreds a) where forMachine dtal (TraceLabelCreds creds a) = - mkObject [ "credentials" .= toJSON creds + mconcat [ "credentials" .= toJSON creds , "val" .= forMachine dtal a ] -- TODO Trace label creds as well @@ -130,14 +131,14 @@ instance (LogFormatting (LedgerUpdate blk), LogFormatting (LedgerWarning blk)) LedgerUpdate update -> forMachine dtal update LedgerWarning warning -> forMachine dtal warning -tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)] +tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> Aeson.Object tipToObject = \case - TipGenesis -> + TipGenesis -> mconcat [ "slot" .= toJSON (0 :: Int) , "block" .= String "genesis" , "blockNo" .= toJSON ((-1) :: Int) ] - Tip slot hash blockno -> + Tip slot hash blockno -> mconcat [ "slot" .= slot , "block" .= String (renderHeaderHash (Proxy @blk) hash) , "blockNo" .= blockno @@ -194,19 +195,19 @@ instance (Show (Header blk), ConvertRawHash blk, LedgerSupportsProtocol blk) "The client has terminated. " <> showT res forMachine _dtal (TraceDownloadedHeader h) = - mkObject $ - [ "kind" .= String "DownloadedHeader" - ] <> tipToObject (tipFromHeader h) + mconcat [ "kind" .= String "DownloadedHeader" + , tipToObject (tipFromHeader h) + ] forMachine dtal (TraceRolledBack tip) = - mkObject [ "kind" .= String "RolledBack" + mconcat [ "kind" .= String "RolledBack" , "tip" .= forMachine dtal tip ] forMachine _dtal (TraceException exc) = - mkObject [ "kind" .= String "Exception" + mconcat [ "kind" .= String "Exception" , "exception" .= String (Text.pack $ show exc) ] forMachine _dtal TraceFoundIntersection {} = - mkObject [ "kind" .= String "FoundIntersection" ] + mconcat [ "kind" .= String "FoundIntersection" ] forMachine _dtal (TraceTermination reason) = - mkObject [ "kind" .= String "Termination" + mconcat [ "kind" .= String "Termination" , "reason" .= String (Text.pack $ show reason) ] docChainSyncClientEvent :: @@ -264,29 +265,33 @@ namesForChainSyncServerEvent TraceChainSyncRollBackward {} = instance ConvertRawHash blk => LogFormatting (TraceChainSyncServerEvent blk) where forMachine _dtal (TraceChainSyncServerRead tip (AddBlock _hdr)) = - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerRead.AddBlock" - ] <> tipToObject tip + , tipToObject tip + ] forMachine _dtal (TraceChainSyncServerRead tip (RollBack _pt)) = - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerRead.RollBack" - ] <> tipToObject tip + , tipToObject tip + ] forMachine _dtal (TraceChainSyncServerReadBlocked tip (AddBlock _hdr)) = - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerReadBlocked.AddBlock" - ] <> tipToObject tip + , tipToObject tip + ] forMachine _dtal (TraceChainSyncServerReadBlocked tip (RollBack _pt)) = - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerReadBlocked.RollBack" - ] <> tipToObject tip - forMachine dtal (TraceChainSyncRollForward point) = - mkObject [ "kind" .= String "ChainSyncServerRead.RollForward" - , "point" .= forMachine dtal point + , tipToObject tip ] + forMachine dtal (TraceChainSyncRollForward point) = + mconcat [ "kind" .= String "ChainSyncServerRead.RollForward" + , "point" .= forMachine dtal point + ] forMachine dtal (TraceChainSyncRollBackward point) = - mkObject [ "kind" .= String "ChainSyncServerRead.ChainSyncRollBackward" - , "point" .= forMachine dtal point - ] + mconcat [ "kind" .= String "ChainSyncServerRead.ChainSyncRollBackward" + , "point" .= forMachine dtal point + ] asMetrics (TraceChainSyncRollForward _point) = [CounterM "cardano.node.chainSync.rollForward" Nothing] @@ -347,10 +352,10 @@ namesForBlockFetchDecision _ = [] instance (LogFormatting peer, Show peer) => LogFormatting [TraceLabelPeer peer (FetchDecision [Point header])] where - forMachine DMinimal _ = emptyObject - forMachine _ [] = mkObject + forMachine DMinimal _ = mempty + forMachine _ [] = mconcat [ "kind" .= String "EmptyPeersFetch"] - forMachine _ xs = mkObject + forMachine _ xs = mconcat [ "kind" .= String "PeersFetch" , "peers" .= toJSON (foldl' (\acc x -> forMachine DDetailed x : acc) [] xs) ] @@ -360,18 +365,18 @@ instance (LogFormatting peer, Show peer) => instance (LogFormatting peer, Show peer, LogFormatting a) => LogFormatting (TraceLabelPeer peer a) where forMachine dtal (TraceLabelPeer peerid a) = - mkObject [ "peer" .= forMachine dtal peerid ] <> forMachine dtal a + mconcat [ "peer" .= forMachine dtal peerid ] <> forMachine dtal a forHuman (TraceLabelPeer peerid a) = "Peer is " <> showT peerid <> ". " <> forHuman a asMetrics (TraceLabelPeer _peerid a) = asMetrics a instance LogFormatting (FetchDecision [Point header]) where forMachine _dtal (Left decline) = - mkObject [ "kind" .= String "FetchDecision declined" + mconcat [ "kind" .= String "FetchDecision declined" , "declined" .= String (showT decline) ] forMachine _dtal (Right results) = - mkObject [ "kind" .= String "FetchDecision results" + mconcat [ "kind" .= String "FetchDecision results" , "length" .= String (showT $ length results) ] @@ -434,21 +439,21 @@ namesForBlockFetchClient' BlockFetch.ClientTerminating {} = instance LogFormatting (BlockFetch.TraceFetchClientState header) where forMachine _dtal BlockFetch.AddedFetchRequest {} = - mkObject [ "kind" .= String "AddedFetchRequest" ] + mconcat [ "kind" .= String "AddedFetchRequest" ] forMachine _dtal BlockFetch.AcknowledgedFetchRequest {} = - mkObject [ "kind" .= String "AcknowledgedFetchRequest" ] + mconcat [ "kind" .= String "AcknowledgedFetchRequest" ] forMachine _dtal BlockFetch.SendFetchRequest {} = - mkObject [ "kind" .= String "SendFetchRequest" ] + mconcat [ "kind" .= String "SendFetchRequest" ] forMachine _dtal BlockFetch.CompletedBlockFetch {} = - mkObject [ "kind" .= String "CompletedBlockFetch" ] + mconcat [ "kind" .= String "CompletedBlockFetch" ] forMachine _dtal BlockFetch.CompletedFetchBatch {} = - mkObject [ "kind" .= String "CompletedFetchBatch" ] + mconcat [ "kind" .= String "CompletedFetchBatch" ] forMachine _dtal BlockFetch.StartedFetchBatch {} = - mkObject [ "kind" .= String "StartedFetchBatch" ] + mconcat [ "kind" .= String "StartedFetchBatch" ] forMachine _dtal BlockFetch.RejectedFetchBatch {} = - mkObject [ "kind" .= String "RejectedFetchBatch" ] + mconcat [ "kind" .= String "RejectedFetchBatch" ] forMachine _dtal BlockFetch.ClientTerminating {} = - mkObject [ "kind" .= String "ClientTerminating" ] + mconcat [ "kind" .= String "ClientTerminating" ] docBlockFetchClient :: Documented (BlockFetch.TraceLabelPeer remotePeer (BlockFetch.TraceFetchClientState (Header blk))) @@ -530,7 +535,7 @@ namesForBlockFetchServer TraceBlockFetchServerSendBlock {} = ["SendBlock"] instance ConvertRawHash blk => LogFormatting (TraceBlockFetchServerEvent blk) where forMachine _dtal (TraceBlockFetchServerSendBlock blk) = - mkObject [ "kind" .= String "BlockFetchServer" + mconcat [ "kind" .= String "BlockFetchServer" , "block" .= String (renderChainHash @blk (renderHeaderHash (Proxy @blk)) @@ -588,27 +593,27 @@ namesForTxInbound' TraceTxInboundCannotRequestMoreTxs {} = instance LogFormatting (TraceTxSubmissionInbound txid tx) where forMachine _dtal (TraceTxSubmissionCollected count) = - mkObject + mconcat [ "kind" .= String "TraceTxSubmissionCollected" , "count" .= toJSON count ] forMachine _dtal (TraceTxSubmissionProcessed processed) = - mkObject + mconcat [ "kind" .= String "TraceTxSubmissionProcessed" , "accepted" .= toJSON (ptxcAccepted processed) , "rejected" .= toJSON (ptxcRejected processed) ] forMachine _dtal TraceTxInboundTerminated = - mkObject + mconcat [ "kind" .= String "TraceTxInboundTerminated" ] forMachine _dtal (TraceTxInboundCanRequestMoreTxs count) = - mkObject + mconcat [ "kind" .= String "TraceTxInboundCanRequestMoreTxs" , "count" .= toJSON count ] forMachine _dtal (TraceTxInboundCannotRequestMoreTxs count) = - mkObject + mconcat [ "kind" .= String "TraceTxInboundCannotRequestMoreTxs" , "count" .= toJSON count ] @@ -692,25 +697,25 @@ namesForTxOutbound' TraceControlMessage {} = instance (Show txid, Show tx) => LogFormatting (TraceTxSubmissionOutbound txid tx) where forMachine DDetailed (TraceTxSubmissionOutboundRecvMsgRequestTxs txids) = - mkObject + mconcat [ "kind" .= String "TraceTxSubmissionOutboundRecvMsgRequestTxs" , "txIds" .= String (Text.pack $ show txids) ] forMachine _dtal (TraceTxSubmissionOutboundRecvMsgRequestTxs _txids) = - mkObject + mconcat [ "kind" .= String "TraceTxSubmissionOutboundRecvMsgRequestTxs" ] forMachine DDetailed (TraceTxSubmissionOutboundSendMsgReplyTxs txs) = - mkObject + mconcat [ "kind" .= String "TraceTxSubmissionOutboundSendMsgReplyTxs" , "txs" .= String (Text.pack $ show txs) ] forMachine _dtal (TraceTxSubmissionOutboundSendMsgReplyTxs _txs) = - mkObject + mconcat [ "kind" .= String "TraceTxSubmissionOutboundSendMsgReplyTxs" ] forMachine _dtal (TraceControlMessage _msg) = - mkObject + mconcat [ "kind" .= String "TraceControlMessage" ] @@ -753,7 +758,7 @@ namesForLocalTxSubmissionServer TraceReceivedTx {} = ["ReceivedTx"] instance LogFormatting (TraceLocalTxSubmissionServerEvent blk) where forMachine _dtal (TraceReceivedTx _gtx) = - mkObject [ "kind" .= String "ReceivedTx" ] + mconcat [ "kind" .= String "ReceivedTx" ] docLocalTxSubmissionServer :: Documented (TraceLocalTxSubmissionServerEvent blk) docLocalTxSubmissionServer = Documented [ @@ -786,26 +791,26 @@ instance , LedgerSupportsMempool blk ) => LogFormatting (TraceEventMempool blk) where forMachine dtal (TraceMempoolAddedTx tx _mpSzBefore mpSzAfter) = - mkObject + mconcat [ "kind" .= String "TraceMempoolAddedTx" , "tx" .= forMachine dtal (txForgetValidated tx) , "mempoolSize" .= forMachine dtal mpSzAfter ] forMachine dtal (TraceMempoolRejectedTx tx txApplyErr mpSz) = - mkObject + mconcat [ "kind" .= String "TraceMempoolRejectedTx" , "err" .= forMachine dtal txApplyErr , "tx" .= forMachine dtal tx , "mempoolSize" .= forMachine dtal mpSz ] forMachine dtal (TraceMempoolRemoveTxs txs mpSz) = - mkObject + mconcat [ "kind" .= String "TraceMempoolRemoveTxs" , "txs" .= map (forMachine dtal . txForgetValidated) txs , "mempoolSize" .= forMachine dtal mpSz ] forMachine dtal (TraceMempoolManuallyRemovedTxs txs0 txs1 mpSz) = - mkObject + mconcat [ "kind" .= String "TraceMempoolManuallyRemovedTxs" , "txsRemoved" .= txs0 , "txsInvalidated" .= map (forMachine dtal . txForgetValidated) txs1 @@ -836,7 +841,7 @@ instance instance LogFormatting MempoolSize where forMachine _dtal MempoolSize{msNumTxs, msNumBytes} = - mkObject + mconcat [ "numTxs" .= msNumTxs , "bytes" .= msNumBytes ] @@ -953,74 +958,74 @@ instance ( tx ~ GenTx blk , LogFormatting (ForgeStateUpdateError blk)) => LogFormatting (TraceForgeEvent blk) where forMachine _dtal (TraceStartLeadershipCheck slotNo) = - mkObject + mconcat [ "kind" .= String "TraceStartLeadershipCheck" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine dtal (TraceSlotIsImmutable slotNo tipPoint tipBlkNo) = - mkObject + mconcat [ "kind" .= String "TraceSlotIsImmutable" , "slot" .= toJSON (unSlotNo slotNo) , "tip" .= renderPointForDetails dtal tipPoint , "tipBlockNo" .= toJSON (unBlockNo tipBlkNo) ] forMachine _dtal (TraceBlockFromFuture currentSlot tip) = - mkObject + mconcat [ "kind" .= String "TraceBlockFromFuture" , "current slot" .= toJSON (unSlotNo currentSlot) , "tip" .= toJSON (unSlotNo tip) ] forMachine dtal (TraceBlockContext currentSlot tipBlkNo tipPoint) = - mkObject + mconcat [ "kind" .= String "TraceBlockContext" , "current slot" .= toJSON (unSlotNo currentSlot) , "tip" .= renderPointForDetails dtal tipPoint , "tipBlockNo" .= toJSON (unBlockNo tipBlkNo) ] forMachine _dtal (TraceNoLedgerState slotNo _pt) = - mkObject + mconcat [ "kind" .= String "TraceNoLedgerState" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine _dtal (TraceLedgerState slotNo _pt) = - mkObject + mconcat [ "kind" .= String "TraceLedgerState" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine _dtal (TraceNoLedgerView slotNo _) = - mkObject + mconcat [ "kind" .= String "TraceNoLedgerView" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine _dtal (TraceLedgerView slotNo) = - mkObject + mconcat [ "kind" .= String "TraceLedgerView" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine dtal (TraceForgeStateUpdateError slotNo reason) = - mkObject + mconcat [ "kind" .= String "TraceForgeStateUpdateError" , "slot" .= toJSON (unSlotNo slotNo) , "reason" .= forMachine dtal reason ] forMachine dtal (TraceNodeCannotForge slotNo reason) = - mkObject + mconcat [ "kind" .= String "TraceNodeCannotForge" , "slot" .= toJSON (unSlotNo slotNo) , "reason" .= forMachine dtal reason ] forMachine _dtal (TraceNodeNotLeader slotNo) = - mkObject + mconcat [ "kind" .= String "TraceNodeNotLeader" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine _dtal (TraceNodeIsLeader slotNo) = - mkObject + mconcat [ "kind" .= String "TraceNodeIsLeader" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine _dtal (TraceForgedBlock slotNo _ blk _) = - mkObject + mconcat [ "kind" .= String "TraceForgedBlock" , "slot" .= toJSON (unSlotNo slotNo) , "block" .= String (renderHeaderHash (Proxy @blk) $ blockHash blk) @@ -1031,18 +1036,18 @@ instance ( tx ~ GenTx blk $ blockPrevHash blk) ] forMachine _dtal (TraceDidntAdoptBlock slotNo _) = - mkObject + mconcat [ "kind" .= String "TraceDidntAdoptBlock" , "slot" .= toJSON (unSlotNo slotNo) ] forMachine dtal (TraceForgedInvalidBlock slotNo _ reason) = - mkObject + mconcat [ "kind" .= String "TraceForgedInvalidBlock" , "slot" .= toJSON (unSlotNo slotNo) , "reason" .= forMachine dtal reason ] forMachine DDetailed (TraceAdoptedBlock slotNo blk txs) = - mkObject + mconcat [ "kind" .= String "TraceAdoptedBlock" , "slot" .= toJSON (unSlotNo slotNo) , "blockHash" .= renderHeaderHashForDetails @@ -1053,7 +1058,7 @@ instance ( tx ~ GenTx blk , "txIds" .= toJSON (map (show . txId . txForgetValidated) txs) ] forMachine dtal (TraceAdoptedBlock slotNo blk _txs) = - mkObject + mconcat [ "kind" .= String "TraceAdoptedBlock" , "slot" .= toJSON (unSlotNo slotNo) , "blockHash" .= renderHeaderHashForDetails @@ -1174,7 +1179,7 @@ instance ( tx ~ GenTx blk instance LogFormatting TraceStartLeadershipCheckPlus where forMachine _dtal TraceStartLeadershipCheckPlus {..} = - mkObject [ "kind" .= String "TraceStartLeadershipCheckPlus" + mconcat [ "kind" .= String "TraceStartLeadershipCheckPlus" , "slotNo" .= toJSON (unSlotNo tsSlotNo) , "utxoSize" .= Number (fromIntegral tsUtxoSize) , "delegMapSize" .= Number (fromIntegral tsUtxoSize) @@ -1415,16 +1420,16 @@ severityBlockchainTime TraceSystemClockMovedBack {} = Warning instance Show t => LogFormatting (TraceBlockchainTimeEvent t) where forMachine _dtal (TraceStartTimeInTheFuture (SystemStart start) toWait) = - mkObject [ "kind" .= String "TStartTimeInTheFuture" + mconcat [ "kind" .= String "TStartTimeInTheFuture" , "systemStart" .= String (showT start) , "toWait" .= String (showT toWait) ] forMachine _dtal (TraceCurrentSlotUnknown time _) = - mkObject [ "kind" .= String "CurrentSlotUnknown" + mconcat [ "kind" .= String "CurrentSlotUnknown" , "time" .= String (showT time) ] forMachine _dtal (TraceSystemClockMovedBack prevTime newTime) = - mkObject [ "kind" .= String "SystemClockMovedBack" + mconcat [ "kind" .= String "SystemClockMovedBack" , "prevTime" .= String (showT prevTime) , "newTime" .= String (showT newTime) ] @@ -1496,7 +1501,7 @@ severityKeepAliveClient _ = Info instance Show remotePeer => LogFormatting (TraceKeepAliveClient remotePeer) where forMachine _dtal (AddSample peer rtt pgsv) = - mkObject + mconcat [ "kind" .= String "AddSample" , "address" .= show peer , "rtt" .= rtt diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index ea27c869e64..255855f3ff7 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -141,7 +141,7 @@ namesForMux' MuxTraceShutdown {} = ["Shutdown"] instance (LogFormatting peer, Show peer) => LogFormatting (WithMuxBearer peer MuxTrace) where forMachine dtal (WithMuxBearer b ev) = - mkObject [ "kind" .= String "MuxTrace" + mconcat [ "kind" .= String "MuxTrace" , "bearer" .= forMachine dtal b , "event" .= showT ev ] forHuman (WithMuxBearer b ev) = "With mux bearer " <> showT b @@ -332,7 +332,7 @@ namesForHandshake''' HS.MsgRefuse {} = ["Refuse"] instance LogFormatting (NtN.HandshakeTr NtN.RemoteAddress NtN.NodeToNodeVersion) where forMachine _dtal (WithMuxBearer b ev) = - mkObject [ "kind" .= String "HandshakeTrace" + mconcat [ "kind" .= String "HandshakeTrace" , "bearer" .= show b , "event" .= show ev ] forHuman (WithMuxBearer b ev) = "With mux bearer " <> showT b @@ -407,7 +407,7 @@ namesForLocalHandshake''' HS.MsgRefuse {} = ["Refuse"] instance LogFormatting (NtC.HandshakeTr NtC.LocalAddress NtC.NodeToClientVersion) where forMachine _dtal (WithMuxBearer b ev) = - mkObject [ "kind" .= String "LocalHandshakeTrace" + mconcat [ "kind" .= String "LocalHandshakeTrace" , "bearer" .= show b , "event" .= show ev ] forHuman (WithMuxBearer b ev) = "With mux bearer " <> showT b @@ -495,67 +495,67 @@ namesForDiffusionInit ND.DiffusionErrored {} = instance (Show ntnAddr, Show ntcAddr) => LogFormatting (ND.InitializationTracer ntnAddr ntcAddr) where - forMachine _dtal (ND.RunServer sockAddr) = mkObject + forMachine _dtal (ND.RunServer sockAddr) = mconcat [ "kind" .= String "RunServer" , "socketAddress" .= String (pack (show sockAddr)) ] - forMachine _dtal (ND.RunLocalServer localAddress) = mkObject + forMachine _dtal (ND.RunLocalServer localAddress) = mconcat [ "kind" .= String "RunLocalServer" , "localAddress" .= String (pack (show localAddress)) ] - forMachine _dtal (ND.UsingSystemdSocket localAddress) = mkObject + forMachine _dtal (ND.UsingSystemdSocket localAddress) = mconcat [ "kind" .= String "UsingSystemdSocket" , "path" .= String (pack . show $ localAddress) ] - forMachine _dtal (ND.CreateSystemdSocketForSnocketPath localAddress) = mkObject + forMachine _dtal (ND.CreateSystemdSocketForSnocketPath localAddress) = mconcat [ "kind" .= String "CreateSystemdSocketForSnocketPath" , "path" .= String (pack . show $ localAddress) ] - forMachine _dtal (ND.CreatedLocalSocket localAddress) = mkObject + forMachine _dtal (ND.CreatedLocalSocket localAddress) = mconcat [ "kind" .= String "CreatedLocalSocket" , "path" .= String (pack . show $ localAddress) ] - forMachine _dtal (ND.ConfiguringLocalSocket localAddress socket) = mkObject + forMachine _dtal (ND.ConfiguringLocalSocket localAddress socket) = mconcat [ "kind" .= String "ConfiguringLocalSocket" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show socket)) ] - forMachine _dtal (ND.ListeningLocalSocket localAddress socket) = mkObject + forMachine _dtal (ND.ListeningLocalSocket localAddress socket) = mconcat [ "kind" .= String "ListeningLocalSocket" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show socket)) ] - forMachine _dtal (ND.LocalSocketUp localAddress fd) = mkObject + forMachine _dtal (ND.LocalSocketUp localAddress fd) = mconcat [ "kind" .= String "LocalSocketUp" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show fd)) ] - forMachine _dtal (ND.CreatingServerSocket socket) = mkObject + forMachine _dtal (ND.CreatingServerSocket socket) = mconcat [ "kind" .= String "CreatingServerSocket" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (ND.ListeningServerSocket socket) = mkObject + forMachine _dtal (ND.ListeningServerSocket socket) = mconcat [ "kind" .= String "ListeningServerSocket" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (ND.ServerSocketUp socket) = mkObject + forMachine _dtal (ND.ServerSocketUp socket) = mconcat [ "kind" .= String "ServerSocketUp" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (ND.ConfiguringServerSocket socket) = mkObject + forMachine _dtal (ND.ConfiguringServerSocket socket) = mconcat [ "kind" .= String "ConfiguringServerSocket" , "socket" .= String (pack (show socket)) ] - forMachine _dtal (ND.UnsupportedLocalSystemdSocket path) = mkObject + forMachine _dtal (ND.UnsupportedLocalSystemdSocket path) = mconcat [ "kind" .= String "UnsupportedLocalSystemdSocket" , "path" .= String (pack (show path)) ] - forMachine _dtal ND.UnsupportedReadySocketCase = mkObject + forMachine _dtal ND.UnsupportedReadySocketCase = mconcat [ "kind" .= String "UnsupportedReadySocketCase" ] - forMachine _dtal (ND.DiffusionErrored exception) = mkObject + forMachine _dtal (ND.DiffusionErrored exception) = mconcat [ "kind" .= String "DiffusionErrored" , "path" .= String (pack (show exception)) ] @@ -653,49 +653,49 @@ namesForLedgerPeers FallingBackToBootstrapPeers {} = ["FallingBackToBootstrapPee instance LogFormatting TraceLedgerPeers where forMachine _dtal (PickedPeer addr _ackStake stake) = - mkObject + mconcat [ "kind" .= String "PickedPeer" , "address" .= show addr , "relativeStake" .= (realToFrac (unPoolStake stake) :: Double) ] forMachine _dtal (PickedPeers (NumberOfPeers n) addrs) = - mkObject + mconcat [ "kind" .= String "PickedPeers" , "desiredCount" .= n , "count" .= length addrs , "addresses" .= show addrs ] forMachine _dtal (FetchingNewLedgerState cnt) = - mkObject + mconcat [ "kind" .= String "FetchingNewLedgerState" , "numberOfPools" .= cnt ] forMachine _dtal DisabledLedgerPeers = - mkObject + mconcat [ "kind" .= String "DisabledLedgerPeers" ] forMachine _dtal (TraceUseLedgerAfter ula) = - mkObject + mconcat [ "kind" .= String "UseLedgerAfter" , "useLedgerAfter" .= UseLedger ula ] forMachine _dtal WaitingOnRequest = - mkObject + mconcat [ "kind" .= String "WaitingOnRequest" ] forMachine _dtal (RequestForPeers (NumberOfPeers np)) = - mkObject + mconcat [ "kind" .= String "RequestForPeers" , "numberOfPeers" .= np ] forMachine _dtal (ReusingLedgerState cnt age) = - mkObject + mconcat [ "kind" .= String "ReusingLedgerState" , "numberOfPools" .= cnt , "ledgerStateAge" .= age ] forMachine _dtal FallingBackToBootstrapPeers = - mkObject + mconcat [ "kind" .= String "FallingBackToBootstrapPeers" ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs index 3cba23325cd..84d8ea385e1 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs @@ -47,7 +47,7 @@ instance LogFormatting ForgeThreadStats where <> " slots missed " <> showT ftsSlotsMissedNum <> " last slot " <> showT ftsLastSlot forMachine _dtal ForgeThreadStats {..} = - mkObject [ "kind" .= String "ForgeThreadStats" + mconcat [ "kind" .= String "ForgeThreadStats" , "nodeCannotForgeNum" .= String (show ftsNodeCannotForgeNum) , "nodeIsLeaderNum" .= String (show ftsNodeIsLeaderNum) , "blocksForgedNum" .= String (show ftsBlocksForgedNum) @@ -107,7 +107,7 @@ instance LogFormatting ForgingStats where <> " blocks forged " <> showT fsBlocksForgedNum <> " slots missed " <> showT fsSlotsMissedNum forMachine _dtal ForgingStats {..} = - mkObject [ "kind" .= String "ForgingStats" + mconcat [ "kind" .= String "ForgingStats" , "nodeCannotForgeNum" .= String (show fsNodeCannotForgeNum) , "nodeIsLeaderNum" .= String (show fsNodeIsLeaderNum) , "blocksForgedNum" .= String (show fsBlocksForgedNum) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs index 053b79d4ff8..68d242e4eec 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs @@ -50,9 +50,9 @@ import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS instance LogFormatting (AnyMessageAndAgency ps) => LogFormatting (TraceSendRecv ps) where - forMachine dtal (TraceSendMsg m) = mkObject + forMachine dtal (TraceSendMsg m) = mconcat [ "kind" .= String "Send" , "msg" .= forMachine dtal m ] - forMachine dtal (TraceRecvMsg m) = mkObject + forMachine dtal (TraceRecvMsg m) = mconcat [ "kind" .= String "Recv" , "msg" .= forMachine dtal m ] forHuman (TraceSendMsg m) = "Send: " <> forHuman m @@ -111,35 +111,35 @@ namesForTChainSync (BlockFetch.TraceLabelPeer _ v) = "NodeToClient" : namesTChai instance LogFormatting (AnyMessageAndAgency (ChainSync blk pt tip)) where forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgRequestNext{}) = - mkObject [ "kind" .= String "MsgRequestNext" + mconcat [ "kind" .= String "MsgRequestNext" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgAwaitReply{}) = - mkObject [ "kind" .= String "MsgAwaitReply" + mconcat [ "kind" .= String "MsgAwaitReply" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgRollForward{}) = - mkObject [ "kind" .= String "MsgRollForward" + mconcat [ "kind" .= String "MsgRollForward" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgRollBackward{}) = - mkObject [ "kind" .= String "MsgRollBackward" + mconcat [ "kind" .= String "MsgRollBackward" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgFindIntersect{}) = - mkObject [ "kind" .= String "MsgFindIntersect" + mconcat [ "kind" .= String "MsgFindIntersect" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgIntersectFound{}) = - mkObject [ "kind" .= String "MsgIntersectFound" + mconcat [ "kind" .= String "MsgIntersectFound" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgIntersectNotFound{}) = - mkObject [ "kind" .= String "MsgIntersectNotFound" + mconcat [ "kind" .= String "MsgIntersectNotFound" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok ChainSync.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] @@ -260,47 +260,47 @@ namesForTTxMonitor (TraceLabelPeer _ v) = namesForTTxMonitor' v instance LogFormatting (AnyMessageAndAgency (LTM.LocalTxMonitor txid tx slotNo)) where forMachine _dtal (AnyMessageAndAgency stok LTM.MsgAcquire {}) = - mkObject [ "kind" .= String "MsgAcquire" + mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgAcquired {}) = - mkObject [ "kind" .= String "MsgAcquired" + mconcat [ "kind" .= String "MsgAcquired" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgAwaitAcquire {}) = - mkObject [ "kind" .= String "MsgAwaitAcquire" + mconcat [ "kind" .= String "MsgAwaitAcquire" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgNextTx {}) = - mkObject [ "kind" .= String "MsgNextTx" + mconcat [ "kind" .= String "MsgNextTx" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgReplyNextTx {}) = - mkObject [ "kind" .= String "MsgReplyNextTx" + mconcat [ "kind" .= String "MsgReplyNextTx" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgHasTx {}) = - mkObject [ "kind" .= String "MsgHasTx" + mconcat [ "kind" .= String "MsgHasTx" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgReplyHasTx {}) = - mkObject [ "kind" .= String "MsgReplyHasTx" + mconcat [ "kind" .= String "MsgReplyHasTx" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgGetSizes {}) = - mkObject [ "kind" .= String "MsgGetSizes" + mconcat [ "kind" .= String "MsgGetSizes" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgReplyGetSizes {}) = - mkObject [ "kind" .= String "MsgReplyGetSizes" + mconcat [ "kind" .= String "MsgReplyGetSizes" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgRelease {}) = - mkObject [ "kind" .= String "MsgRelease" + mconcat [ "kind" .= String "MsgRelease" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTM.MsgDone {}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] @@ -412,19 +412,19 @@ namesForTTxSubmission (BlockFetch.TraceLabelPeer _ v) = namesTTxSubmission v instance LogFormatting (AnyMessageAndAgency (LTS.LocalTxSubmission tx err)) where forMachine _dtal (AnyMessageAndAgency stok LTS.MsgSubmitTx{}) = - mkObject [ "kind" .= String "MsgSubmitTx" + mconcat [ "kind" .= String "MsgSubmitTx" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTS.MsgAcceptTx{}) = - mkObject [ "kind" .= String "MsgAcceptTx" + mconcat [ "kind" .= String "MsgAcceptTx" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTS.MsgRejectTx{}) = - mkObject [ "kind" .= String "MsgRejectTx" + mconcat [ "kind" .= String "MsgRejectTx" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LTS.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] @@ -511,35 +511,35 @@ namesForTStateQuery (BlockFetch.TraceLabelPeer _ v) = namesForTStateQuery' v instance (forall result. Show (Query blk result)) => LogFormatting (AnyMessageAndAgency (LSQ.LocalStateQuery blk pt (Query blk))) where forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgAcquire{}) = - mkObject [ "kind" .= String "MsgAcquire" + mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgAcquired{}) = - mkObject [ "kind" .= String "MsgAcquired" + mconcat [ "kind" .= String "MsgAcquired" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgFailure{}) = - mkObject [ "kind" .= String "MsgFailure" + mconcat [ "kind" .= String "MsgFailure" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgQuery{}) = - mkObject [ "kind" .= String "MsgQuery" + mconcat [ "kind" .= String "MsgQuery" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgResult{}) = - mkObject [ "kind" .= String "MsgResult" + mconcat [ "kind" .= String "MsgResult" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgRelease{}) = - mkObject [ "kind" .= String "MsgRelease" + mconcat [ "kind" .= String "MsgRelease" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgReAcquire{}) = - mkObject [ "kind" .= String "MsgReAcquire" + mconcat [ "kind" .= String "MsgReAcquire" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok LSQ.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index a5525610092..d8b22fcc5e5 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -203,14 +203,14 @@ instance ( ConvertTxId blk ) => LogFormatting (AnyMessageAndAgency (BlockFetch blk (Point blk))) where forMachine DMinimal (AnyMessageAndAgency stok (MsgBlock blk)) = - mkObject [ "kind" .= String "MsgBlock" + mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) ] forMachine dtal (AnyMessageAndAgency stok (MsgBlock blk)) = - mkObject [ "kind" .= String "MsgBlock" + mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) @@ -221,23 +221,23 @@ instance ( ConvertTxId blk presentTx = String . renderTxIdForDetails dtal . txId forMachine _v (AnyMessageAndAgency stok MsgRequestRange{}) = - mkObject [ "kind" .= String "MsgRequestRange" + mconcat [ "kind" .= String "MsgRequestRange" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgStartBatch{}) = - mkObject [ "kind" .= String "MsgStartBatch" + mconcat [ "kind" .= String "MsgStartBatch" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgNoBlocks{}) = - mkObject [ "kind" .= String "MsgNoBlocks" + mconcat [ "kind" .= String "MsgNoBlocks" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgBatchDone{}) = - mkObject [ "kind" .= String "MsgBatchDone" + mconcat [ "kind" .= String "MsgBatchDone" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgClientDone{}) = - mkObject [ "kind" .= String "MsgClientDone" + mconcat [ "kind" .= String "MsgClientDone" , "agency" .= String (pack $ show stok) ] @@ -341,14 +341,14 @@ instance ( ConvertTxId blk ) => LogFormatting (AnyMessageAndAgency (BlockFetch (Serialised blk) (Point blk))) where forMachine DMinimal (AnyMessageAndAgency stok (MsgBlock _blk)) = - mkObject [ "kind" .= String "MsgBlock" + mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) -- , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) -- , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) ] forMachine _dtal (AnyMessageAndAgency stok (MsgBlock _blk)) = - mkObject [ "kind" .= String "MsgBlock" + mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) -- , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) -- , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) @@ -359,23 +359,23 @@ instance ( ConvertTxId blk -- presentTx = String . renderTxIdForDetails dtal . txId forMachine _v (AnyMessageAndAgency stok MsgRequestRange{}) = - mkObject [ "kind" .= String "MsgRequestRange" + mconcat [ "kind" .= String "MsgRequestRange" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgStartBatch{}) = - mkObject [ "kind" .= String "MsgStartBatch" + mconcat [ "kind" .= String "MsgStartBatch" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgNoBlocks{}) = - mkObject [ "kind" .= String "MsgNoBlocks" + mconcat [ "kind" .= String "MsgNoBlocks" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgBatchDone{}) = - mkObject [ "kind" .= String "MsgBatchDone" + mconcat [ "kind" .= String "MsgBatchDone" , "agency" .= String (pack $ show stok) ] forMachine _v (AnyMessageAndAgency stok MsgClientDone{}) = - mkObject [ "kind" .= String "MsgClientDone" + mconcat [ "kind" .= String "MsgClientDone" , "agency" .= String (pack $ show stok) ] @@ -434,29 +434,29 @@ namesForTxSubmissionNode (BlockFetch.TraceLabelPeer _ v) = instance (Show txid, Show tx) => LogFormatting (AnyMessageAndAgency (STX.TxSubmission txid tx)) where forMachine _dtal (AnyMessageAndAgency stok (STX.MsgRequestTxs txids)) = - mkObject + mconcat [ "kind" .= String "MsgRequestTxs" , "agency" .= String (pack $ show stok) , "txIds" .= String (pack $ show txids) ] forMachine _dtal (AnyMessageAndAgency stok (STX.MsgReplyTxs txs)) = - mkObject + mconcat [ "kind" .= String "MsgReplyTxs" , "agency" .= String (pack $ show stok) , "txs" .= String (pack $ show txs) ] forMachine _dtal (AnyMessageAndAgency stok STX.MsgRequestTxIds {}) = - mkObject + mconcat [ "kind" .= String "MsgRequestTxIds" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok (STX.MsgReplyTxIds _)) = - mkObject + mconcat [ "kind" .= String "MsgReplyTxIds" , "agency" .= String (pack $ show stok) ] forMachine _dtal (AnyMessageAndAgency stok STX.MsgDone) = - mkObject + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] @@ -631,7 +631,7 @@ instance (Show txid, Show tx) -- function as total. stok@(ClientAgency TokHello) MsgHello) = - mkObject + mconcat [ "kind" .= String "MsgHello" , "agency" .= String (pack $ show stok) ] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs index 72089319413..ce0d5427a9e 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs @@ -56,31 +56,31 @@ import Ouroboros.Network.Subscription.Worker (ConnectResult (..), Subs instance LogFormatting NtN.RemoteAddress where forMachine _dtal (Socket.SockAddrInet port addr) = let ip = IP.fromHostAddress addr in - mkObject [ "addr" .= show ip + mconcat [ "addr" .= show ip , "port" .= show port ] forMachine _dtal (Socket.SockAddrInet6 port _ addr _) = let ip = IP.fromHostAddress6 addr in - mkObject [ "addr" .= show ip + mconcat [ "addr" .= show ip , "port" .= show port ] forMachine _dtal (Socket.SockAddrUnix path) = - mkObject [ "path" .= show path ] + mconcat [ "path" .= show path ] instance LogFormatting NtN.RemoteConnectionId where forMachine dtal (NtN.ConnectionId l r) = - mkObject [ "local" .= forMachine dtal l + mconcat [ "local" .= forMachine dtal l , "remote" .= forMachine dtal r ] instance LogFormatting LocalAddress where forMachine _dtal (LocalAddress path) = - mkObject ["path" .= path] + mconcat ["path" .= path] instance LogFormatting NtC.LocalConnectionId where forMachine dtal (NtC.ConnectionId l r) = - mkObject [ "local" .= forMachine dtal l + mconcat [ "local" .= forMachine dtal l , "remote" .= forMachine dtal r ] @@ -149,7 +149,7 @@ namesForIPSubscription(WithIPList _ _ e) = "IP" : namesForSubscription e instance LogFormatting (WithIPList (SubscriptionTrace Socket.SockAddr)) where forMachine _dtal (WithIPList localAddresses dests ev) = - mkObject [ "kind" .= String "IP SubscriptionTrace" + mconcat [ "kind" .= String "IP SubscriptionTrace" , "localAddresses" .= String (pack $ show localAddresses) , "dests" .= String (pack $ show dests) , "event" .= String (pack $ show ev)] @@ -208,7 +208,7 @@ severityDNSSubscription NtN.WithDomainName {..} = case wdnEvent of instance LogFormatting (WithDomainName (SubscriptionTrace Socket.SockAddr)) where forMachine _dtal (WithDomainName dom ev) = - mkObject [ "kind" .= String "DNS SubscriptionTrace" + mconcat [ "kind" .= String "DNS SubscriptionTrace" , "domain" .= String (pack $ show dom) , "event" .= String (pack $ show ev)] forHuman (WithDomainName dom ev) = @@ -327,7 +327,7 @@ namesForDNSResolver (NtN.WithDomainName _ ev) = case ev of instance LogFormatting (WithDomainName DnsTrace) where forMachine _dtal (WithDomainName dom ev) = - mkObject [ "kind" .= String "DnsTrace" + mconcat [ "kind" .= String "DnsTrace" , "domain" .= String (pack $ show dom) , "event" .= String (pack $ show ev)] forHuman (WithDomainName dom ev) = @@ -412,7 +412,7 @@ namesForErrorPolicy (WithAddr _ ev) = case ev of instance Show addr => LogFormatting (NtN.WithAddr addr NtN.ErrorPolicyTrace) where forMachine _dtal (NtN.WithAddr addr ev) = - mkObject [ "kind" .= String "ErrorPolicyTrace" + mconcat [ "kind" .= String "ErrorPolicyTrace" , "address" .= show addr , "event" .= show ev ] forHuman (NtN.WithAddr addr ev) = "With address " <> showT addr <> ". " <> showT ev @@ -532,16 +532,16 @@ namesForAcceptPolicy NtN.ServerTraceAcceptConnectionResume {} = instance LogFormatting NtN.AcceptConnectionsPolicyTrace where forMachine _dtal (NtN.ServerTraceAcceptConnectionRateLimiting delay numOfConnections) = - mkObject [ "kind" .= String "ServerTraceAcceptConnectionRateLimiting" + mconcat [ "kind" .= String "ServerTraceAcceptConnectionRateLimiting" , "delay" .= show delay , "numberOfConnection" .= show numOfConnections ] forMachine _dtal (NtN.ServerTraceAcceptConnectionHardLimit softLimit) = - mkObject [ "kind" .= String "ServerTraceAcceptConnectionHardLimit" + mconcat [ "kind" .= String "ServerTraceAcceptConnectionHardLimit" , "softLimit" .= show softLimit ] forMachine _dtal (NtN.ServerTraceAcceptConnectionResume numOfConnections) = - mkObject [ "kind" .= String "ServerTraceAcceptConnectionResume" + mconcat [ "kind" .= String "ServerTraceAcceptConnectionResume" , "numberOfConnection" .= show numOfConnections ] forHuman = showT diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 2db7d697d86..344ae496470 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -115,30 +115,30 @@ severityLocalRootPeers _ = Info instance (ToJSONKey ntnAddr, ToJSONKey RelayAccessPoint, Show ntnAddr, Show exception) => LogFormatting (TraceLocalRootPeers ntnAddr exception) where forMachine _dtal (TraceLocalRootDomains groups) = - mkObject [ "kind" .= String "LocalRootDomains" + mconcat [ "kind" .= String "LocalRootDomains" , "localRootDomains" .= toJSON groups ] forMachine _dtal (TraceLocalRootWaiting d dt) = - mkObject [ "kind" .= String "LocalRootWaiting" + mconcat [ "kind" .= String "LocalRootWaiting" , "domainAddress" .= toJSON d , "diffTime" .= show dt ] forMachine _dtal (TraceLocalRootResult d res) = - mkObject [ "kind" .= String "LocalRootResult" + mconcat [ "kind" .= String "LocalRootResult" , "domainAddress" .= toJSON d , "result" .= toJSONList res ] forMachine _dtal (TraceLocalRootGroups groups) = - mkObject [ "kind" .= String "LocalRootGroups" + mconcat [ "kind" .= String "LocalRootGroups" , "localRootGroups" .= toJSON groups ] forMachine _dtal (TraceLocalRootFailure d exception) = - mkObject [ "kind" .= String "LocalRootFailure" + mconcat [ "kind" .= String "LocalRootFailure" , "domainAddress" .= toJSON d , "reason" .= show exception ] forMachine _dtal (TraceLocalRootError d exception) = - mkObject [ "kind" .= String "LocalRootError" + mconcat [ "kind" .= String "LocalRootError" , "domainAddress" .= toJSON d , "reason" .= show exception ] @@ -187,20 +187,20 @@ severityPublicRootPeers _ = Info instance LogFormatting TracePublicRootPeers where forMachine _dtal (TracePublicRootRelayAccessPoint relays) = - mkObject [ "kind" .= String "PublicRootRelayAddresses" + mconcat [ "kind" .= String "PublicRootRelayAddresses" , "relayAddresses" .= toJSONList relays ] forMachine _dtal (TracePublicRootDomains domains) = - mkObject [ "kind" .= String "PublicRootDomains" + mconcat [ "kind" .= String "PublicRootDomains" , "domainAddresses" .= toJSONList domains ] forMachine _dtal (TracePublicRootResult b res) = - mkObject [ "kind" .= String "PublicRootResult" + mconcat [ "kind" .= String "PublicRootResult" , "domain" .= show b , "result" .= toJSONList res ] forMachine _dtal (TracePublicRootFailure b d) = - mkObject [ "kind" .= String "PublicRootFailure" + mconcat [ "kind" .= String "PublicRootFailure" , "domain" .= show b , "reason" .= show d ] @@ -293,63 +293,63 @@ severityPeerSelection TraceChurnMode {} = Info instance LogFormatting (TracePeerSelection SockAddr) where forMachine _dtal (TraceLocalRootPeersChanged lrp lrp') = - mkObject [ "kind" .= String "LocalRootPeersChanged" + mconcat [ "kind" .= String "LocalRootPeersChanged" , "previous" .= toJSON lrp , "current" .= toJSON lrp' ] forMachine _dtal (TraceTargetsChanged pst pst') = - mkObject [ "kind" .= String "TargetsChanged" + mconcat [ "kind" .= String "TargetsChanged" , "previous" .= toJSON pst , "current" .= toJSON pst' ] forMachine _dtal (TracePublicRootsRequest tRootPeers nRootPeers) = - mkObject [ "kind" .= String "PublicRootsRequest" + mconcat [ "kind" .= String "PublicRootsRequest" , "targetNumberOfRootPeers" .= tRootPeers , "numberOfRootPeers" .= nRootPeers ] forMachine _dtal (TracePublicRootsResults res group dt) = - mkObject [ "kind" .= String "PublicRootsResults" + mconcat [ "kind" .= String "PublicRootsResults" , "result" .= toJSONList (toList res) , "group" .= group , "diffTime" .= dt ] forMachine _dtal (TracePublicRootsFailure err group dt) = - mkObject [ "kind" .= String "PublicRootsFailure" + mconcat [ "kind" .= String "PublicRootsFailure" , "reason" .= show err , "group" .= group , "diffTime" .= dt ] forMachine _dtal (TraceGossipRequests targetKnown actualKnown aps sps) = - mkObject [ "kind" .= String "GossipRequests" + mconcat [ "kind" .= String "GossipRequests" , "targetKnown" .= targetKnown , "actualKnown" .= actualKnown , "availablePeers" .= toJSONList (toList aps) , "selectedPeers" .= toJSONList (toList sps) ] forMachine _dtal (TraceGossipResults res) = - mkObject [ "kind" .= String "GossipResults" + mconcat [ "kind" .= String "GossipResults" , "result" .= toJSONList (map ( bimap show id <$> ) res) ] forMachine _dtal (TraceForgetColdPeers targetKnown actualKnown sp) = - mkObject [ "kind" .= String "ForgeColdPeers" + mconcat [ "kind" .= String "ForgeColdPeers" , "targetKnown" .= targetKnown , "actualKnown" .= actualKnown , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TracePromoteColdPeers targetKnown actualKnown sp) = - mkObject [ "kind" .= String "PromoteColdPeers" + mconcat [ "kind" .= String "PromoteColdPeers" , "targetEstablished" .= targetKnown , "actualEstablished" .= actualKnown , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TracePromoteColdLocalPeers tLocalEst aLocalEst sp) = - mkObject [ "kind" .= String "PromoteColdLocalPeers" + mconcat [ "kind" .= String "PromoteColdLocalPeers" , "targetLocalEstablished" .= tLocalEst , "actualLocalEstablished" .= aLocalEst , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TracePromoteColdFailed tEst aEst p d err) = - mkObject [ "kind" .= String "PromoteColdFailed" + mconcat [ "kind" .= String "PromoteColdFailed" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p @@ -357,97 +357,97 @@ instance LogFormatting (TracePeerSelection SockAddr) where , "reason" .= show err ] forMachine _dtal (TracePromoteColdDone tEst aEst p) = - mkObject [ "kind" .= String "PromoteColdDone" + mconcat [ "kind" .= String "PromoteColdDone" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p ] forMachine _dtal (TracePromoteWarmPeers tActive aActive sp) = - mkObject [ "kind" .= String "PromoteWarmPeers" + mconcat [ "kind" .= String "PromoteWarmPeers" , "targetActive" .= tActive , "actualActive" .= aActive , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TracePromoteWarmLocalPeers taa sp) = - mkObject [ "kind" .= String "PromoteWarmLocalPeers" + mconcat [ "kind" .= String "PromoteWarmLocalPeers" , "targetActualActive" .= toJSONList taa , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TracePromoteWarmFailed tActive aActive p err) = - mkObject [ "kind" .= String "PromoteWarmFailed" + mconcat [ "kind" .= String "PromoteWarmFailed" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p , "reason" .= show err ] forMachine _dtal (TracePromoteWarmDone tActive aActive p) = - mkObject [ "kind" .= String "PromoteWarmDone" + mconcat [ "kind" .= String "PromoteWarmDone" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p ] forMachine _dtal (TracePromoteWarmAborted tActive aActive p) = - mkObject [ "kind" .= String "PromoteWarmAborted" + mconcat [ "kind" .= String "PromoteWarmAborted" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p ] forMachine _dtal (TraceDemoteWarmPeers tEst aEst sp) = - mkObject [ "kind" .= String "DemoteWarmPeers" + mconcat [ "kind" .= String "DemoteWarmPeers" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TraceDemoteWarmFailed tEst aEst p err) = - mkObject [ "kind" .= String "DemoteWarmFailed" + mconcat [ "kind" .= String "DemoteWarmFailed" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p , "reason" .= show err ] forMachine _dtal (TraceDemoteWarmDone tEst aEst p) = - mkObject [ "kind" .= String "DemoteWarmDone" + mconcat [ "kind" .= String "DemoteWarmDone" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p ] forMachine _dtal (TraceDemoteHotPeers tActive aActive sp) = - mkObject [ "kind" .= String "DemoteHotPeers" + mconcat [ "kind" .= String "DemoteHotPeers" , "targetActive" .= tActive , "actualActive" .= aActive , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TraceDemoteLocalHotPeers taa sp) = - mkObject [ "kind" .= String "DemoteLocalHotPeers" + mconcat [ "kind" .= String "DemoteLocalHotPeers" , "targetActualActive" .= toJSONList taa , "selectedPeers" .= toJSONList (toList sp) ] forMachine _dtal (TraceDemoteHotFailed tActive aActive p err) = - mkObject [ "kind" .= String "DemoteHotFailed" + mconcat [ "kind" .= String "DemoteHotFailed" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p , "reason" .= show err ] forMachine _dtal (TraceDemoteHotDone tActive aActive p) = - mkObject [ "kind" .= String "DemoteHotDone" + mconcat [ "kind" .= String "DemoteHotDone" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p ] forMachine _dtal (TraceDemoteAsynchronous msp) = - mkObject [ "kind" .= String "DemoteAsynchronous" + mconcat [ "kind" .= String "DemoteAsynchronous" , "state" .= toJSON msp ] forMachine _dtal TraceGovernorWakeup = - mkObject [ "kind" .= String "GovernorWakeup" + mconcat [ "kind" .= String "GovernorWakeup" ] forMachine _dtal (TraceChurnWait dt) = - mkObject [ "kind" .= String "ChurnWait" + mconcat [ "kind" .= String "ChurnWait" , "diffTime" .= toJSON dt ] forMachine _dtal (TraceChurnMode c) = - mkObject [ "kind" .= String "ChurnMode" + mconcat [ "kind" .= String "ChurnMode" , "event" .= show c ] forHuman = pack . show @@ -576,7 +576,7 @@ peerSelectionTargetsToObject targetNumberOfEstablishedPeers, targetNumberOfActivePeers } = Object $ - mkObject [ "roots" .= targetNumberOfRootPeers + mconcat [ "roots" .= targetNumberOfRootPeers , "knownPeers" .= targetNumberOfKnownPeers , "established" .= targetNumberOfEstablishedPeers , "active" .= targetNumberOfActivePeers @@ -595,18 +595,18 @@ severityDebugPeerSelection _ = Debug instance Show peerConn => LogFormatting (DebugPeerSelection SockAddr peerConn) where forMachine DNormal (TraceGovernorState blockedAt wakeupAfter PeerSelectionState { targets, knownPeers, establishedPeers, activePeers }) = - mkObject [ "kind" .= String "DebugPeerSelection" + mconcat [ "kind" .= String "DebugPeerSelection" , "blockedAt" .= String (pack $ show blockedAt) , "wakeupAfter" .= String (pack $ show wakeupAfter) , "targets" .= peerSelectionTargetsToObject targets , "numberOfPeers" .= - Object (mkObject [ "known" .= KnownPeers.size knownPeers + Object (mconcat [ "known" .= KnownPeers.size knownPeers , "established" .= EstablishedPeers.size establishedPeers , "active" .= Set.size activePeers ]) ] forMachine _ (TraceGovernorState blockedAt wakeupAfter ev) = - mkObject [ "kind" .= String "DebugPeerSelection" + mconcat [ "kind" .= String "DebugPeerSelection" , "blockedAt" .= String (pack $ show blockedAt) , "wakeupAfter" .= String (pack $ show wakeupAfter) , "peerSelectionState" .= String (pack $ show ev) @@ -629,7 +629,7 @@ severityPeerSelectionCounters _ = Info instance LogFormatting PeerSelectionCounters where forMachine _dtal ev = - mkObject [ "kind" .= String "PeerSelectionCounters" + mconcat [ "kind" .= String "PeerSelectionCounters" , "coldPeers" .= coldPeers ev , "warmPeers" .= warmPeers ev , "hotPeers" .= hotPeers ev @@ -677,21 +677,21 @@ severityPeerSelectionActions PeerMonitoringResult {} = Debug -- For that an export is needed at ouroboros-network instance LogFormatting (PeerSelectionActionsTrace SockAddr) where forMachine _dtal (PeerStatusChanged ps) = - mkObject [ "kind" .= String "PeerStatusChanged" + mconcat [ "kind" .= String "PeerStatusChanged" , "peerStatusChangeType" .= show ps ] forMachine _dtal (PeerStatusChangeFailure ps f) = - mkObject [ "kind" .= String "PeerStatusChangeFailure" + mconcat [ "kind" .= String "PeerStatusChangeFailure" , "peerStatusChangeType" .= show ps , "reason" .= show f ] forMachine _dtal (PeerMonitoringError connId s) = - mkObject [ "kind" .= String "PeerMonitoridngError" + mconcat [ "kind" .= String "PeerMonitoridngError" , "connectionId" .= toJSON connId , "reason" .= show s ] forMachine _dtal (PeerMonitoringResult connId wf) = - mkObject [ "kind" .= String "PeerMonitoringResult" + mconcat [ "kind" .= String "PeerMonitoringResult" , "connectionId" .= toJSON connId , "withProtocolTemp" .= show wf ] @@ -783,124 +783,124 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions) => LogFormatting (ConnectionManagerTrace addr (ConnectionHandlerTrace versionNumber agreedOptions)) where forMachine dtal (TrIncludeConnection prov peerAddr) = - mkObject $ reverse + mconcat $ reverse [ "kind" .= String "IncludeConnection" , "remoteAddress" .= forMachine dtal peerAddr , "provenance" .= String (pack . show $ prov) ] forMachine dtal (TrUnregisterConnection prov peerAddr) = - mkObject $ reverse + mconcat $ reverse [ "kind" .= String "UnregisterConnection" , "remoteAddress" .= forMachine dtal peerAddr , "provenance" .= String (pack . show $ prov) ] forMachine _dtal (TrConnect (Just localAddress) remoteAddress) = - mkObject + mconcat [ "kind" .= String "ConnectTo" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } ] forMachine dtal (TrConnect Nothing remoteAddress) = - mkObject + mconcat [ "kind" .= String "ConnectTo" , "remoteAddress" .= forMachine dtal remoteAddress ] forMachine _dtal (TrConnectError (Just localAddress) remoteAddress err) = - mkObject + mconcat [ "kind" .= String "ConnectError" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } , "reason" .= String (pack . show $ err) ] forMachine dtal (TrConnectError Nothing remoteAddress err) = - mkObject + mconcat [ "kind" .= String "ConnectError" , "remoteAddress" .= forMachine dtal remoteAddress , "reason" .= String (pack . show $ err) ] forMachine _dtal (TrTerminatingConnection prov connId) = - mkObject + mconcat [ "kind" .= String "TerminatingConnection" , "provenance" .= String (pack . show $ prov) , "connectionId" .= toJSON connId ] forMachine dtal (TrTerminatedConnection prov remoteAddress) = - mkObject + mconcat [ "kind" .= String "TerminatedConnection" , "provenance" .= String (pack . show $ prov) , "remoteAddress" .= forMachine dtal remoteAddress ] forMachine dtal (TrConnectionHandler connId a) = - mkObject + mconcat [ "kind" .= String "ConnectionHandler" , "connectionId" .= toJSON connId , "connectionHandler" .= forMachine dtal a ] forMachine _dtal TrShutdown = - mkObject + mconcat [ "kind" .= String "Shutdown" ] forMachine dtal (TrConnectionExists prov remoteAddress inState) = - mkObject + mconcat [ "kind" .= String "ConnectionExists" , "provenance" .= String (pack . show $ prov) , "remoteAddress" .= forMachine dtal remoteAddress , "state" .= toJSON inState ] forMachine _dtal (TrForbiddenConnection connId) = - mkObject + mconcat [ "kind" .= String "ForbiddenConnection" , "connectionId" .= toJSON connId ] forMachine _dtal (TrImpossibleConnection connId) = - mkObject + mconcat [ "kind" .= String "ImpossibleConnection" , "connectionId" .= toJSON connId ] forMachine _dtal (TrConnectionFailure connId) = - mkObject + mconcat [ "kind" .= String "ConnectionFailure" , "connectionId" .= toJSON connId ] forMachine dtal (TrConnectionNotFound prov remoteAddress) = - mkObject + mconcat [ "kind" .= String "ConnectionNotFound" , "remoteAddress" .= forMachine dtal remoteAddress , "provenance" .= String (pack . show $ prov) ] forMachine dtal (TrForbiddenOperation remoteAddress connState) = - mkObject + mconcat [ "kind" .= String "ForbiddenOperation" , "remoteAddress" .= forMachine dtal remoteAddress , "connectionState" .= toJSON connState ] forMachine dtal (TrPruneConnections pruningSet numberPruned chosenPeers) = - mkObject + mconcat [ "kind" .= String "PruneConnections" , "prunedPeers" .= toJSON pruningSet , "numberPrunedPeers" .= toJSON numberPruned , "choiceSet" .= toJSON (forMachine dtal `Set.map` chosenPeers) ] forMachine _dtal (TrConnectionCleanup connId) = - mkObject + mconcat [ "kind" .= String "ConnectionCleanup" , "connectionId" .= toJSON connId ] forMachine _dtal (TrConnectionTimeWait connId) = - mkObject + mconcat [ "kind" .= String "ConnectionTimeWait" , "connectionId" .= toJSON connId ] forMachine _dtal (TrConnectionTimeWaitDone connId) = - mkObject + mconcat [ "kind" .= String "ConnectionTimeWaitDone" , "connectionId" .= toJSON connId ] forMachine _dtal (TrConnectionManagerCounters cmCounters) = - mkObject + mconcat [ "kind" .= String "ConnectionManagerCounters" , "state" .= toJSON cmCounters ] forMachine _dtal (TrState cmState) = - mkObject + mconcat [ "kind" .= String "ConnectionManagerState" , "state" .= listValue (\(addr, connState) -> object @@ -910,7 +910,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, (Map.toList cmState) ] forMachine _dtal (ConnectionManager.TrUnexpectedlyFalseAssertion info) = - mkObject + mconcat [ "kind" .= String "UnexpectedlyFalseAssertion" , "info" .= String (pack . show $ info) ] @@ -937,23 +937,23 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) => LogFormatting (ConnectionHandlerTrace versionNumber agreedOptions) where forMachine _dtal (TrHandshakeSuccess versionNumber agreedOptions) = - mkObject + mconcat [ "kind" .= String "HandshakeSuccess" , "versionNumber" .= toJSON versionNumber , "agreedOptions" .= toJSON agreedOptions ] forMachine _dtal (TrHandshakeClientError err) = - mkObject + mconcat [ "kind" .= String "HandshakeClientError" , "reason" .= toJSON err ] forMachine _dtal (TrHandshakeServerError err) = - mkObject + mconcat [ "kind" .= String "HandshakeServerError" , "reason" .= toJSON err ] forMachine _dtal (TrError e err cerr) = - mkObject + mconcat [ "kind" .= String "Error" , "context" .= show e , "reason" .= show err @@ -1079,7 +1079,7 @@ severityConnectionManagerTransition _ = Debug instance (Show peerAddr, ToJSON peerAddr) => LogFormatting (ConnectionManager.AbstractTransitionTrace peerAddr) where forMachine _dtal (ConnectionManager.TransitionTrace peerAddr tr) = - mkObject $ reverse + mconcat $ reverse [ "kind" .= String "ConnectionManagerTransition" , "address" .= toJSON peerAddr , "from" .= toJSON (ConnectionManager.fromState tr) @@ -1120,26 +1120,26 @@ severityServer TrServerError {} = Critical instance (Show addr, LogFormatting addr, ToJSON addr) => LogFormatting (ServerTrace addr) where forMachine dtal (TrAcceptConnection peerAddr) = - mkObject [ "kind" .= String "AcceptConnection" + mconcat [ "kind" .= String "AcceptConnection" , "address" .= forMachine dtal peerAddr ] forMachine _dtal (TrAcceptError exception) = - mkObject [ "kind" .= String "AcceptErroor" + mconcat [ "kind" .= String "AcceptErroor" , "reason" .= show exception ] forMachine dtal (TrAcceptPolicyTrace policyTrace) = - mkObject [ "kind" .= String "AcceptPolicyTrace" + mconcat [ "kind" .= String "AcceptPolicyTrace" , "policy" .= forMachine dtal policyTrace ] forMachine dtal (TrServerStarted peerAddrs) = - mkObject [ "kind" .= String "AcceptPolicyTrace" + mconcat [ "kind" .= String "AcceptPolicyTrace" , "addresses" .= toJSON (forMachine dtal `map` peerAddrs) ] forMachine _dtal TrServerStopped = - mkObject [ "kind" .= String "ServerStopped" + mconcat [ "kind" .= String "ServerStopped" ] forMachine _dtal (TrServerError exception) = - mkObject [ "kind" .= String "ServerError" + mconcat [ "kind" .= String "ServerError" , "reason" .= show exception ] forHuman = pack . show @@ -1219,86 +1219,86 @@ severityInboundGovernor InboundGovernor.TrInboundGovernorError {} = Error instance (ToJSON addr, Show addr) => LogFormatting (InboundGovernorTrace addr) where forMachine _dtal (TrNewConnection p connId) = - mkObject [ "kind" .= String "NewConnection" + mconcat [ "kind" .= String "NewConnection" , "provenance" .= show p , "connectionId" .= toJSON connId ] forMachine _dtal (TrResponderRestarted connId m) = - mkObject [ "kind" .= String "ResponderStarted" + mconcat [ "kind" .= String "ResponderStarted" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] forMachine _dtal (TrResponderStartFailure connId m s) = - mkObject [ "kind" .= String "ResponderStartFailure" + mconcat [ "kind" .= String "ResponderStartFailure" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m , "reason" .= show s ] forMachine _dtal (TrResponderErrored connId m s) = - mkObject [ "kind" .= String "ResponderErrored" + mconcat [ "kind" .= String "ResponderErrored" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m , "reason" .= show s ] forMachine _dtal (TrResponderStarted connId m) = - mkObject [ "kind" .= String "ResponderStarted" + mconcat [ "kind" .= String "ResponderStarted" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] forMachine _dtal (TrResponderTerminated connId m) = - mkObject [ "kind" .= String "ResponderTerminated" + mconcat [ "kind" .= String "ResponderTerminated" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] forMachine _dtal (TrPromotedToWarmRemote connId opRes) = - mkObject [ "kind" .= String "PromotedToWarmRemote" + mconcat [ "kind" .= String "PromotedToWarmRemote" , "connectionId" .= toJSON connId , "result" .= toJSON opRes ] forMachine _dtal (TrPromotedToHotRemote connId) = - mkObject [ "kind" .= String "PromotedToHotRemote" + mconcat [ "kind" .= String "PromotedToHotRemote" , "connectionId" .= toJSON connId ] forMachine _dtal (TrDemotedToColdRemote connId od) = - mkObject [ "kind" .= String "DemotedToColdRemote" + mconcat [ "kind" .= String "DemotedToColdRemote" , "connectionId" .= toJSON connId , "result" .= show od ] forMachine _dtal (TrDemotedToWarmRemote connId) = - mkObject [ "kind" .= String "DemotedToWarmRemote" + mconcat [ "kind" .= String "DemotedToWarmRemote" , "connectionId" .= toJSON connId ] forMachine _dtal (TrWaitIdleRemote connId opRes) = - mkObject [ "kind" .= String "WaitIdleRemote" + mconcat [ "kind" .= String "WaitIdleRemote" , "connectionId" .= toJSON connId , "result" .= toJSON opRes ] forMachine _dtal (TrMuxCleanExit connId) = - mkObject [ "kind" .= String "MuxCleanExit" + mconcat [ "kind" .= String "MuxCleanExit" , "connectionId" .= toJSON connId ] forMachine _dtal (TrMuxErrored connId s) = - mkObject [ "kind" .= String "MuxErrored" + mconcat [ "kind" .= String "MuxErrored" , "connectionId" .= toJSON connId , "reason" .= show s ] forMachine _dtal (TrInboundGovernorCounters counters) = - mkObject [ "kind" .= String "InboundGovernorCounters" + mconcat [ "kind" .= String "InboundGovernorCounters" , "idlePeers" .= idlePeersRemote counters , "coldPeers" .= coldPeersRemote counters , "warmPeers" .= warmPeersRemote counters , "hotPeers" .= hotPeersRemote counters ] forMachine _dtal (TrRemoteState st) = - mkObject [ "kind" .= String "RemoteState" + mconcat [ "kind" .= String "RemoteState" , "remoteSt" .= toJSON st ] forMachine _dtal (InboundGovernor.TrUnexpectedlyFalseAssertion info) = - mkObject [ "kind" .= String "UnexpectedlyFalseAssertion" + mconcat [ "kind" .= String "UnexpectedlyFalseAssertion" , "remoteSt" .= String (pack . show $ info) ] forMachine _dtal (InboundGovernor.TrInboundGovernorError err) = - mkObject [ "kind" .= String "InboundGovernorError" + mconcat [ "kind" .= String "InboundGovernorError" , "remoteSt" .= String (pack . show $ err) ] forHuman = pack . show @@ -1453,7 +1453,7 @@ severityInboundGovernorTransition _ = Debug instance (Show peerAddr, ToJSON peerAddr) => LogFormatting (InboundGovernor.RemoteTransitionTrace peerAddr) where forMachine _dtal (InboundGovernor.TransitionTrace peerAddr tr) = - mkObject $ reverse + mconcat $ reverse [ "kind" .= String "ConnectionManagerTransition" , "address" .= toJSON peerAddr , "from" .= toJSON (ConnectionManager.fromState tr) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index d1639b24100..a679a592848 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs @@ -126,9 +126,9 @@ severityPeers :: [PeerT blk] -> SeverityS severityPeers _ = Notice instance LogFormatting [PeerT blk] where - forMachine DMinimal _ = mkObject [ "kind" .= String "NodeKernelPeers"] - forMachine _ [] = mkObject [ "kind" .= String "NodeKernelPeers"] - forMachine dtal xs = mkObject + forMachine DMinimal _ = mconcat [ "kind" .= String "NodeKernelPeers"] + forMachine _ [] = mconcat [ "kind" .= String "NodeKernelPeers"] + forMachine dtal xs = mconcat [ "kind" .= String "NodeKernelPeers" , "peers" .= toJSON (foldl' (\acc x -> forMachine dtal x : acc) [] xs) ] @@ -137,7 +137,7 @@ instance LogFormatting [PeerT blk] where instance LogFormatting (PeerT blk) where forMachine _dtal (PeerT cid _af status inflight) = - mkObject [ "peerAddress" .= String (Text.pack . show . remoteAddress $ cid) + mconcat [ "peerAddress" .= String (Text.pack . show . remoteAddress $ cid) , "peerStatus" .= String (Text.pack . ppStatus $ status) , "peerSlotNo" .= String (Text.pack . ppMaxSlotNo . peerFetchMaxSlotNo $ inflight) , "peerReqsInF" .= String (show . peerFetchReqsInFlight $ inflight) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Shutdown.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Shutdown.hs index 54ced73ac09..c08ffdab3d8 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Shutdown.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Shutdown.hs @@ -15,7 +15,7 @@ module Cardano.Node.Tracing.Tracers.Shutdown import Cardano.Logging import Cardano.Node.Handlers.Shutdown import Data.Aeson (ToJSON (..), Value (..), (.=)) -import Data.Monoid ((<>)) +import Data.Monoid (mconcat, (<>)) import Data.Text (Text, pack) import Prelude (show) @@ -53,17 +53,17 @@ instance LogFormatting ShutdownTrace where forMachine _ = \case ShutdownRequested -> - mkObject [ "kind" .= String "ShutdownRequested" ] + mconcat [ "kind" .= String "ShutdownRequested" ] AbnormalShutdown -> - mkObject [ "kind" .= String "AbnormalShutdown" ] + mconcat [ "kind" .= String "AbnormalShutdown" ] ShutdownUnexpectedInput text -> - mkObject [ "kind" .= String "AbnormalShutdown" + mconcat [ "kind" .= String "AbnormalShutdown" , "unexpected" .= String text ] RequestingShutdown reason -> - mkObject [ "kind" .= String "RequestingShutdown" + mconcat [ "kind" .= String "RequestingShutdown" , "reason" .= String reason ] ShutdownArmedAtSlot slot -> - mkObject [ "kind" .= String "ShutdownArmedAtSlot" + mconcat [ "kind" .= String "ShutdownArmedAtSlot" , "slot" .= toJSON slot ] docShutdown :: Documented ShutdownTrace diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index 5e1d179b143..102e25fc33f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -148,7 +148,7 @@ instance ( Show (BlockNodeToNodeVersion blk) localSocket supportedNodeToNodeVersions supportedNodeToClientVersions) - = mkObject ( + = mconcat ( [ "kind" .= String "StartupInfo" , "nodeAddresses" .= toJSON (map ppN2NSocketInfo addresses) , "localSocket" .= case localSocket of @@ -174,10 +174,10 @@ instance ( Show (BlockNodeToNodeVersion blk) Just (v, _) -> String (pack . show $ v) ]) forMachine _dtal (StartupP2PInfo diffusionMode) = - mkObject [ "kind" .= String "StartupP2PInfo" + mconcat [ "kind" .= String "StartupP2PInfo" , "diffusionMode" .= String (showT diffusionMode) ] forMachine _dtal (StartupTime time) = - mkObject [ "kind" .= String "StartupTime" + mconcat [ "kind" .= String "StartupTime" , "startupTime" .= String ( showT . (ceiling :: POSIXTime -> Int) . utcTimeToPOSIXSeconds @@ -185,54 +185,54 @@ instance ( Show (BlockNodeToNodeVersion blk) ) ] forMachine _dtal (StartupNetworkMagic networkMagic) = - mkObject [ "kind" .= String "StartupNetworkMagic" + mconcat [ "kind" .= String "StartupNetworkMagic" , "networkMagic" .= String (showT . unNetworkMagic $ networkMagic) ] forMachine _dtal (StartupSocketConfigError err) = - mkObject [ "kind" .= String "StartupSocketConfigError" + mconcat [ "kind" .= String "StartupSocketConfigError" , "error" .= String (showT err) ] forMachine _dtal StartupDBValidation = - mkObject [ "kind" .= String "StartupDBValidation" + mconcat [ "kind" .= String "StartupDBValidation" , "message" .= String "start db validation" ] forMachine _dtal NetworkConfigUpdate = - mkObject [ "kind" .= String "NetworkConfigUpdate" + mconcat [ "kind" .= String "NetworkConfigUpdate" , "message" .= String "ntework configuration update" ] forMachine _dtal (NetworkConfigUpdateError err) = - mkObject [ "kind" .= String "NetworkConfigUpdateError" + mconcat [ "kind" .= String "NetworkConfigUpdateError" , "error" .= String err ] forMachine _dtal (NetworkConfig localRoots publicRoots useLedgerAfter) = - mkObject [ "kind" .= String "NetworkConfig" + mconcat [ "kind" .= String "NetworkConfig" , "localRoots" .= toJSON localRoots , "publicRoots" .= toJSON publicRoots , "useLedgerAfter" .= UseLedger useLedgerAfter ] forMachine _dtal P2PWarning = - mkObject [ "kind" .= String "P2PWarning" + mconcat [ "kind" .= String "P2PWarning" , "message" .= String p2pWarningMessage ] forMachine _dtal P2PWarningDevelopementNetworkProtocols = - mkObject [ "kind" .= String "P2PWarningDevelopementNetworkProtocols" + mconcat [ "kind" .= String "P2PWarningDevelopementNetworkProtocols" , "message" .= String p2pWarningDevelopmentNetworkProtocolsMessage ] forMachine _ver (WarningDevelopmentNetworkProtocols ntnVersions ntcVersions) = - mkObject [ "kind" .= String "WarningDevelopmentNetworkProtocols" + mconcat [ "kind" .= String "WarningDevelopmentNetworkProtocols" , "message" .= String "enabled development network protocols" , "nodeToNodeDevelopmentVersions" .= String (showT ntnVersions) , "nodeToClientDevelopmentVersions" .= String (showT ntcVersions) ] forMachine _dtal (BINetwork BasicInfoNetwork {..}) = - mkObject [ "kind" .= String "BasicInfoNetwork" + mconcat [ "kind" .= String "BasicInfoNetwork" , "addresses" .= String (showT niAddresses) , "diffusionMode" .= String (showT niDiffusionMode) , "dnsProducers" .= String (showT niDnsProducers) , "ipProducers" .= String (showT niIpProducers) ] forMachine _dtal (BIByron BasicInfoByron {..}) = - mkObject [ "kind" .= String "BasicInfoByron" + mconcat [ "kind" .= String "BasicInfoByron" , "systemStartTime" .= String (showT bibSystemStartTime) , "slotLength" .= String (showT bibSlotLength) , "epochLength" .= String (showT bibEpochLength) ] forMachine _dtal (BIShelley BasicInfoShelleyBased {..}) = - mkObject [ "kind" .= String "BasicInfoShelleyBased" + mconcat [ "kind" .= String "BasicInfoShelleyBased" , "era" .= String bisEra , "systemStartTime" .= String (showT bisSystemStartTime) , "slotLength" .= String (showT bisSlotLength) @@ -240,7 +240,7 @@ instance ( Show (BlockNodeToNodeVersion blk) , "slotsPerKESPeriod" .= String (showT bisSlotsPerKESPeriod) ] forMachine _dtal (BICommon BasicInfoCommon {..}) = - mkObject [ "kind" .= String "BasicInfoCommon" + mconcat [ "kind" .= String "BasicInfoCommon" , "configPath" .= String (pack biConfigPath) , "networkMagic" .= String (showT biNetworkMagic) , "protocol" .= String biProtocol diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index 257477dd1d5..113bacebaae 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -32,6 +32,7 @@ import Generic.Data (gmappend) import Cardano.BM.Tracing (TracingVerbosity (..)) import Cardano.Node.Orphans () +import qualified Data.Aeson.Key as Aeson data TraceOptions @@ -606,7 +607,7 @@ proxyLastToEither name (Last x) = maybe (Left $ "Default value not specified for " <> proxyName name) Right x parseTracer :: KnownSymbol name => Proxy name -> Object -> Parser (Last (OnOff name)) -parseTracer p obj = Last <$> obj .:? proxyName p +parseTracer p obj = Last <$> obj .:? Aeson.fromText (proxyName p) lastToEither :: String -> Last a -> Either String a lastToEither errMsg (Last x) = maybe (Left errMsg) Right x diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs index 8df43c06c43..02e0c07c812 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs @@ -45,36 +45,36 @@ import Cardano.Crypto.Signing (VerificationKey) instance ToObject ApplyMempoolPayloadErr where toObject _verb (MempoolTxErr utxoValidationErr) = - mkObject + mconcat [ "kind" .= String "MempoolTxErr" , "error" .= String (show utxoValidationErr) ] toObject _verb (MempoolDlgErr delegScheduleError) = - mkObject + mconcat [ "kind" .= String "MempoolDlgErr" , "error" .= String (show delegScheduleError) ] toObject _verb (MempoolUpdateProposalErr iFaceErr) = - mkObject + mconcat [ "kind" .= String "MempoolUpdateProposalErr" , "error" .= String (show iFaceErr) ] toObject _verb (MempoolUpdateVoteErr iFaceErrr) = - mkObject + mconcat [ "kind" .= String "MempoolUpdateVoteErr" , "error" .= String (show iFaceErrr) ] instance ToObject ByronLedgerUpdate where toObject verb (ByronUpdatedProtocolUpdates protocolUpdates) = - mkObject + mconcat [ "kind" .= String "ByronUpdatedProtocolUpdates" , "protocolUpdates" .= map (toObject verb) protocolUpdates ] instance ToObject ProtocolUpdate where toObject verb (ProtocolUpdate updateVersion updateState) = - mkObject + mconcat [ "kind" .= String "ProtocolUpdate" , "protocolUpdateVersion" .= updateVersion , "protocolUpdateState" .= toObject verb updateState @@ -83,39 +83,39 @@ instance ToObject ProtocolUpdate where instance ToObject UpdateState where toObject _verb updateState = case updateState of UpdateRegistered slot -> - mkObject + mconcat [ "kind" .= String "UpdateRegistered" , "slot" .= slot ] UpdateActive votes -> - mkObject + mconcat [ "kind" .= String "UpdateActive" , "votes" .= map (Text.pack . show) (Set.toList votes) ] UpdateConfirmed slot -> - mkObject + mconcat [ "kind" .= String "UpdateConfirmed" , "slot" .= slot ] UpdateStablyConfirmed endorsements -> - mkObject + mconcat [ "kind" .= String "UpdateStablyConfirmed" , "endorsements" .= map (Text.pack . show) (Set.toList endorsements) ] UpdateCandidate slot epoch -> - mkObject + mconcat [ "kind" .= String "UpdateCandidate" , "slot" .= slot , "epoch" .= epoch ] UpdateStableCandidate transitionEpoch -> - mkObject + mconcat [ "kind" .= String "UpdateStableCandidate" , "transitionEpoch" .= transitionEpoch ] instance ToObject (GenTx ByronBlock) where - toObject _ tx = mkObject [ "txid" .= Text.take 8 (renderTxId (txId tx)) ] + toObject _ tx = mconcat [ "txid" .= Text.take 8 (renderTxId (txId tx)) ] instance ToJSON (TxId (GenTx ByronBlock)) where @@ -124,73 +124,73 @@ instance ToJSON (TxId (GenTx ByronBlock)) where instance ToObject ChainValidationError where toObject _verb ChainValidationBoundaryTooLarge = - mkObject + mconcat [ "kind" .= String "ChainValidationBoundaryTooLarge" ] toObject _verb ChainValidationBlockAttributesTooLarge = - mkObject + mconcat [ "kind" .= String "ChainValidationBlockAttributesTooLarge" ] toObject _verb (ChainValidationBlockTooLarge _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationBlockTooLarge" ] toObject _verb ChainValidationHeaderAttributesTooLarge = - mkObject + mconcat [ "kind" .= String "ChainValidationHeaderAttributesTooLarge" ] toObject _verb (ChainValidationHeaderTooLarge _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationHeaderTooLarge" ] toObject _verb (ChainValidationDelegationPayloadError err) = - mkObject + mconcat [ "kind" .= String err ] toObject _verb (ChainValidationInvalidDelegation _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationInvalidDelegation" ] toObject _verb (ChainValidationGenesisHashMismatch _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationGenesisHashMismatch" ] toObject _verb (ChainValidationExpectedGenesisHash _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationExpectedGenesisHash" ] toObject _verb (ChainValidationExpectedHeaderHash _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationExpectedHeaderHash" ] toObject _verb (ChainValidationInvalidHash _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationInvalidHash" ] toObject _verb (ChainValidationMissingHash _) = - mkObject + mconcat [ "kind" .= String "ChainValidationMissingHash" ] toObject _verb (ChainValidationUnexpectedGenesisHash _) = - mkObject + mconcat [ "kind" .= String "ChainValidationUnexpectedGenesisHash" ] toObject _verb (ChainValidationInvalidSignature _) = - mkObject + mconcat [ "kind" .= String "ChainValidationInvalidSignature" ] toObject _verb (ChainValidationDelegationSchedulingError _) = - mkObject + mconcat [ "kind" .= String "ChainValidationDelegationSchedulingError" ] toObject _verb (ChainValidationProtocolMagicMismatch _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationProtocolMagicMismatch" ] toObject _verb ChainValidationSignatureLight = - mkObject + mconcat [ "kind" .= String "ChainValidationSignatureLight" ] toObject _verb (ChainValidationTooManyDelegations _) = - mkObject + mconcat [ "kind" .= String "ChainValidationTooManyDelegations" ] toObject _verb (ChainValidationUpdateError _ _) = - mkObject + mconcat [ "kind" .= String "ChainValidationUpdateError" ] toObject _verb (ChainValidationUTxOValidationError _) = - mkObject + mconcat [ "kind" .= String "ChainValidationUTxOValidationError" ] toObject _verb (ChainValidationProofValidationError _) = - mkObject + mconcat [ "kind" .= String "ChainValidationProofValidationError" ] instance ToObject (Header ByronBlock) where toObject _verb b = - mkObject $ + mconcat $ [ "kind" .= String "ByronBlock" , "hash" .= condense (blockHash b) , "slotNo" .= condense (blockSlot b) @@ -208,7 +208,7 @@ instance ToObject (Header ByronBlock) where instance ToObject ByronOtherHeaderEnvelopeError where toObject _verb (UnexpectedEBBInSlot slot) = - mkObject + mconcat [ "kind" .= String "UnexpectedEBBInSlot" , "slot" .= slot ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 7dc4251a48d..d631fdfd611 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -74,6 +74,7 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB +import qualified Data.Aeson as Aeson {- HLINT ignore "Use const" -} @@ -392,9 +393,9 @@ instance HasSeverityAnnotation a => HasSeverityAnnotation (Consensus.TraceLabelC instance ToObject a => ToObject (Consensus.TraceLabelCreds a) where toObject verb (Consensus.TraceLabelCreds creds val) = - mkObject [ "credentials" .= toJSON creds - , "val" .= toObject verb val - ] + mconcat [ "credentials" .= toJSON creds + , "val" .= toObject verb val + ] instance (HasPrivacyAnnotation a, HasSeverityAnnotation a, ToObject a) => Transformable Text IO (Consensus.TraceLabelCreds a) where @@ -629,7 +630,7 @@ instance ( ConvertRawHash blk instance ToObject BFT.BftValidationErr where toObject _verb (BFT.BftInvalidSignature err) = - mkObject + mconcat [ "kind" .= String "BftInvalidSignature" , "error" .= String (pack err) ] @@ -637,9 +638,9 @@ instance ToObject BFT.BftValidationErr where instance ToObject LedgerDB.DiskSnapshot where toObject MinimalVerbosity snap = toObject NormalVerbosity snap - toObject NormalVerbosity _ = mkObject [ "kind" .= String "snapshot" ] + toObject NormalVerbosity _ = mconcat [ "kind" .= String "snapshot" ] toObject MaximalVerbosity snap = - mkObject [ "kind" .= String "snapshot" + mconcat [ "kind" .= String "snapshot" , "snapshot" .= String (pack $ show snap) ] @@ -657,19 +658,19 @@ instance ( StandardHash blk ) => ToObject (HeaderEnvelopeError blk) where toObject _verb (UnexpectedBlockNo expect act) = - mkObject + mconcat [ "kind" .= String "UnexpectedBlockNo" , "expected" .= condense expect , "actual" .= condense act ] toObject _verb (UnexpectedSlotNo expect act) = - mkObject + mconcat [ "kind" .= String "UnexpectedSlotNo" , "expected" .= condense expect , "actual" .= condense act ] toObject _verb (UnexpectedPrevHash expect act) = - mkObject + mconcat [ "kind" .= String "UnexpectedPrevHash" , "expected" .= String (pack $ show expect) , "actual" .= String (pack $ show act) @@ -684,12 +685,12 @@ instance ( StandardHash blk ) => ToObject (HeaderError blk) where toObject verb (HeaderProtocolError err) = - mkObject + mconcat [ "kind" .= String "HeaderProtocolError" , "error" .= toObject verb err ] toObject verb (HeaderEnvelopeError err) = - mkObject + mconcat [ "kind" .= String "HeaderEnvelopeError" , "error" .= toObject verb err ] @@ -702,12 +703,12 @@ instance ( ConvertRawHash blk , ToObject (ValidationErr (BlockProtocol blk))) => ToObject (ChainDB.InvalidBlockReason blk) where toObject verb (ChainDB.ValidationError extvalerr) = - mkObject + mconcat [ "kind" .= String "ValidationError" , "error" .= toObject verb extvalerr ] toObject verb (ChainDB.InFutureExceedsClockSkew point) = - mkObject + mconcat [ "kind" .= String "InFutureExceedsClockSkew" , "point" .= toObject verb point ] @@ -716,23 +717,23 @@ instance ( ConvertRawHash blk instance (Show (PBFT.PBftVerKeyHash c)) => ToObject (PBFT.PBftValidationErr c) where toObject _verb (PBFT.PBftInvalidSignature text) = - mkObject + mconcat [ "kind" .= String "PBftInvalidSignature" , "error" .= String text ] toObject _verb (PBFT.PBftNotGenesisDelegate vkhash _ledgerView) = - mkObject + mconcat [ "kind" .= String "PBftNotGenesisDelegate" , "vk" .= String (pack $ show vkhash) ] toObject _verb (PBFT.PBftExceededSignThreshold vkhash numForged) = - mkObject + mconcat [ "kind" .= String "PBftExceededSignThreshold" , "vk" .= String (pack $ show vkhash) , "numForged" .= String (pack (show numForged)) ] toObject _verb PBFT.PBftInvalidSlot = - mkObject + mconcat [ "kind" .= String "PBftInvalidSlot" ] @@ -740,12 +741,12 @@ instance (Show (PBFT.PBftVerKeyHash c)) instance (Show (PBFT.PBftVerKeyHash c)) => ToObject (PBFT.PBftCannotForge c) where toObject _verb (PBFT.PBftCannotForgeInvalidDelegation vkhash) = - mkObject + mconcat [ "kind" .= String "PBftCannotForgeInvalidDelegation" , "vk" .= String (pack $ show vkhash) ] toObject _verb (PBFT.PBftCannotForgeThresholdExceeded numForged) = - mkObject + mconcat [ "kind" .= String "PBftCannotForgeThresholdExceeded" , "numForged" .= numForged ] @@ -753,7 +754,7 @@ instance (Show (PBFT.PBftVerKeyHash c)) instance ConvertRawHash blk => ToObject (RealPoint blk) where - toObject verb p = mkObject + toObject verb p = mconcat [ "kind" .= String "Point" , "slot" .= unSlotNo (realPointSlot p) , "hash" .= renderHeaderHashForVerbosity (Proxy @blk) verb (realPointHash p) ] @@ -773,34 +774,34 @@ instance ( ConvertRawHash blk => ToObject (ChainDB.TraceEvent blk) where toObject verb (ChainDB.TraceAddBlockEvent ev) = case ev of ChainDB.IgnoreBlockOlderThanK pt -> - mkObject [ "kind" .= String "TraceAddBlockEvent.IgnoreBlockOlderThanK" + mconcat [ "kind" .= String "TraceAddBlockEvent.IgnoreBlockOlderThanK" , "block" .= toObject verb pt ] ChainDB.IgnoreBlockAlreadyInVolatileDB pt -> - mkObject [ "kind" .= String "TraceAddBlockEvent.IgnoreBlockAlreadyInVolatileDB" + mconcat [ "kind" .= String "TraceAddBlockEvent.IgnoreBlockAlreadyInVolatileDB" , "block" .= toObject verb pt ] ChainDB.IgnoreInvalidBlock pt reason -> - mkObject [ "kind" .= String "TraceAddBlockEvent.IgnoreInvalidBlock" + mconcat [ "kind" .= String "TraceAddBlockEvent.IgnoreInvalidBlock" , "block" .= toObject verb pt , "reason" .= show reason ] ChainDB.AddedBlockToQueue pt sz -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddedBlockToQueue" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddedBlockToQueue" , "block" .= toObject verb pt , "queueSize" .= toJSON sz ] ChainDB.BlockInTheFuture pt slot -> - mkObject [ "kind" .= String "TraceAddBlockEvent.BlockInTheFuture" + mconcat [ "kind" .= String "TraceAddBlockEvent.BlockInTheFuture" , "block" .= toObject verb pt , "slot" .= toObject verb slot ] ChainDB.StoreButDontChange pt -> - mkObject [ "kind" .= String "TraceAddBlockEvent.StoreButDontChange" + mconcat [ "kind" .= String "TraceAddBlockEvent.StoreButDontChange" , "block" .= toObject verb pt ] ChainDB.TryAddToCurrentChain pt -> - mkObject [ "kind" .= String "TraceAddBlockEvent.TryAddToCurrentChain" + mconcat [ "kind" .= String "TraceAddBlockEvent.TryAddToCurrentChain" , "block" .= toObject verb pt ] ChainDB.TrySwitchToAFork pt _ -> - mkObject [ "kind" .= String "TraceAddBlockEvent.TrySwitchToAFork" + mconcat [ "kind" .= String "TraceAddBlockEvent.TrySwitchToAFork" , "block" .= toObject verb pt ] ChainDB.AddedToCurrentChain events _ base extended -> - mkObject $ + mconcat $ [ "kind" .= String "TraceAddBlockEvent.AddedToCurrentChain" , "newtip" .= renderPointForVerbosity verb (AF.headPoint extended) , "chainLengthDelta" .= extended `chainLengthΔ` base @@ -810,7 +811,7 @@ instance ( ConvertRawHash blk ++ [ "events" .= toJSON (map (toObject verb) events) | not (null events) ] ChainDB.SwitchedToAFork events _ old new -> - mkObject $ + mconcat $ [ "kind" .= String "TraceAddBlockEvent.SwitchedToAFork" , "newtip" .= renderPointForVerbosity verb (AF.headPoint new) , "chainLengthDelta" .= new `chainLengthΔ` old @@ -823,33 +824,33 @@ instance ( ConvertRawHash blk | not (null events) ] ChainDB.AddBlockValidation ev' -> case ev' of ChainDB.InvalidBlock err pt -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.InvalidBlock" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.InvalidBlock" , "block" .= toObject verb pt , "error" .= show err ] ChainDB.ValidCandidate c -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.ValidCandidate" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.ValidCandidate" , "block" .= renderPointForVerbosity verb (AF.headPoint c) ] ChainDB.CandidateContainsFutureBlocks c hdrs -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocks" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocks" , "block" .= renderPointForVerbosity verb (AF.headPoint c) , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocksExceedingClockSkew" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocksExceedingClockSkew" , "block" .= renderPointForVerbosity verb (AF.headPoint c) , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart start) (LedgerDB.PushGoal goal) (LedgerDB.Pushing curr)) -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDb" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDb" , "startingBlock" .= renderRealPoint start , "currentBlock" .= renderRealPoint curr , "targetBlock" .= renderRealPoint goal ] ChainDB.AddedBlockToVolatileDB pt (BlockNo bn) _ -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddedBlockToVolatileDB" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddedBlockToVolatileDB" , "block" .= toObject verb pt , "blockNo" .= show bn ] ChainDB.ChainSelectionForFutureBlock pt -> - mkObject [ "kind" .= String "TraceAddBlockEvent.ChainSelectionForFutureBlock" + mconcat [ "kind" .= String "TraceAddBlockEvent.ChainSelectionForFutureBlock" , "block" .= toObject verb pt ] where addedHdrsNewChain @@ -863,108 +864,108 @@ instance ( ConvertRawHash blk Nothing -> [] -- No sense to do validation here. chainLengthΔ :: AF.AnchoredFragment (Header blk) -> AF.AnchoredFragment (Header blk) -> Int chainLengthΔ = on (-) (fromWithOrigin (-1) . fmap (fromIntegral . unBlockNo) . AF.headBlockNo) - toObject MinimalVerbosity (ChainDB.TraceLedgerReplayEvent _ev) = emptyObject -- no output + toObject MinimalVerbosity (ChainDB.TraceLedgerReplayEvent _ev) = mempty -- no output toObject verb (ChainDB.TraceLedgerReplayEvent ev) = case ev of LedgerDB.ReplayFromGenesis _replayTo -> - mkObject [ "kind" .= String "TraceLedgerReplayEvent.ReplayFromGenesis" ] + mconcat [ "kind" .= String "TraceLedgerReplayEvent.ReplayFromGenesis" ] LedgerDB.ReplayFromSnapshot snap tip' _replayFrom _replayTo -> - mkObject [ "kind" .= String "TraceLedgerReplayEvent.ReplayFromSnapshot" + mconcat [ "kind" .= String "TraceLedgerReplayEvent.ReplayFromSnapshot" , "snapshot" .= toObject verb snap , "tip" .= show tip' ] LedgerDB.ReplayedBlock pt _ledgerEvents _ (LedgerDB.ReplayGoal replayTo) -> - mkObject [ "kind" .= String "TraceLedgerReplayEvent.ReplayedBlock" + mconcat [ "kind" .= String "TraceLedgerReplayEvent.ReplayedBlock" , "slot" .= unSlotNo (realPointSlot pt) , "tip" .= withOrigin 0 unSlotNo (pointSlot replayTo) ] - toObject MinimalVerbosity (ChainDB.TraceLedgerEvent _ev) = emptyObject -- no output + toObject MinimalVerbosity (ChainDB.TraceLedgerEvent _ev) = mempty -- no output toObject verb (ChainDB.TraceLedgerEvent ev) = case ev of LedgerDB.TookSnapshot snap pt -> - mkObject [ "kind" .= String "TraceLedgerEvent.TookSnapshot" + mconcat [ "kind" .= String "TraceLedgerEvent.TookSnapshot" , "snapshot" .= toObject verb snap , "tip" .= show pt ] LedgerDB.DeletedSnapshot snap -> - mkObject [ "kind" .= String "TraceLedgerEvent.DeletedSnapshot" + mconcat [ "kind" .= String "TraceLedgerEvent.DeletedSnapshot" , "snapshot" .= toObject verb snap ] LedgerDB.InvalidSnapshot snap failure -> - mkObject [ "kind" .= String "TraceLedgerEvent.InvalidSnapshot" + mconcat [ "kind" .= String "TraceLedgerEvent.InvalidSnapshot" , "snapshot" .= toObject verb snap , "failure" .= show failure ] toObject verb (ChainDB.TraceCopyToImmutableDBEvent ev) = case ev of ChainDB.CopiedBlockToImmutableDB pt -> - mkObject [ "kind" .= String "TraceCopyToImmutableDBEvent.CopiedBlockToImmutableDB" + mconcat [ "kind" .= String "TraceCopyToImmutableDBEvent.CopiedBlockToImmutableDB" , "slot" .= toObject verb pt ] ChainDB.NoBlocksToCopyToImmutableDB -> - mkObject [ "kind" .= String "TraceCopyToImmutableDBEvent.NoBlocksToCopyToImmutableDB" ] + mconcat [ "kind" .= String "TraceCopyToImmutableDBEvent.NoBlocksToCopyToImmutableDB" ] toObject verb (ChainDB.TraceGCEvent ev) = case ev of ChainDB.PerformedGC slot -> - mkObject [ "kind" .= String "TraceGCEvent.PerformedGC" + mconcat [ "kind" .= String "TraceGCEvent.PerformedGC" , "slot" .= toObject verb slot ] ChainDB.ScheduledGC slot difft -> - mkObject $ [ "kind" .= String "TraceGCEvent.ScheduledGC" + mconcat $ [ "kind" .= String "TraceGCEvent.ScheduledGC" , "slot" .= toObject verb slot ] <> [ "difft" .= String ((pack . show) difft) | verb >= MaximalVerbosity] toObject verb (ChainDB.TraceOpenEvent ev) = case ev of ChainDB.StartedOpeningDB -> - mkObject ["kind" .= String "TraceOpenEvent.StartedOpeningDB"] + mconcat ["kind" .= String "TraceOpenEvent.StartedOpeningDB"] ChainDB.StartedOpeningImmutableDB -> - mkObject ["kind" .= String "TraceOpenEvent.StartedOpeningImmutableDB"] + mconcat ["kind" .= String "TraceOpenEvent.StartedOpeningImmutableDB"] ChainDB.StartedOpeningVolatileDB -> - mkObject ["kind" .= String "TraceOpenEvent.StartedOpeningVolatileDB"] + mconcat ["kind" .= String "TraceOpenEvent.StartedOpeningVolatileDB"] ChainDB.StartedOpeningLgrDB -> - mkObject ["kind" .= String "TraceOpenEvent.StartedOpeningLgrDB"] + mconcat ["kind" .= String "TraceOpenEvent.StartedOpeningLgrDB"] ChainDB.OpenedDB immTip tip' -> - mkObject [ "kind" .= String "TraceOpenEvent.OpenedDB" + mconcat [ "kind" .= String "TraceOpenEvent.OpenedDB" , "immtip" .= toObject verb immTip , "tip" .= toObject verb tip' ] ChainDB.ClosedDB immTip tip' -> - mkObject [ "kind" .= String "TraceOpenEvent.ClosedDB" + mconcat [ "kind" .= String "TraceOpenEvent.ClosedDB" , "immtip" .= toObject verb immTip , "tip" .= toObject verb tip' ] ChainDB.OpenedImmutableDB immTip epoch -> - mkObject [ "kind" .= String "TraceOpenEvent.OpenedImmutableDB" + mconcat [ "kind" .= String "TraceOpenEvent.OpenedImmutableDB" , "immtip" .= toObject verb immTip , "epoch" .= String ((pack . show) epoch) ] ChainDB.OpenedVolatileDB -> - mkObject [ "kind" .= String "TraceOpenEvent.OpenedVolatileDB" ] + mconcat [ "kind" .= String "TraceOpenEvent.OpenedVolatileDB" ] ChainDB.OpenedLgrDB -> - mkObject [ "kind" .= String "TraceOpenEvent.OpenedLgrDB" ] + mconcat [ "kind" .= String "TraceOpenEvent.OpenedLgrDB" ] toObject _verb (ChainDB.TraceFollowerEvent ev) = case ev of ChainDB.NewFollower -> - mkObject [ "kind" .= String "TraceFollowerEvent.NewFollower" ] + mconcat [ "kind" .= String "TraceFollowerEvent.NewFollower" ] ChainDB.FollowerNoLongerInMem _ -> - mkObject [ "kind" .= String "TraceFollowerEvent.FollowerNoLongerInMem" ] + mconcat [ "kind" .= String "TraceFollowerEvent.FollowerNoLongerInMem" ] ChainDB.FollowerSwitchToMem _ _ -> - mkObject [ "kind" .= String "TraceFollowerEvent.FollowerSwitchToMem" ] + mconcat [ "kind" .= String "TraceFollowerEvent.FollowerSwitchToMem" ] ChainDB.FollowerNewImmIterator _ _ -> - mkObject [ "kind" .= String "TraceFollowerEvent.FollowerNewImmIterator" ] + mconcat [ "kind" .= String "TraceFollowerEvent.FollowerNewImmIterator" ] toObject verb (ChainDB.TraceInitChainSelEvent ev) = case ev of ChainDB.InitalChainSelected -> - mkObject ["kind" .= String "TraceFollowerEvent.InitalChainSelected"] + mconcat ["kind" .= String "TraceFollowerEvent.InitalChainSelected"] ChainDB.StartedInitChainSelection -> - mkObject ["kind" .= String "TraceFollowerEvent.StartedInitChainSelection"] + mconcat ["kind" .= String "TraceFollowerEvent.StartedInitChainSelection"] ChainDB.InitChainSelValidation ev' -> case ev' of ChainDB.InvalidBlock err pt -> - mkObject [ "kind" .= String "TraceInitChainSelEvent.InvalidBlock" + mconcat [ "kind" .= String "TraceInitChainSelEvent.InvalidBlock" , "block" .= toObject verb pt , "error" .= show err ] ChainDB.ValidCandidate c -> - mkObject [ "kind" .= String "TraceInitChainSelEvent.ValidCandidate" + mconcat [ "kind" .= String "TraceInitChainSelEvent.ValidCandidate" , "block" .= renderPointForVerbosity verb (AF.headPoint c) ] ChainDB.CandidateContainsFutureBlocks c hdrs -> - mkObject [ "kind" .= String "TraceInitChainSelEvent.CandidateContainsFutureBlocks" + mconcat [ "kind" .= String "TraceInitChainSelEvent.CandidateContainsFutureBlocks" , "block" .= renderPointForVerbosity verb (AF.headPoint c) , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] ChainDB.CandidateContainsFutureBlocksExceedingClockSkew c hdrs -> - mkObject [ "kind" .= String "TraceInitChainSelEvent.CandidateContainsFutureBlocksExceedingClockSkew" + mconcat [ "kind" .= String "TraceInitChainSelEvent.CandidateContainsFutureBlocksExceedingClockSkew" , "block" .= renderPointForVerbosity verb (AF.headPoint c) , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] ChainDB.UpdateLedgerDbTraceEvent (StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr) ) -> - mkObject [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb" + mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb" , "startingBlock" .= renderRealPoint start , "currentBlock" .= renderRealPoint curr , "targetBlock" .= renderRealPoint goal @@ -972,163 +973,163 @@ instance ( ConvertRawHash blk toObject _verb (ChainDB.TraceIteratorEvent ev) = case ev of ChainDB.UnknownRangeRequested unkRange -> - mkObject [ "kind" .= String "TraceIteratorEvent.UnknownRangeRequested" + mconcat [ "kind" .= String "TraceIteratorEvent.UnknownRangeRequested" , "range" .= String (showT unkRange) ] ChainDB.StreamFromVolatileDB streamFrom streamTo realPt -> - mkObject [ "kind" .= String "TraceIteratorEvent.StreamFromVolatileDB" + mconcat [ "kind" .= String "TraceIteratorEvent.StreamFromVolatileDB" , "from" .= String (showT streamFrom) , "to" .= String (showT streamTo) , "point" .= String (Text.pack . show $ map renderRealPoint realPt) ] ChainDB.StreamFromImmutableDB streamFrom streamTo -> - mkObject [ "kind" .= String "TraceIteratorEvent.StreamFromImmutableDB" + mconcat [ "kind" .= String "TraceIteratorEvent.StreamFromImmutableDB" , "from" .= String (showT streamFrom) , "to" .= String (showT streamTo) ] ChainDB.StreamFromBoth streamFrom streamTo realPt -> - mkObject [ "kind" .= String "TraceIteratorEvent.StreamFromBoth" + mconcat [ "kind" .= String "TraceIteratorEvent.StreamFromBoth" , "from" .= String (showT streamFrom) , "to" .= String (showT streamTo) , "point" .= String (Text.pack . show $ map renderRealPoint realPt) ] ChainDB.BlockMissingFromVolatileDB realPt -> - mkObject [ "kind" .= String "TraceIteratorEvent.BlockMissingFromVolatileDB" + mconcat [ "kind" .= String "TraceIteratorEvent.BlockMissingFromVolatileDB" , "point" .= String (renderRealPoint realPt) ] ChainDB.BlockWasCopiedToImmutableDB realPt -> - mkObject [ "kind" .= String "TraceIteratorEvent.BlockWasCopiedToImmutableDB" + mconcat [ "kind" .= String "TraceIteratorEvent.BlockWasCopiedToImmutableDB" , "point" .= String (renderRealPoint realPt) ] ChainDB.BlockGCedFromVolatileDB realPt -> - mkObject [ "kind" .= String "TraceIteratorEvent.BlockGCedFromVolatileDB" + mconcat [ "kind" .= String "TraceIteratorEvent.BlockGCedFromVolatileDB" , "point" .= String (renderRealPoint realPt) ] ChainDB.SwitchBackToVolatileDB -> - mkObject ["kind" .= String "TraceIteratorEvent.SwitchBackToVolatileDB" + mconcat ["kind" .= String "TraceIteratorEvent.SwitchBackToVolatileDB" ] toObject verb (ChainDB.TraceImmutableDBEvent ev) = case ev of ImmDB.ChunkValidationEvent traceChunkValidation -> toObject verb traceChunkValidation ImmDB.NoValidLastLocation -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.NoValidLastLocation" ] + mconcat [ "kind" .= String "TraceImmutableDBEvent.NoValidLastLocation" ] ImmDB.ValidatedLastLocation chunkNo immTip -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.ValidatedLastLocation" + mconcat [ "kind" .= String "TraceImmutableDBEvent.ValidatedLastLocation" , "chunkNo" .= String (renderChunkNo chunkNo) , "immTip" .= String (renderTipHash immTip) , "blockNo" .= String (renderTipBlockNo immTip) ] ImmDB.ChunkFileDoesntFit expectPrevHash actualPrevHash -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.ChunkFileDoesntFit" + mconcat [ "kind" .= String "TraceImmutableDBEvent.ChunkFileDoesntFit" , "expectedPrevHash" .= String (renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) expectPrevHash) , "actualPrevHash" .= String (renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) actualPrevHash) ] ImmDB.Migrating txt -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.Migrating" + mconcat [ "kind" .= String "TraceImmutableDBEvent.Migrating" , "info" .= String txt ] ImmDB.DeletingAfter immTipWithInfo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.DeletingAfter" + mconcat [ "kind" .= String "TraceImmutableDBEvent.DeletingAfter" , "immTipHash" .= String (renderWithOrigin renderTipHash immTipWithInfo) , "immTipBlockNo" .= String (renderWithOrigin renderTipBlockNo immTipWithInfo) ] - ImmDB.DBAlreadyClosed -> mkObject [ "kind" .= String "TraceImmutableDBEvent.DBAlreadyClosed" ] - ImmDB.DBClosed -> mkObject [ "kind" .= String "TraceImmutableDBEvent.DBClosed" ] + ImmDB.DBAlreadyClosed -> mconcat [ "kind" .= String "TraceImmutableDBEvent.DBAlreadyClosed" ] + ImmDB.DBClosed -> mconcat [ "kind" .= String "TraceImmutableDBEvent.DBClosed" ] ImmDB.TraceCacheEvent cacheEv -> case cacheEv of ImmDB.TraceCurrentChunkHit chunkNo nbPastChunksInCache -> - mkObject [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TraceCurrentChunkHit" + mconcat [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TraceCurrentChunkHit" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] ImmDB.TracePastChunkHit chunkNo nbPastChunksInCache -> - mkObject [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunkHit" + mconcat [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunkHit" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] ImmDB.TracePastChunkMiss chunkNo nbPastChunksInCache -> - mkObject [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunkMiss" + mconcat [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunkMiss" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] ImmDB.TracePastChunkEvict chunkNo nbPastChunksInCache -> - mkObject [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunkEvict" + mconcat [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunkEvict" , "chunkNo" .= String (renderChunkNo chunkNo) , "noPastChunks" .= String (showT nbPastChunksInCache) ] ImmDB.TracePastChunksExpired chunkNos nbPastChunksInCache -> - mkObject [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunksExpired" + mconcat [ "kind" .= String "TraceImmDbEvent.TraceCacheEvent.TracePastChunksExpired" , "chunkNos" .= String (Text.pack . show $ map renderChunkNo chunkNos) , "noPastChunks" .= String (showT nbPastChunksInCache) ] toObject _verb (ChainDB.TraceVolatileDBEvent ev) = case ev of - VolDb.DBAlreadyClosed -> mkObject [ "kind" .= String "TraceVolatileDbEvent.DBAlreadyClosed"] + VolDb.DBAlreadyClosed -> mconcat [ "kind" .= String "TraceVolatileDbEvent.DBAlreadyClosed"] VolDb.BlockAlreadyHere blockId -> - mkObject [ "kind" .= String "TraceVolatileDbEvent.BlockAlreadyHere" + mconcat [ "kind" .= String "TraceVolatileDbEvent.BlockAlreadyHere" , "blockId" .= String (showT blockId) ] VolDb.Truncate pErr fsPath blockOffset -> - mkObject [ "kind" .= String "TraceVolatileDbEvent.Truncate" + mconcat [ "kind" .= String "TraceVolatileDbEvent.Truncate" , "parserError" .= String (showT pErr) , "file" .= String (showT fsPath) , "blockOffset" .= String (showT blockOffset) ] VolDb.InvalidFileNames fsPaths -> - mkObject [ "kind" .= String "TraceVolatileDBEvent.InvalidFileNames" + mconcat [ "kind" .= String "TraceVolatileDBEvent.InvalidFileNames" , "files" .= String (Text.pack . show $ map show fsPaths) ] instance ConvertRawHash blk => ToObject (ImmDB.TraceChunkValidation blk ChunkNo) where toObject verb ev = case ev of ImmDB.RewriteSecondaryIndex chunkNo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.RewriteSecondaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.RewriteSecondaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.RewritePrimaryIndex chunkNo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.RewritePrimaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.RewritePrimaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.MissingPrimaryIndex chunkNo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.MissingPrimaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingPrimaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.MissingSecondaryIndex chunkNo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.MissingSecondaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingSecondaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.InvalidPrimaryIndex chunkNo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidPrimaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidPrimaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.InvalidSecondaryIndex chunkNo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidSecondaryIndex" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidSecondaryIndex" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrHashMismatch hashPrevBlock prevHashOfBlock) -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch" , "chunkNo" .= String (renderChunkNo chunkNo) , "hashPrevBlock" .= String (Text.decodeLatin1 . toRawHash (Proxy @blk) $ hashPrevBlock) , "prevHashOfBlock" .= String (renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) prevHashOfBlock) ] ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrCorrupt pt) -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt" , "chunkNo" .= String (renderChunkNo chunkNo) , "block" .= String (renderPointForVerbosity verb pt) ] ImmDB.ValidatedChunk chunkNo _ -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.ValidatedChunk" + mconcat [ "kind" .= String "TraceImmutableDBEvent.ValidatedChunk" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.MissingChunkFile chunkNo -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.MissingChunkFile" + mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingChunkFile" , "chunkNo" .= String (renderChunkNo chunkNo) ] ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrRead readIncErr) -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead" + mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead" , "chunkNo" .= String (renderChunkNo chunkNo) , "error" .= String (showT readIncErr) ] ImmDB.StartedValidatingChunk initialChunk finalChunk -> - mkObject [ "kind" .= String "TraceImmutableDBEvent.StartedValidatingChunk" + mconcat [ "kind" .= String "TraceImmutableDBEvent.StartedValidatingChunk" , "initialChunk" .= renderChunkNo initialChunk , "finalChunk" .= renderChunkNo finalChunk ] @@ -1136,18 +1137,18 @@ instance ConvertRawHash blk => ToObject (ImmDB.TraceChunkValidation blk ChunkNo) instance ConvertRawHash blk => ToObject (TraceBlockFetchServerEvent blk) where toObject _verb (TraceBlockFetchServerSendBlock blk) = - mkObject [ "kind" .= String "TraceBlockFetchServerSendBlock" + mconcat [ "kind" .= String "TraceBlockFetchServerSendBlock" , "block" .= String (renderChainHash @blk (renderHeaderHash (Proxy @blk)) $ pointHash blk) ] -tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> [(Text, Value)] +tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> Aeson.Object tipToObject = \case - TipGenesis -> + TipGenesis -> mconcat [ "slot" .= toJSON (0 :: Int) , "block" .= String "genesis" , "blockNo" .= toJSON ((-1) :: Int) ] - Tip slot hash blockno -> + Tip slot hash blockno -> mconcat [ "slot" .= slot , "block" .= String (renderHeaderHash (Proxy @blk) hash) , "blockNo" .= blockno @@ -1157,47 +1158,52 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) => ToObject (TraceChainSyncClientEvent blk) where toObject verb ev = case ev of TraceDownloadedHeader h -> - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncClientEvent.TraceDownloadedHeader" - ] <> tipToObject (tipFromHeader h) + , tipToObject (tipFromHeader h) + ] TraceRolledBack tip -> - mkObject [ "kind" .= String "ChainSyncClientEvent.TraceRolledBack" + mconcat [ "kind" .= String "ChainSyncClientEvent.TraceRolledBack" , "tip" .= toObject verb tip ] TraceException exc -> - mkObject [ "kind" .= String "ChainSyncClientEvent.TraceException" + mconcat [ "kind" .= String "ChainSyncClientEvent.TraceException" , "exception" .= String (pack $ show exc) ] TraceFoundIntersection _ _ _ -> - mkObject [ "kind" .= String "ChainSyncClientEvent.TraceFoundIntersection" ] + mconcat [ "kind" .= String "ChainSyncClientEvent.TraceFoundIntersection" ] TraceTermination reason -> - mkObject [ "kind" .= String "ChainSyncClientEvent.TraceTermination" + mconcat [ "kind" .= String "ChainSyncClientEvent.TraceTermination" , "reason" .= String (pack $ show reason) ] instance ConvertRawHash blk => ToObject (TraceChainSyncServerEvent blk) where toObject verb ev = case ev of TraceChainSyncServerRead tip AddBlock{} -> - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerRead.AddBlock" - ] <> tipToObject tip + , tipToObject tip + ] TraceChainSyncServerRead tip RollBack{} -> - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerRead.RollBack" - ] <> tipToObject tip + , tipToObject tip + ] TraceChainSyncServerReadBlocked tip AddBlock{} -> - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerReadBlocked.AddBlock" - ] <> tipToObject tip + , tipToObject tip + ] TraceChainSyncServerReadBlocked tip RollBack{} -> - mkObject $ + mconcat $ [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerReadBlocked.RollBack" - ] <> tipToObject tip + , tipToObject tip + ] TraceChainSyncRollForward point -> - mkObject [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncRollForward" + mconcat [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncRollForward" , "point" .= toObject verb point ] TraceChainSyncRollBackward point -> - mkObject [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncRollBackward" + mconcat [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncRollBackward" , "point" .= toObject verb point ] @@ -1205,26 +1211,26 @@ instance ( Show (ApplyTxErr blk), ToObject (ApplyTxErr blk), ToObject (GenTx blk ToJSON (GenTxId blk), LedgerSupportsMempool blk ) => ToObject (TraceEventMempool blk) where toObject verb (TraceMempoolAddedTx tx _mpSzBefore mpSzAfter) = - mkObject + mconcat [ "kind" .= String "TraceMempoolAddedTx" , "tx" .= toObject verb (txForgetValidated tx) , "mempoolSize" .= toObject verb mpSzAfter ] toObject verb (TraceMempoolRejectedTx tx txApplyErr mpSz) = - mkObject + mconcat [ "kind" .= String "TraceMempoolRejectedTx" , "err" .= toObject verb txApplyErr , "tx" .= toObject verb tx , "mempoolSize" .= toObject verb mpSz ] toObject verb (TraceMempoolRemoveTxs txs mpSz) = - mkObject + mconcat [ "kind" .= String "TraceMempoolRemoveTxs" , "txs" .= map (toObject verb . txForgetValidated) txs , "mempoolSize" .= toObject verb mpSz ] toObject verb (TraceMempoolManuallyRemovedTxs txs0 txs1 mpSz) = - mkObject + mconcat [ "kind" .= String "TraceMempoolManuallyRemovedTxs" , "txsRemoved" .= txs0 , "txsInvalidated" .= map (toObject verb . txForgetValidated) txs1 @@ -1233,7 +1239,7 @@ instance ( Show (ApplyTxErr blk), ToObject (ApplyTxErr blk), ToObject (GenTx blk instance ToObject MempoolSize where toObject _verb MempoolSize{msNumTxs, msNumBytes} = - mkObject + mconcat [ "numTxs" .= msNumTxs , "bytes" .= msNumBytes ] @@ -1257,74 +1263,74 @@ instance ( tx ~ GenTx blk , ToObject (ForgeStateUpdateError blk)) => ToObject (TraceForgeEvent blk) where toObject _verb (TraceStartLeadershipCheck slotNo) = - mkObject + mconcat [ "kind" .= String "TraceStartLeadershipCheck" , "slot" .= toJSON (unSlotNo slotNo) ] toObject verb (TraceSlotIsImmutable slotNo tipPoint tipBlkNo) = - mkObject + mconcat [ "kind" .= String "TraceSlotIsImmutable" , "slot" .= toJSON (unSlotNo slotNo) , "tip" .= renderPointForVerbosity verb tipPoint , "tipBlockNo" .= toJSON (unBlockNo tipBlkNo) ] toObject _verb (TraceBlockFromFuture currentSlot tip) = - mkObject + mconcat [ "kind" .= String "TraceBlockFromFuture" , "current slot" .= toJSON (unSlotNo currentSlot) , "tip" .= toJSON (unSlotNo tip) ] toObject verb (TraceBlockContext currentSlot tipBlkNo tipPoint) = - mkObject + mconcat [ "kind" .= String "TraceBlockContext" , "current slot" .= toJSON (unSlotNo currentSlot) , "tip" .= renderPointForVerbosity verb tipPoint , "tipBlockNo" .= toJSON (unBlockNo tipBlkNo) ] toObject _verb (TraceNoLedgerState slotNo _pt) = - mkObject + mconcat [ "kind" .= String "TraceNoLedgerState" , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceLedgerState slotNo _pt) = - mkObject + mconcat [ "kind" .= String "TraceLedgerState" , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceNoLedgerView slotNo _) = - mkObject + mconcat [ "kind" .= String "TraceNoLedgerView" , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceLedgerView slotNo) = - mkObject + mconcat [ "kind" .= String "TraceLedgerView" , "slot" .= toJSON (unSlotNo slotNo) ] toObject verb (TraceForgeStateUpdateError slotNo reason) = - mkObject + mconcat [ "kind" .= String "TraceForgeStateUpdateError" , "slot" .= toJSON (unSlotNo slotNo) , "reason" .= toObject verb reason ] toObject verb (TraceNodeCannotForge slotNo reason) = - mkObject + mconcat [ "kind" .= String "TraceNodeCannotForge" , "slot" .= toJSON (unSlotNo slotNo) , "reason" .= toObject verb reason ] toObject _verb (TraceNodeNotLeader slotNo) = - mkObject + mconcat [ "kind" .= String "TraceNodeNotLeader" , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceNodeIsLeader slotNo) = - mkObject + mconcat [ "kind" .= String "TraceNodeIsLeader" , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceForgedBlock slotNo _ blk _) = - mkObject + mconcat [ "kind" .= String "TraceForgedBlock" , "slot" .= toJSON (unSlotNo slotNo) , "block" .= String (renderHeaderHash (Proxy @blk) $ blockHash blk) @@ -1332,18 +1338,18 @@ instance ( tx ~ GenTx blk , "blockPrev" .= String (renderChainHash @blk (renderHeaderHash (Proxy @blk)) $ blockPrevHash blk) ] toObject _verb (TraceDidntAdoptBlock slotNo _) = - mkObject + mconcat [ "kind" .= String "TraceDidntAdoptBlock" , "slot" .= toJSON (unSlotNo slotNo) ] toObject verb (TraceForgedInvalidBlock slotNo _ reason) = - mkObject + mconcat [ "kind" .= String "TraceForgedInvalidBlock" , "slot" .= toJSON (unSlotNo slotNo) , "reason" .= toObject verb reason ] toObject MaximalVerbosity (TraceAdoptedBlock slotNo blk txs) = - mkObject + mconcat [ "kind" .= String "TraceAdoptedBlock" , "slot" .= toJSON (unSlotNo slotNo) , "blockHash" .= renderHeaderHashForVerbosity @@ -1354,7 +1360,7 @@ instance ( tx ~ GenTx blk , "txIds" .= toJSON (map (show . txId . txForgetValidated) txs) ] toObject verb (TraceAdoptedBlock slotNo blk _txs) = - mkObject + mconcat [ "kind" .= String "TraceAdoptedBlock" , "slot" .= toJSON (unSlotNo slotNo) , "blockHash" .= renderHeaderHashForVerbosity @@ -1367,4 +1373,4 @@ instance ( tx ~ GenTx blk instance ToObject (TraceLocalTxSubmissionServerEvent blk) where toObject _verb _ = - mkObject [ "kind" .= String "TraceLocalTxSubmissionServerEvent" ] + mconcat [ "kind" .= String "TraceLocalTxSubmissionServerEvent" ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index 51440e83b4c..870af7afabf 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -97,7 +97,7 @@ instance ToJSON (TxId (GenTx blk)) => ToJSON (WrapGenTxId blk) where instance All (ToObject `Compose` WrapApplyTxErr) xs => ToObject (HardForkApplyTxErr xs) where toObject verb (HardForkApplyTxErrFromEra err) = toObject verb err toObject _verb (HardForkApplyTxErrWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkApplyTxErrWrongEra" , "currentEra" .= ledgerEraName , "txEra" .= otherEraName @@ -123,7 +123,7 @@ instance All (ToObject `Compose` WrapLedgerErr) xs => ToObject (HardForkLedgerEr toObject verb (HardForkLedgerErrorFromEra err) = toObject verb err toObject _verb (HardForkLedgerErrorWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkLedgerErrorWrongEra" , "currentEra" .= ledgerEraName , "blockEra" .= otherEraName @@ -152,7 +152,7 @@ instance ( All (ToObject `Compose` WrapLedgerWarning) xs HardForkWarningInEra err -> toObject verb err HardForkWarningTransitionMismatch toEra eraParams epoch -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionMismatch" , "toEra" .= condense toEra , "eraParams" .= toObject verb eraParams @@ -160,20 +160,20 @@ instance ( All (ToObject `Compose` WrapLedgerWarning) xs ] HardForkWarningTransitionInFinalEra fromEra epoch -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionInFinalEra" , "fromEra" .= condense fromEra , "transitionEpoch" .= epoch ] HardForkWarningTransitionUnconfirmed toEra -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionUnconfirmed" , "toEra" .= condense toEra ] HardForkWarningTransitionReconfirmed fromEra toEra prevEpoch newEpoch -> - mkObject + mconcat [ "kind" .= String "HardForkWarningTransitionReconfirmed" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -192,7 +192,7 @@ instance ToObject (LedgerWarning blk) => ToObject (WrapLedgerWarning blk) where instance ToObject EraParams where toObject _verb EraParams{ eraEpochSize, eraSlotLength, eraSafeZone} = - mkObject + mconcat [ "epochSize" .= unEpochSize eraEpochSize , "slotLength" .= getSlotLength eraSlotLength , "safeZone" .= eraSafeZone @@ -212,7 +212,7 @@ instance ( All (ToObject `Compose` WrapLedgerUpdate) xs HardForkUpdateInEra err -> toObject verb err HardForkUpdateTransitionConfirmed fromEra toEra epoch -> - mkObject + mconcat [ "kind" .= String "HardForkUpdateTransitionConfirmed" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -220,7 +220,7 @@ instance ( All (ToObject `Compose` WrapLedgerUpdate) xs ] HardForkUpdateTransitionDone fromEra toEra epoch -> - mkObject + mconcat [ "kind" .= String "HardForkUpdateTransitionDone" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -228,7 +228,7 @@ instance ( All (ToObject `Compose` WrapLedgerUpdate) xs ] HardForkUpdateTransitionRolledBack fromEra toEra -> - mkObject + mconcat [ "kind" .= String "HardForkUpdateTransitionRolledBack" , "fromEra" .= condense fromEra , "toEra" .= condense toEra @@ -252,7 +252,7 @@ instance All (ToObject `Compose` WrapEnvelopeErr) xs => ToObject (HardForkEnvelo toObject verb (HardForkEnvelopeErrFromEra err) = toObject verb err toObject _verb (HardForkEnvelopeErrWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkEnvelopeErrWrongEra" , "currentEra" .= ledgerEraName , "blockEra" .= otherEraName @@ -278,7 +278,7 @@ instance All (ToObject `Compose` WrapValidationErr) xs => ToObject (HardForkVali toObject verb (HardForkValidationErrFromEra err) = toObject verb err toObject _verb (HardForkValidationErrWrongEra mismatch) = - mkObject + mconcat [ "kind" .= String "HardForkValidationErrWrongEra" , "currentEra" .= ledgerEraName , "blockEra" .= otherEraName @@ -323,7 +323,7 @@ instance ToObject (CannotForge blk) => ToObject (WrapCannotForge blk) where instance All (ToObject `Compose` WrapForgeStateInfo) xs => ToObject (OneEraForgeStateInfo xs) where toObject verb forgeStateInfo = - mkObject + mconcat [ "kind" .= String "HardForkForgeStateInfo" , "forgeStateInfo" .= toJSON forgeStateInfo' ] @@ -349,7 +349,7 @@ instance ToObject (ForgeStateInfo blk) => ToObject (WrapForgeStateInfo blk) wher instance All (ToObject `Compose` WrapForgeStateUpdateError) xs => ToObject (OneEraForgeStateUpdateError xs) where toObject verb forgeStateUpdateError = - mkObject + mconcat [ "kind" .= String "HardForkForgeStateUpdateError" , "forgeStateUpdateError" .= toJSON forgeStateUpdateError' ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 0998d5d0600..ea78e2cd64f 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -334,7 +334,7 @@ instance HasTextFormatter (Identity (SubscriptionTrace LocalAddress)) where instance ToObject (Identity (SubscriptionTrace LocalAddress)) where toObject _verb (Identity ev) = - mkObject [ "kind" .= ("SubscriptionTrace" :: String) + mconcat [ "kind" .= ("SubscriptionTrace" :: String) , "event" .= show ev ] @@ -740,14 +740,14 @@ instance ( ConvertTxId blk ) => ToObject (AnyMessageAndAgency (BlockFetch blk (Point blk))) where toObject MinimalVerbosity (AnyMessageAndAgency stok (MsgBlock blk)) = - mkObject [ "kind" .= String "MsgBlock" + mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) ] toObject verb (AnyMessageAndAgency stok (MsgBlock blk)) = - mkObject [ "kind" .= String "MsgBlock" + mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) @@ -758,23 +758,23 @@ instance ( ConvertTxId blk presentTx = String . renderTxIdForVerbosity verb . txId toObject _v (AnyMessageAndAgency stok MsgRequestRange{}) = - mkObject [ "kind" .= String "MsgRequestRange" + mconcat [ "kind" .= String "MsgRequestRange" , "agency" .= String (pack $ show stok) ] toObject _v (AnyMessageAndAgency stok MsgStartBatch{}) = - mkObject [ "kind" .= String "MsgStartBatch" + mconcat [ "kind" .= String "MsgStartBatch" , "agency" .= String (pack $ show stok) ] toObject _v (AnyMessageAndAgency stok MsgNoBlocks{}) = - mkObject [ "kind" .= String "MsgNoBlocks" + mconcat [ "kind" .= String "MsgNoBlocks" , "agency" .= String (pack $ show stok) ] toObject _v (AnyMessageAndAgency stok MsgBatchDone{}) = - mkObject [ "kind" .= String "MsgBatchDone" + mconcat [ "kind" .= String "MsgBatchDone" , "agency" .= String (pack $ show stok) ] toObject _v (AnyMessageAndAgency stok MsgClientDone{}) = - mkObject [ "kind" .= String "MsgClientDone" + mconcat [ "kind" .= String "MsgClientDone" , "agency" .= String (pack $ show stok) ] @@ -786,19 +786,19 @@ instance ( ToObject (AnyMessageAndAgency ps) toObject verb (AnyMessageAndAgency stok msg) = case (stok, msg) of (_, Hello.MsgHello) -> - mkObject [ "kind" .= String "MsgHello" + mconcat [ "kind" .= String "MsgHello" , "agency" .= String (pack $ show stok) ] ( ClientAgency (Hello.TokClientTalk tok) , Hello.MsgTalk msg' ) -> - mkObject [ "kind" .= String "MsgTalk" + mconcat [ "kind" .= String "MsgTalk" , "message" .= toObject verb (AnyMessageAndAgency (ClientAgency tok) msg') ] ( ServerAgency (Hello.TokServerTalk tok) , Hello.MsgTalk msg' ) -> - mkObject [ "kind" .= String "MsgTalk" + mconcat [ "kind" .= String "MsgTalk" , "message" .= toObject verb (AnyMessageAndAgency (ServerAgency tok) msg') @@ -807,162 +807,162 @@ instance ( ToObject (AnyMessageAndAgency ps) instance (forall result. Show (query result)) => ToObject (AnyMessageAndAgency (LocalStateQuery blk pt query)) where toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgAcquire{}) = - mkObject [ "kind" .= String "MsgAcquire" + mconcat [ "kind" .= String "MsgAcquire" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgAcquired{}) = - mkObject [ "kind" .= String "MsgAcquired" + mconcat [ "kind" .= String "MsgAcquired" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgFailure{}) = - mkObject [ "kind" .= String "MsgFailure" + mconcat [ "kind" .= String "MsgFailure" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgQuery{}) = - mkObject [ "kind" .= String "MsgQuery" + mconcat [ "kind" .= String "MsgQuery" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgResult{}) = - mkObject [ "kind" .= String "MsgResult" + mconcat [ "kind" .= String "MsgResult" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgRelease{}) = - mkObject [ "kind" .= String "MsgRelease" + mconcat [ "kind" .= String "MsgRelease" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgReAcquire{}) = - mkObject [ "kind" .= String "MsgReAcquire" + mconcat [ "kind" .= String "MsgReAcquire" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalStateQuery.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] instance ToObject (AnyMessageAndAgency (LocalTxMonitor txid tx slotno)) where toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgAcquire {}) = - mkObject [ "kind" .= String "MsgAcuire" + mconcat [ "kind" .= String "MsgAcuire" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgAcquired {}) = - mkObject [ "kind" .= String "MsgAcuired" + mconcat [ "kind" .= String "MsgAcuired" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgAwaitAcquire {}) = - mkObject [ "kind" .= String "MsgAwaitAcuire" + mconcat [ "kind" .= String "MsgAwaitAcuire" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgNextTx {}) = - mkObject [ "kind" .= String "MsgNextTx" + mconcat [ "kind" .= String "MsgNextTx" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgReplyNextTx {}) = - mkObject [ "kind" .= String "MsgReplyNextTx" + mconcat [ "kind" .= String "MsgReplyNextTx" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgHasTx {}) = - mkObject [ "kind" .= String "MsgHasTx" + mconcat [ "kind" .= String "MsgHasTx" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgReplyHasTx {}) = - mkObject [ "kind" .= String "MsgReplyHasTx" + mconcat [ "kind" .= String "MsgReplyHasTx" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgGetSizes {}) = - mkObject [ "kind" .= String "MsgGetSizes" + mconcat [ "kind" .= String "MsgGetSizes" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgReplyGetSizes {}) = - mkObject [ "kind" .= String "MsgReplyGetSizes" + mconcat [ "kind" .= String "MsgReplyGetSizes" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgRelease {}) = - mkObject [ "kind" .= String "MsgRelease" + mconcat [ "kind" .= String "MsgRelease" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxMonitor.MsgDone {}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] instance ToObject (AnyMessageAndAgency (LocalTxSubmission tx err)) where toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgSubmitTx{}) = - mkObject [ "kind" .= String "MsgSubmitTx" + mconcat [ "kind" .= String "MsgSubmitTx" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgAcceptTx{}) = - mkObject [ "kind" .= String "MsgAcceptTx" + mconcat [ "kind" .= String "MsgAcceptTx" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgRejectTx{}) = - mkObject [ "kind" .= String "MsgRejectTx" + mconcat [ "kind" .= String "MsgRejectTx" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok LocalTxSub.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] instance ToObject (AnyMessageAndAgency (ChainSync blk pt tip)) where toObject _verb (AnyMessageAndAgency stok ChainSync.MsgRequestNext{}) = - mkObject [ "kind" .= String "MsgRequestNext" + mconcat [ "kind" .= String "MsgRequestNext" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok ChainSync.MsgAwaitReply{}) = - mkObject [ "kind" .= String "MsgAwaitReply" + mconcat [ "kind" .= String "MsgAwaitReply" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok ChainSync.MsgRollForward{}) = - mkObject [ "kind" .= String "MsgRollForward" + mconcat [ "kind" .= String "MsgRollForward" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok ChainSync.MsgRollBackward{}) = - mkObject [ "kind" .= String "MsgRollBackward" + mconcat [ "kind" .= String "MsgRollBackward" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok ChainSync.MsgFindIntersect{}) = - mkObject [ "kind" .= String "MsgFindIntersect" + mconcat [ "kind" .= String "MsgFindIntersect" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok ChainSync.MsgIntersectFound{}) = - mkObject [ "kind" .= String "MsgIntersectFound" + mconcat [ "kind" .= String "MsgIntersectFound" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok ChainSync.MsgIntersectNotFound{}) = - mkObject [ "kind" .= String "MsgIntersectNotFound" + mconcat [ "kind" .= String "MsgIntersectNotFound" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok ChainSync.MsgDone{}) = - mkObject [ "kind" .= String "MsgDone" + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] instance (Show txid, Show tx) => ToObject (AnyMessageAndAgency (TxSubmission txid tx)) where toObject _verb (AnyMessageAndAgency stok (MsgRequestTxs txids)) = - mkObject + mconcat [ "kind" .= String "MsgRequestTxs" , "agency" .= String (pack $ show stok) , "txIds" .= String (pack $ show txids) ] toObject _verb (AnyMessageAndAgency stok (MsgReplyTxs txs)) = - mkObject + mconcat [ "kind" .= String "MsgReplyTxs" , "agency" .= String (pack $ show stok) , "txs" .= String (pack $ show txs) ] toObject _verb (AnyMessageAndAgency stok MsgRequestTxIds{}) = - mkObject + mconcat [ "kind" .= String "MsgRequestTxIds" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok (MsgReplyTxIds _)) = - mkObject + mconcat [ "kind" .= String "MsgReplyTxIds" , "agency" .= String (pack $ show stok) ] toObject _verb (AnyMessageAndAgency stok MsgDone) = - mkObject + mconcat [ "kind" .= String "MsgDone" , "agency" .= String (pack $ show stok) ] @@ -989,91 +989,91 @@ instance Aeson.ToJSON ConnectionManagerCounters where instance ToObject (FetchDecision [Point header]) where toObject _verb (Left decline) = - mkObject [ "kind" .= String "FetchDecision declined" + mconcat [ "kind" .= String "FetchDecision declined" , "declined" .= String (pack (show decline)) ] toObject _verb (Right results) = - mkObject [ "kind" .= String "FetchDecision results" + mconcat [ "kind" .= String "FetchDecision results" , "length" .= String (pack $ show $ length results) ] -- TODO: use 'ToJSON' constraints instance (Show ntnAddr, Show ntcAddr) => ToObject (ND.InitializationTracer ntnAddr ntcAddr) where - toObject _verb (ND.RunServer sockAddr) = mkObject + toObject _verb (ND.RunServer sockAddr) = mconcat [ "kind" .= String "RunServer" , "socketAddress" .= String (pack (show sockAddr)) ] - toObject _verb (ND.RunLocalServer localAddress) = mkObject + toObject _verb (ND.RunLocalServer localAddress) = mconcat [ "kind" .= String "RunLocalServer" , "localAddress" .= String (pack (show localAddress)) ] - toObject _verb (ND.UsingSystemdSocket localAddress) = mkObject + toObject _verb (ND.UsingSystemdSocket localAddress) = mconcat [ "kind" .= String "UsingSystemdSocket" , "path" .= String (pack . show $ localAddress) ] - toObject _verb (ND.CreateSystemdSocketForSnocketPath localAddress) = mkObject + toObject _verb (ND.CreateSystemdSocketForSnocketPath localAddress) = mconcat [ "kind" .= String "CreateSystemdSocketForSnocketPath" , "path" .= String (pack . show $ localAddress) ] - toObject _verb (ND.CreatedLocalSocket localAddress) = mkObject + toObject _verb (ND.CreatedLocalSocket localAddress) = mconcat [ "kind" .= String "CreatedLocalSocket" , "path" .= String (pack . show $ localAddress) ] - toObject _verb (ND.ConfiguringLocalSocket localAddress socket) = mkObject + toObject _verb (ND.ConfiguringLocalSocket localAddress socket) = mconcat [ "kind" .= String "ConfiguringLocalSocket" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show socket)) ] - toObject _verb (ND.ListeningLocalSocket localAddress socket) = mkObject + toObject _verb (ND.ListeningLocalSocket localAddress socket) = mconcat [ "kind" .= String "ListeningLocalSocket" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show socket)) ] - toObject _verb (ND.LocalSocketUp localAddress fd) = mkObject + toObject _verb (ND.LocalSocketUp localAddress fd) = mconcat [ "kind" .= String "LocalSocketUp" , "path" .= String (pack . show $ localAddress) , "socket" .= String (pack (show fd)) ] - toObject _verb (ND.CreatingServerSocket socket) = mkObject + toObject _verb (ND.CreatingServerSocket socket) = mconcat [ "kind" .= String "CreatingServerSocket" , "socket" .= String (pack (show socket)) ] - toObject _verb (ND.ListeningServerSocket socket) = mkObject + toObject _verb (ND.ListeningServerSocket socket) = mconcat [ "kind" .= String "ListeningServerSocket" , "socket" .= String (pack (show socket)) ] - toObject _verb (ND.ServerSocketUp socket) = mkObject + toObject _verb (ND.ServerSocketUp socket) = mconcat [ "kind" .= String "ServerSocketUp" , "socket" .= String (pack (show socket)) ] - toObject _verb (ND.ConfiguringServerSocket socket) = mkObject + toObject _verb (ND.ConfiguringServerSocket socket) = mconcat [ "kind" .= String "ConfiguringServerSocket" , "socket" .= String (pack (show socket)) ] - toObject _verb (ND.UnsupportedLocalSystemdSocket path) = mkObject + toObject _verb (ND.UnsupportedLocalSystemdSocket path) = mconcat [ "kind" .= String "UnsupportedLocalSystemdSocket" , "path" .= String (pack (show path)) ] - toObject _verb ND.UnsupportedReadySocketCase = mkObject + toObject _verb ND.UnsupportedReadySocketCase = mconcat [ "kind" .= String "UnsupportedReadySocketCase" ] - toObject _verb (ND.DiffusionErrored exception) = mkObject + toObject _verb (ND.DiffusionErrored exception) = mconcat [ "kind" .= String "DiffusionErrored" , "path" .= String (pack (show exception)) ] instance ToObject (NtC.HandshakeTr LocalAddress NodeToClientVersion) where toObject _verb (WithMuxBearer b ev) = - mkObject [ "kind" .= String "LocalHandshakeTrace" + mconcat [ "kind" .= String "LocalHandshakeTrace" , "bearer" .= show b , "event" .= show ev ] instance ToObject (NtN.HandshakeTr RemoteAddress NodeToNodeVersion) where toObject _verb (WithMuxBearer b ev) = - mkObject [ "kind" .= String "HandshakeTrace" + mconcat [ "kind" .= String "HandshakeTrace" , "bearer" .= show b , "event" .= show ev ] @@ -1084,16 +1084,16 @@ instance Aeson.ToJSONKey LocalAddress where instance ToObject NtN.AcceptConnectionsPolicyTrace where toObject _verb (NtN.ServerTraceAcceptConnectionRateLimiting delay numOfConnections) = - mkObject [ "kind" .= String "ServerTraceAcceptConnectionRateLimiting" + mconcat [ "kind" .= String "ServerTraceAcceptConnectionRateLimiting" , "delay" .= show delay , "numberOfConnection" .= show numOfConnections ] toObject _verb (NtN.ServerTraceAcceptConnectionHardLimit softLimit) = - mkObject [ "kind" .= String "ServerTraceAcceptConnectionHardLimit" + mconcat [ "kind" .= String "ServerTraceAcceptConnectionHardLimit" , "softLimit" .= show softLimit ] toObject _verb (NtN.ServerTraceAcceptConnectionResume numOfConnections) = - mkObject [ "kind" .= String "ServerTraceAcceptConnectionResume" + mconcat [ "kind" .= String "ServerTraceAcceptConnectionResume" , "numberOfConnection" .= show numOfConnections ] @@ -1101,10 +1101,10 @@ instance ToObject NtN.AcceptConnectionsPolicyTrace where instance ConvertRawHash blk => ToObject (Point blk) where toObject _verb GenesisPoint = - mkObject + mconcat [ "kind" .= String "GenesisPoint" ] toObject verb (BlockPoint slot h) = - mkObject + mconcat [ "kind" .= String "BlockPoint" , "slot" .= toJSON (unSlotNo slot) , "headerHash" .= renderHeaderHashForVerbosity (Proxy @blk) verb h @@ -1113,17 +1113,17 @@ instance ConvertRawHash blk instance ToObject SlotNo where toObject _verb slot = - mkObject [ "kind" .= String "SlotNo" + mconcat [ "kind" .= String "SlotNo" , "slot" .= toJSON (unSlotNo slot) ] instance (HasHeader header, ConvertRawHash header) => ToObject (TraceFetchClientState header) where toObject _verb BlockFetch.AddedFetchRequest {} = - mkObject [ "kind" .= String "AddedFetchRequest" ] + mconcat [ "kind" .= String "AddedFetchRequest" ] toObject _verb BlockFetch.AcknowledgedFetchRequest {} = - mkObject [ "kind" .= String "AcknowledgedFetchRequest" ] + mconcat [ "kind" .= String "AcknowledgedFetchRequest" ] toObject _verb (BlockFetch.SendFetchRequest af) = - mkObject [ "kind" .= String "SendFetchRequest" + mconcat [ "kind" .= String "SendFetchRequest" , "head" .= String (renderChainHash (renderHeaderHash (Proxy @header)) (AF.headHash af)) @@ -1139,7 +1139,7 @@ instance (HasHeader header, ConvertRawHash header) (firstHdr AS.:< _, _ AS.:> lastHdr) -> blockNo lastHdr - blockNo firstHdr + 1 toObject _verb (BlockFetch.CompletedBlockFetch pt _ _ _ delay blockSize) = - mkObject [ "kind" .= String "CompletedBlockFetch" + mconcat [ "kind" .= String "CompletedBlockFetch" , "delay" .= (realToFrac delay :: Double) , "size" .= blockSize , "block" .= String @@ -1148,62 +1148,62 @@ instance (HasHeader header, ConvertRawHash header) BlockPoint _ h -> renderHeaderHash (Proxy @header) h) ] toObject _verb BlockFetch.CompletedFetchBatch {} = - mkObject [ "kind" .= String "CompletedFetchBatch" ] + mconcat [ "kind" .= String "CompletedFetchBatch" ] toObject _verb BlockFetch.StartedFetchBatch {} = - mkObject [ "kind" .= String "StartedFetchBatch" ] + mconcat [ "kind" .= String "StartedFetchBatch" ] toObject _verb BlockFetch.RejectedFetchBatch {} = - mkObject [ "kind" .= String "RejectedFetchBatch" ] + mconcat [ "kind" .= String "RejectedFetchBatch" ] toObject _verb (BlockFetch.ClientTerminating outstanding) = - mkObject [ "kind" .= String "ClientTerminating" + mconcat [ "kind" .= String "ClientTerminating" , "outstanding" .= outstanding ] instance (ToObject peer) => ToObject [TraceLabelPeer peer (FetchDecision [Point header])] where - toObject MinimalVerbosity _ = emptyObject - toObject _ [] = emptyObject - toObject _ xs = mkObject + toObject MinimalVerbosity _ = mempty + toObject _ [] = mempty + toObject _ xs = mconcat [ "kind" .= String "PeersFetch" , "peers" .= toJSON (foldl' (\acc x -> toObject MaximalVerbosity x : acc) [] xs) ] instance (ToObject peer, ToObject a) => ToObject (TraceLabelPeer peer a) where toObject verb (TraceLabelPeer peerid a) = - mkObject [ "peer" .= toObject verb peerid ] <> toObject verb a + mconcat [ "peer" .= toObject verb peerid ] <> toObject verb a instance ToObject (AnyMessageAndAgency ps) => ToObject (TraceSendRecv ps) where - toObject verb (TraceSendMsg m) = mkObject + toObject verb (TraceSendMsg m) = mconcat [ "kind" .= String "Send" , "msg" .= toObject verb m ] - toObject verb (TraceRecvMsg m) = mkObject + toObject verb (TraceRecvMsg m) = mconcat [ "kind" .= String "Recv" , "msg" .= toObject verb m ] instance ToObject (TraceTxSubmissionInbound txid tx) where toObject _verb (TraceTxSubmissionCollected count) = - mkObject + mconcat [ "kind" .= String "TxSubmissionCollected" , "count" .= toJSON count ] toObject _verb (TraceTxSubmissionProcessed processed) = - mkObject + mconcat [ "kind" .= String "TxSubmissionProcessed" , "accepted" .= toJSON (ptxcAccepted processed) , "rejected" .= toJSON (ptxcRejected processed) ] toObject _verb TraceTxInboundTerminated = - mkObject + mconcat [ "kind" .= String "TxInboundTerminated" ] toObject _verb (TraceTxInboundCanRequestMoreTxs count) = - mkObject + mconcat [ "kind" .= String "TxInboundCanRequestMoreTxs" , "count" .= toJSON count ] toObject _verb (TraceTxInboundCannotRequestMoreTxs count) = - mkObject + mconcat [ "kind" .= String "TxInboundCannotRequestMoreTxs" , "count" .= toJSON count ] @@ -1229,25 +1229,25 @@ instance Aeson.ToJSON SockAddr where instance (Show txid, Show tx) => ToObject (TraceTxSubmissionOutbound txid tx) where toObject MaximalVerbosity (TraceTxSubmissionOutboundRecvMsgRequestTxs txids) = - mkObject + mconcat [ "kind" .= String "TxSubmissionOutboundRecvMsgRequestTxs" , "txIds" .= String (pack $ show txids) ] toObject _verb (TraceTxSubmissionOutboundRecvMsgRequestTxs _txids) = - mkObject + mconcat [ "kind" .= String "TxSubmissionOutboundRecvMsgRequestTxs" ] toObject MaximalVerbosity (TraceTxSubmissionOutboundSendMsgReplyTxs txs) = - mkObject + mconcat [ "kind" .= String "TxSubmissionOutboundSendMsgReplyTxs" , "txs" .= String (pack $ show txs) ] toObject _verb (TraceTxSubmissionOutboundSendMsgReplyTxs _txs) = - mkObject + mconcat [ "kind" .= String "TxSubmissionOutboundSendMsgReplyTxs" ] toObject _verb (TraceControlMessage controlMessage) = - mkObject + mconcat [ "kind" .= String "ControlMessage" , "controlMessage" .= String (pack $ show controlMessage) ] @@ -1255,7 +1255,7 @@ instance (Show txid, Show tx) instance Show remotePeer => ToObject (TraceKeepAliveClient remotePeer) where toObject _verb (AddSample peer rtt pgsv) = - mkObject + mconcat [ "kind" .= String "KeepAliveClient AddSample" , "address" .= show peer , "rtt" .= rtt @@ -1273,63 +1273,63 @@ instance Show remotePeer => ToObject (TraceKeepAliveClient remotePeer) where instance ToObject TraceLedgerPeers where toObject _verb (PickedPeer addr _ackStake stake) = - mkObject + mconcat [ "kind" .= String "PickedPeer" , "address" .= show addr , "relativeStake" .= (realToFrac (unPoolStake stake) :: Double) ] toObject _verb (PickedPeers (NumberOfPeers n) addrs) = - mkObject + mconcat [ "kind" .= String "PickedPeers" , "desiredCount" .= n , "count" .= length addrs , "addresses" .= show addrs ] toObject _verb (FetchingNewLedgerState cnt) = - mkObject + mconcat [ "kind" .= String "FetchingNewLedgerState" , "numberOfPools" .= cnt ] toObject _verb DisabledLedgerPeers = - mkObject + mconcat [ "kind" .= String "DisabledLedgerPeers" ] toObject _verb (TraceUseLedgerAfter ula) = - mkObject + mconcat [ "kind" .= String "UseLedgerAfter" , "useLedgerAfter" .= UseLedger ula ] toObject _verb WaitingOnRequest = - mkObject + mconcat [ "kind" .= String "WaitingOnRequest" ] toObject _verb (RequestForPeers (NumberOfPeers np)) = - mkObject + mconcat [ "kind" .= String "RequestForPeers" , "numberOfPeers" .= np ] toObject _verb (ReusingLedgerState cnt age) = - mkObject + mconcat [ "kind" .= String "ReusingLedgerState" , "numberOfPools" .= cnt , "ledgerStateAge" .= age ] toObject _verb FallingBackToBootstrapPeers = - mkObject + mconcat [ "kind" .= String "FallingBackToBootstrapPeers" ] instance Show addr => ToObject (WithAddr addr ErrorPolicyTrace) where toObject _verb (WithAddr addr ev) = - mkObject [ "kind" .= String "ErrorPolicyTrace" + mconcat [ "kind" .= String "ErrorPolicyTrace" , "address" .= show addr , "event" .= show ev ] instance ToObject (WithIPList (SubscriptionTrace SockAddr)) where toObject _verb (WithIPList localAddresses dests ev) = - mkObject [ "kind" .= String "WithIPList SubscriptionTrace" + mconcat [ "kind" .= String "WithIPList SubscriptionTrace" , "localAddresses" .= show localAddresses , "dests" .= show dests , "event" .= show ev ] @@ -1337,21 +1337,21 @@ instance ToObject (WithIPList (SubscriptionTrace SockAddr)) where instance ToObject (WithDomainName DnsTrace) where toObject _verb (WithDomainName dom ev) = - mkObject [ "kind" .= String "DnsTrace" + mconcat [ "kind" .= String "DnsTrace" , "domain" .= show dom , "event" .= show ev ] instance ToObject (WithDomainName (SubscriptionTrace SockAddr)) where toObject _verb (WithDomainName dom ev) = - mkObject [ "kind" .= String "SubscriptionTrace" + mconcat [ "kind" .= String "SubscriptionTrace" , "domain" .= show dom , "event" .= show ev ] instance ToObject peer => ToObject (WithMuxBearer peer MuxTrace) where toObject verb (WithMuxBearer b ev) = - mkObject [ "kind" .= String "MuxTrace" + mconcat [ "kind" .= String "MuxTrace" , "bearer" .= toObject verb b , "event" .= show ev ] @@ -1359,30 +1359,30 @@ instance Aeson.ToJSONKey RelayAccessPoint where instance Show exception => ToObject (TraceLocalRootPeers RemoteAddress exception) where toObject _verb (TraceLocalRootDomains groups) = - mkObject [ "kind" .= String "LocalRootDomains" + mconcat [ "kind" .= String "LocalRootDomains" , "localRootDomains" .= toJSON groups ] toObject _verb (TraceLocalRootWaiting d dt) = - mkObject [ "kind" .= String "LocalRootWaiting" + mconcat [ "kind" .= String "LocalRootWaiting" , "domainAddress" .= toJSON d , "diffTime" .= show dt ] toObject _verb (TraceLocalRootResult d res) = - mkObject [ "kind" .= String "LocalRootResult" + mconcat [ "kind" .= String "LocalRootResult" , "domainAddress" .= toJSON d , "result" .= Aeson.toJSONList res ] toObject _verb (TraceLocalRootGroups groups) = - mkObject [ "kind" .= String "LocalRootGroups" + mconcat [ "kind" .= String "LocalRootGroups" , "localRootGroups" .= toJSON groups ] toObject _verb (TraceLocalRootFailure d dexception) = - mkObject [ "kind" .= String "LocalRootFailure" + mconcat [ "kind" .= String "LocalRootFailure" , "domainAddress" .= toJSON d , "reason" .= show dexception ] toObject _verb (TraceLocalRootError d dexception) = - mkObject [ "kind" .= String "LocalRootError" + mconcat [ "kind" .= String "LocalRootError" , "domainAddress" .= toJSON d , "reason" .= show dexception ] @@ -1392,20 +1392,20 @@ instance ToJSON IP where instance ToObject TracePublicRootPeers where toObject _verb (TracePublicRootRelayAccessPoint relays) = - mkObject [ "kind" .= String "PublicRootRelayAddresses" + mconcat [ "kind" .= String "PublicRootRelayAddresses" , "relayAddresses" .= Aeson.toJSONList relays ] toObject _verb (TracePublicRootDomains domains) = - mkObject [ "kind" .= String "PublicRootDomains" + mconcat [ "kind" .= String "PublicRootDomains" , "domainAddresses" .= Aeson.toJSONList domains ] toObject _verb (TracePublicRootResult b res) = - mkObject [ "kind" .= String "PublicRootResult" + mconcat [ "kind" .= String "PublicRootResult" , "domain" .= show b , "result" .= Aeson.toJSONList res ] toObject _verb (TracePublicRootFailure b d) = - mkObject [ "kind" .= String "PublicRootFailure" + mconcat [ "kind" .= String "PublicRootFailure" , "domain" .= show b , "reason" .= show d ] @@ -1437,63 +1437,63 @@ instance ToJSON PeerSelectionTargets where instance ToObject (TracePeerSelection SockAddr) where toObject _verb (TraceLocalRootPeersChanged lrp lrp') = - mkObject [ "kind" .= String "LocalRootPeersChanged" + mconcat [ "kind" .= String "LocalRootPeersChanged" , "previous" .= toJSON lrp , "current" .= toJSON lrp' ] toObject _verb (TraceTargetsChanged pst pst') = - mkObject [ "kind" .= String "TargetsChanged" + mconcat [ "kind" .= String "TargetsChanged" , "previous" .= toJSON pst , "current" .= toJSON pst' ] toObject _verb (TracePublicRootsRequest tRootPeers nRootPeers) = - mkObject [ "kind" .= String "PublicRootsRequest" + mconcat [ "kind" .= String "PublicRootsRequest" , "targetNumberOfRootPeers" .= tRootPeers , "numberOfRootPeers" .= nRootPeers ] toObject _verb (TracePublicRootsResults res group dt) = - mkObject [ "kind" .= String "PublicRootsResults" + mconcat [ "kind" .= String "PublicRootsResults" , "result" .= Aeson.toJSONList (toList res) , "group" .= group , "diffTime" .= dt ] toObject _verb (TracePublicRootsFailure err group dt) = - mkObject [ "kind" .= String "PublicRootsFailure" + mconcat [ "kind" .= String "PublicRootsFailure" , "reason" .= show err , "group" .= group , "diffTime" .= dt ] toObject _verb (TraceGossipRequests targetKnown actualKnown aps sps) = - mkObject [ "kind" .= String "GossipRequests" + mconcat [ "kind" .= String "GossipRequests" , "targetKnown" .= targetKnown , "actualKnown" .= actualKnown , "availablePeers" .= Aeson.toJSONList (toList aps) , "selectedPeers" .= Aeson.toJSONList (toList sps) ] toObject _verb (TraceGossipResults res) = - mkObject [ "kind" .= String "GossipResults" + mconcat [ "kind" .= String "GossipResults" , "result" .= Aeson.toJSONList (map ( bimap show id <$> ) res) ] toObject _verb (TraceForgetColdPeers targetKnown actualKnown sp) = - mkObject [ "kind" .= String "ForgeColdPeers" + mconcat [ "kind" .= String "ForgeColdPeers" , "targetKnown" .= targetKnown , "actualKnown" .= actualKnown , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TracePromoteColdPeers targetKnown actualKnown sp) = - mkObject [ "kind" .= String "PromoteColdPeers" + mconcat [ "kind" .= String "PromoteColdPeers" , "targetEstablished" .= targetKnown , "actualEstablished" .= actualKnown , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TracePromoteColdLocalPeers tLocalEst aLocalEst sp) = - mkObject [ "kind" .= String "PromoteColdLocalPeers" + mconcat [ "kind" .= String "PromoteColdLocalPeers" , "targetLocalEstablished" .= tLocalEst , "actualLocalEstablished" .= aLocalEst , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TracePromoteColdFailed tEst aEst p d err) = - mkObject [ "kind" .= String "PromoteColdFailed" + mconcat [ "kind" .= String "PromoteColdFailed" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p @@ -1501,97 +1501,97 @@ instance ToObject (TracePeerSelection SockAddr) where , "reason" .= show err ] toObject _verb (TracePromoteColdDone tEst aEst p) = - mkObject [ "kind" .= String "PromoteColdDone" + mconcat [ "kind" .= String "PromoteColdDone" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p ] toObject _verb (TracePromoteWarmPeers tActive aActive sp) = - mkObject [ "kind" .= String "PromoteWarmPeers" + mconcat [ "kind" .= String "PromoteWarmPeers" , "targetActive" .= tActive , "actualActive" .= aActive , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TracePromoteWarmLocalPeers taa sp) = - mkObject [ "kind" .= String "PromoteWarmLocalPeers" + mconcat [ "kind" .= String "PromoteWarmLocalPeers" , "targetActualActive" .= Aeson.toJSONList taa , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TracePromoteWarmFailed tActive aActive p err) = - mkObject [ "kind" .= String "PromoteWarmFailed" + mconcat [ "kind" .= String "PromoteWarmFailed" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p , "reason" .= show err ] toObject _verb (TracePromoteWarmDone tActive aActive p) = - mkObject [ "kind" .= String "PromoteWarmDone" + mconcat [ "kind" .= String "PromoteWarmDone" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p ] toObject _verb (TracePromoteWarmAborted tActive aActive p) = - mkObject [ "kind" .= String "PromoteWarmAborted" + mconcat [ "kind" .= String "PromoteWarmAborted" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p ] toObject _verb (TraceDemoteWarmPeers tEst aEst sp) = - mkObject [ "kind" .= String "DemoteWarmPeers" + mconcat [ "kind" .= String "DemoteWarmPeers" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TraceDemoteWarmFailed tEst aEst p err) = - mkObject [ "kind" .= String "DemoteWarmFailed" + mconcat [ "kind" .= String "DemoteWarmFailed" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p , "reason" .= show err ] toObject _verb (TraceDemoteWarmDone tEst aEst p) = - mkObject [ "kind" .= String "DemoteWarmDone" + mconcat [ "kind" .= String "DemoteWarmDone" , "targetEstablished" .= tEst , "actualEstablished" .= aEst , "peer" .= toJSON p ] toObject _verb (TraceDemoteHotPeers tActive aActive sp) = - mkObject [ "kind" .= String "DemoteHotPeers" + mconcat [ "kind" .= String "DemoteHotPeers" , "targetActive" .= tActive , "actualActive" .= aActive , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TraceDemoteLocalHotPeers taa sp) = - mkObject [ "kind" .= String "DemoteLocalHotPeers" + mconcat [ "kind" .= String "DemoteLocalHotPeers" , "targetActualActive" .= Aeson.toJSONList taa , "selectedPeers" .= Aeson.toJSONList (toList sp) ] toObject _verb (TraceDemoteHotFailed tActive aActive p err) = - mkObject [ "kind" .= String "DemoteHotFailed" + mconcat [ "kind" .= String "DemoteHotFailed" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p , "reason" .= show err ] toObject _verb (TraceDemoteHotDone tActive aActive p) = - mkObject [ "kind" .= String "DemoteHotDone" + mconcat [ "kind" .= String "DemoteHotDone" , "targetActive" .= tActive , "actualActive" .= aActive , "peer" .= toJSON p ] toObject _verb (TraceDemoteAsynchronous msp) = - mkObject [ "kind" .= String "DemoteAsynchronous" + mconcat [ "kind" .= String "DemoteAsynchronous" , "state" .= toJSON msp ] toObject _verb TraceGovernorWakeup = - mkObject [ "kind" .= String "GovernorWakeup" + mconcat [ "kind" .= String "GovernorWakeup" ] toObject _verb (TraceChurnWait dt) = - mkObject [ "kind" .= String "ChurnWait" + mconcat [ "kind" .= String "ChurnWait" , "diffTime" .= toJSON dt ] toObject _verb (TraceChurnMode c) = - mkObject [ "kind" .= String "ChurnMode" + mconcat [ "kind" .= String "ChurnMode" , "event" .= show c ] -- Connection manager abstract state. For explanation of each state see @@ -1640,7 +1640,7 @@ peerSelectionTargetsToObject targetNumberOfEstablishedPeers, targetNumberOfActivePeers } = Object $ - mkObject [ "roots" .= targetNumberOfRootPeers + mconcat [ "roots" .= targetNumberOfRootPeers , "knownPeers" .= targetNumberOfKnownPeers , "established" .= targetNumberOfEstablishedPeers , "active" .= targetNumberOfActivePeers @@ -1650,18 +1650,18 @@ instance Show peerConn => ToObject (DebugPeerSelection SockAddr peerConn) where toObject verb (TraceGovernorState blockedAt wakeupAfter PeerSelectionState { targets, knownPeers, establishedPeers, activePeers }) | verb <= NormalVerbosity = - mkObject [ "kind" .= String "DebugPeerSelection" + mconcat [ "kind" .= String "DebugPeerSelection" , "blockedAt" .= String (pack $ show blockedAt) , "wakeupAfter" .= String (pack $ show wakeupAfter) , "targets" .= peerSelectionTargetsToObject targets , "numberOfPeers" .= - Object (mkObject [ "known" .= KnownPeers.size knownPeers + Object (mconcat [ "known" .= KnownPeers.size knownPeers , "established" .= EstablishedPeers.size establishedPeers , "active" .= Set.size activePeers ]) ] toObject _ (TraceGovernorState blockedAt wakeupAfter ev) = - mkObject [ "kind" .= String "DebugPeerSelection" + mconcat [ "kind" .= String "DebugPeerSelection" , "blockedAt" .= String (pack $ show blockedAt) , "wakeupAfter" .= String (pack $ show wakeupAfter) , "peerSelectionState" .= String (pack $ show ev) @@ -1671,28 +1671,28 @@ instance Show peerConn => ToObject (DebugPeerSelection SockAddr peerConn) where -- For that an export is needed at ouroboros-network instance ToObject (PeerSelectionActionsTrace SockAddr) where toObject _verb (PeerStatusChanged ps) = - mkObject [ "kind" .= String "PeerStatusChanged" + mconcat [ "kind" .= String "PeerStatusChanged" , "peerStatusChangeType" .= show ps ] toObject _verb (PeerStatusChangeFailure ps f) = - mkObject [ "kind" .= String "PeerStatusChangeFailure" + mconcat [ "kind" .= String "PeerStatusChangeFailure" , "peerStatusChangeType" .= show ps , "reason" .= show f ] toObject _verb (PeerMonitoringError connId s) = - mkObject [ "kind" .= String "PeerMonitoridngError" + mconcat [ "kind" .= String "PeerMonitoridngError" , "connectionId" .= toJSON connId , "reason" .= show s ] toObject _verb (PeerMonitoringResult connId wf) = - mkObject [ "kind" .= String "PeerMonitoringResult" + mconcat [ "kind" .= String "PeerMonitoringResult" , "connectionId" .= toJSON connId , "withProtocolTemp" .= show wf ] instance ToObject PeerSelectionCounters where toObject _verb ev = - mkObject [ "kind" .= String "PeerSelectionCounters" + mconcat [ "kind" .= String "PeerSelectionCounters" , "coldPeers" .= coldPeers ev , "warmPeers" .= warmPeers ev , "hotPeers" .= hotPeers ev @@ -1783,23 +1783,23 @@ instance ToJSON NodeToClientVersionData where instance (Show versionNumber, ToJSON versionNumber, ToJSON agreedOptions) => ToObject (ConnectionHandlerTrace versionNumber agreedOptions) where toObject _verb (TrHandshakeSuccess versionNumber agreedOptions) = - mkObject + mconcat [ "kind" .= String "HandshakeSuccess" , "versionNumber" .= toJSON versionNumber , "agreedOptions" .= toJSON agreedOptions ] toObject _verb (TrHandshakeClientError err) = - mkObject + mconcat [ "kind" .= String "HandshakeClientError" , "reason" .= toJSON err ] toObject _verb (TrHandshakeServerError err) = - mkObject + mconcat [ "kind" .= String "HandshakeServerError" , "reason" .= toJSON err ] toObject _verb (TrError e err cerr) = - mkObject + mconcat [ "kind" .= String "Error" , "context" .= show e , "reason" .= show err @@ -1812,124 +1812,124 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, toObject verb ev = case ev of TrIncludeConnection prov peerAddr -> - mkObject $ reverse + mconcat $ reverse [ "kind" .= String "IncludeConnection" , "remoteAddress" .= toObject verb peerAddr , "provenance" .= String (pack . show $ prov) ] TrUnregisterConnection prov peerAddr -> - mkObject $ reverse + mconcat $ reverse [ "kind" .= String "UnregisterConnection" , "remoteAddress" .= toObject verb peerAddr , "provenance" .= String (pack . show $ prov) ] TrConnect (Just localAddress) remoteAddress -> - mkObject + mconcat [ "kind" .= String "ConnectTo" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } ] TrConnect Nothing remoteAddress -> - mkObject + mconcat [ "kind" .= String "ConnectTo" , "remoteAddress" .= toObject verb remoteAddress ] TrConnectError (Just localAddress) remoteAddress err -> - mkObject + mconcat [ "kind" .= String "ConnectError" , "connectionId" .= toJSON ConnectionId { localAddress, remoteAddress } , "reason" .= String (pack . show $ err) ] TrConnectError Nothing remoteAddress err -> - mkObject + mconcat [ "kind" .= String "ConnectError" , "remoteAddress" .= toObject verb remoteAddress , "reason" .= String (pack . show $ err) ] TrTerminatingConnection prov connId -> - mkObject + mconcat [ "kind" .= String "TerminatingConnection" , "provenance" .= String (pack . show $ prov) , "connectionId" .= toJSON connId ] TrTerminatedConnection prov remoteAddress -> - mkObject + mconcat [ "kind" .= String "TerminatedConnection" , "provenance" .= String (pack . show $ prov) , "remoteAddress" .= toObject verb remoteAddress ] TrConnectionHandler connId a -> - mkObject + mconcat [ "kind" .= String "ConnectionHandler" , "connectionId" .= toJSON connId , "connectionHandler" .= toObject verb a ] TrShutdown -> - mkObject + mconcat [ "kind" .= String "Shutdown" ] TrConnectionExists prov remoteAddress inState -> - mkObject + mconcat [ "kind" .= String "ConnectionExists" , "provenance" .= String (pack . show $ prov) , "remoteAddress" .= toObject verb remoteAddress , "state" .= toJSON inState ] TrForbiddenConnection connId -> - mkObject + mconcat [ "kind" .= String "ForbiddenConnection" , "connectionId" .= toJSON connId ] TrImpossibleConnection connId -> - mkObject + mconcat [ "kind" .= String "ImpossibleConnection" , "connectionId" .= toJSON connId ] TrConnectionFailure connId -> - mkObject + mconcat [ "kind" .= String "ConnectionFailure" , "connectionId" .= toJSON connId ] TrConnectionNotFound prov remoteAddress -> - mkObject + mconcat [ "kind" .= String "ConnectionNotFound" , "remoteAddress" .= toObject verb remoteAddress , "provenance" .= String (pack . show $ prov) ] TrForbiddenOperation remoteAddress connState -> - mkObject + mconcat [ "kind" .= String "ForbiddenOperation" , "remoteAddress" .= toObject verb remoteAddress , "connectionState" .= toJSON connState ] TrPruneConnections pruningSet numberPruned chosenPeers -> - mkObject + mconcat [ "kind" .= String "PruneConnections" , "prunedPeers" .= toJSON pruningSet , "numberPrunedPeers" .= toJSON numberPruned , "choiceSet" .= toJSON (toObject verb `Set.map` chosenPeers) ] TrConnectionCleanup connId -> - mkObject + mconcat [ "kind" .= String "ConnectionCleanup" , "connectionId" .= toJSON connId ] TrConnectionTimeWait connId -> - mkObject + mconcat [ "kind" .= String "ConnectionTimeWait" , "connectionId" .= toJSON connId ] TrConnectionTimeWaitDone connId -> - mkObject + mconcat [ "kind" .= String "ConnectionTimeWaitDone" , "connectionId" .= toJSON connId ] TrConnectionManagerCounters cmCounters -> - mkObject + mconcat [ "kind" .= String "ConnectionManagerCounters" , "state" .= toJSON cmCounters ] TrState cmState -> - mkObject + mconcat [ "kind" .= String "ConnectionManagerState" , "state" .= listValue (\(addr, connState) -> Aeson.object @@ -1939,7 +1939,7 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, (Map.toList cmState) ] ConnMgr.TrUnexpectedlyFalseAssertion info -> - mkObject + mconcat [ "kind" .= String "UnexpectedlyFalseAssertion" , "info" .= String (pack . show $ info) ] @@ -1963,7 +1963,7 @@ instance ToJSON state => ToJSON (ConnMgr.MaybeUnknown state) where instance (Show addr, ToObject addr, ToJSON addr) => ToObject (ConnMgr.AbstractTransitionTrace addr) where toObject _verb (ConnMgr.TransitionTrace addr tr) = - mkObject [ "kind" .= String "ConnectionManagerTransition" + mconcat [ "kind" .= String "ConnectionManagerTransition" , "address" .= toJSON addr , "from" .= toJSON (ConnMgr.fromState tr) , "to" .= toJSON (ConnMgr.toState tr) @@ -1972,26 +1972,26 @@ instance (Show addr, ToObject addr, ToJSON addr) instance (Show addr, ToObject addr, ToJSON addr) => ToObject (ServerTrace addr) where toObject verb (TrAcceptConnection peerAddr) = - mkObject [ "kind" .= String "AcceptConnection" + mconcat [ "kind" .= String "AcceptConnection" , "address" .= toObject verb peerAddr ] toObject _verb (TrAcceptError exception) = - mkObject [ "kind" .= String "AcceptErroor" + mconcat [ "kind" .= String "AcceptErroor" , "reason" .= show exception ] toObject verb (TrAcceptPolicyTrace policyTrace) = - mkObject [ "kind" .= String "AcceptPolicyTrace" + mconcat [ "kind" .= String "AcceptPolicyTrace" , "policy" .= toObject verb policyTrace ] toObject verb (TrServerStarted peerAddrs) = - mkObject [ "kind" .= String "AcceptPolicyTrace" + mconcat [ "kind" .= String "AcceptPolicyTrace" , "addresses" .= toJSON (toObject verb `map` peerAddrs) ] toObject _verb TrServerStopped = - mkObject [ "kind" .= String "ServerStopped" + mconcat [ "kind" .= String "ServerStopped" ] toObject _verb (TrServerError exception) = - mkObject [ "kind" .= String "ServerError" + mconcat [ "kind" .= String "ServerError" , "reason" .= show exception ] @@ -2023,123 +2023,123 @@ instance ToJSON addr => Aeson.ToJSONKey (ConnectionId addr) where instance ToObject NtN.RemoteAddress where toObject _verb (SockAddrInet port addr) = let ip = IP.fromHostAddress addr in - mkObject [ "addr" .= show ip + mconcat [ "addr" .= show ip , "port" .= show port ] toObject _verb (SockAddrInet6 port _ addr _) = let ip = IP.fromHostAddress6 addr in - mkObject [ "addr" .= show ip + mconcat [ "addr" .= show ip , "port" .= show port ] toObject _verb (SockAddrUnix path) = - mkObject [ "path" .= show path ] + mconcat [ "path" .= show path ] instance ToObject NtN.RemoteConnectionId where toObject verb (NtN.ConnectionId l r) = - mkObject [ "local" .= toObject verb l + mconcat [ "local" .= toObject verb l , "remote" .= toObject verb r ] instance ToObject LocalAddress where toObject _verb (LocalAddress path) = - mkObject ["path" .= path] + mconcat ["path" .= path] instance ToObject NtC.LocalConnectionId where toObject verb (NtC.ConnectionId l r) = - mkObject [ "local" .= toObject verb l + mconcat [ "local" .= toObject verb l , "remote" .= toObject verb r ] instance (ToJSON addr, Show addr) => ToObject (InboundGovernorTrace addr) where toObject _verb (TrNewConnection p connId) = - mkObject [ "kind" .= String "NewConnection" + mconcat [ "kind" .= String "NewConnection" , "provenance" .= show p , "connectionId" .= toJSON connId ] toObject _verb (TrResponderRestarted connId m) = - mkObject [ "kind" .= String "ResponderStarted" + mconcat [ "kind" .= String "ResponderStarted" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] toObject _verb (TrResponderStartFailure connId m s) = - mkObject [ "kind" .= String "ResponderStartFailure" + mconcat [ "kind" .= String "ResponderStartFailure" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m , "reason" .= show s ] toObject _verb (TrResponderErrored connId m s) = - mkObject [ "kind" .= String "ResponderErrored" + mconcat [ "kind" .= String "ResponderErrored" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m , "reason" .= show s ] toObject _verb (TrResponderStarted connId m) = - mkObject [ "kind" .= String "ResponderStarted" + mconcat [ "kind" .= String "ResponderStarted" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] toObject _verb (TrResponderTerminated connId m) = - mkObject [ "kind" .= String "ResponderTerminated" + mconcat [ "kind" .= String "ResponderTerminated" , "connectionId" .= toJSON connId , "miniProtocolNum" .= toJSON m ] toObject _verb (TrPromotedToWarmRemote connId opRes) = - mkObject [ "kind" .= String "PromotedToWarmRemote" + mconcat [ "kind" .= String "PromotedToWarmRemote" , "connectionId" .= toJSON connId , "result" .= toJSON opRes ] toObject _verb (TrPromotedToHotRemote connId) = - mkObject [ "kind" .= String "PromotedToHotRemote" + mconcat [ "kind" .= String "PromotedToHotRemote" , "connectionId" .= toJSON connId ] toObject _verb (TrDemotedToColdRemote connId od) = - mkObject [ "kind" .= String "DemotedToColdRemote" + mconcat [ "kind" .= String "DemotedToColdRemote" , "connectionId" .= toJSON connId , "result" .= show od ] toObject _verb (TrDemotedToWarmRemote connId) = - mkObject [ "kind" .= String "DemotedToWarmRemote" + mconcat [ "kind" .= String "DemotedToWarmRemote" , "connectionId" .= toJSON connId ] toObject _verb (TrWaitIdleRemote connId opRes) = - mkObject [ "kind" .= String "WaitIdleRemote" + mconcat [ "kind" .= String "WaitIdleRemote" , "connectionId" .= toJSON connId , "result" .= toJSON opRes ] toObject _verb (TrMuxCleanExit connId) = - mkObject [ "kind" .= String "MuxCleanExit" + mconcat [ "kind" .= String "MuxCleanExit" , "connectionId" .= toJSON connId ] toObject _verb (TrMuxErrored connId s) = - mkObject [ "kind" .= String "MuxErrored" + mconcat [ "kind" .= String "MuxErrored" , "connectionId" .= toJSON connId , "reason" .= show s ] toObject _verb (TrInboundGovernorCounters counters) = - mkObject [ "kind" .= String "InboundGovernorCounters" + mconcat [ "kind" .= String "InboundGovernorCounters" , "idlePeers" .= idlePeersRemote counters , "coldPeers" .= coldPeersRemote counters , "warmPeers" .= warmPeersRemote counters , "hotPeers" .= hotPeersRemote counters ] toObject _verb (TrRemoteState st) = - mkObject [ "kind" .= String "RemoteState" + mconcat [ "kind" .= String "RemoteState" , "remoteSt" .= toJSON st ] toObject _verb (InboundGovernor.TrUnexpectedlyFalseAssertion info) = - mkObject [ "kind" .= String "UnexpectedlyFalseAssertion" + mconcat [ "kind" .= String "UnexpectedlyFalseAssertion" , "remoteSt" .= String (pack . show $ info) ] toObject _verb (InboundGovernor.TrInboundGovernorError err) = - mkObject [ "kind" .= String "InboundGovernorError" + mconcat [ "kind" .= String "InboundGovernorError" , "remoteSt" .= String (pack . show $ err) ] instance ToJSON addr => ToObject (Server.RemoteTransitionTrace addr) where toObject _verb (ConnMgr.TransitionTrace addr tr) = - mkObject [ "kind" .= String "InboundGovernorTransition" + mconcat [ "kind" .= String "InboundGovernorTransition" , "address" .= toJSON addr , "from" .= toJSON (ConnMgr.fromState tr) , "to" .= toJSON (ConnMgr.toState tr) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index b99ee6558bb..69b5b7b9b8d 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -22,7 +22,6 @@ import Cardano.Prelude import Data.Aeson (Value (..), object) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson -import qualified Data.HashMap.Strict as HMS import qualified Data.Set as Set import qualified Data.Text as Text @@ -53,7 +52,7 @@ import qualified Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo import Cardano.Ledger.Alonzo.Rules.Bbody (AlonzoBbodyPredFail) import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo import qualified Cardano.Ledger.Alonzo.Rules.Utxos as Alonzo -import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoPredFail (..)) +import Cardano.Ledger.Alonzo.Rules.Utxow (UtxowPredicateFail (..)) import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo import qualified Cardano.Ledger.AuxiliaryData as Core @@ -97,6 +96,7 @@ import Cardano.Ledger.Shelley.Rules.Utxow import Cardano.Protocol.TPraos.API (ChainTransitionError (ChainTransitionError)) import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod)) import Cardano.Protocol.TPraos.Rules.Prtcl +import qualified Data.Aeson.Key as Aeson {- HLINT ignore "Use :" -} @@ -107,13 +107,13 @@ import Cardano.Protocol.TPraos.Rules.Prtcl -- NOTE: this list is sorted in roughly topological order. instance ShelleyBasedEra era => ToObject (GenTx (ShelleyBlock era)) where - toObject _ tx = mkObject [ "txid" .= Text.take 8 (renderTxId (txId tx)) ] + toObject _ tx = mconcat [ "txid" .= Text.take 8 (renderTxId (txId tx)) ] instance ToJSON (SupportsMempool.TxId (GenTx (ShelleyBlock era))) where toJSON = String . Text.take 8 . renderTxId instance ShelleyBasedEra era => ToObject (Header (ShelleyBlock era)) where - toObject _verb b = mkObject + toObject _verb b = mconcat [ "kind" .= String "ShelleyBlock" , "hash" .= condense (blockHash b) , "slotNo" .= condense (blockSlot b) @@ -127,17 +127,17 @@ instance ( ShelleyBasedEra era , ToObject (PredicateFailure (Core.EraRule "LEDGER" era)) ) => ToObject (ApplyTxError era) where toObject verb (ApplyTxError predicateFailures) = - HMS.unions $ map (toObject verb) predicateFailures + mconcat $ map (toObject verb) predicateFailures instance Core.Crypto crypto => ToObject (TPraosCannotForge crypto) where toObject _verb (TPraosCannotForgeKeyNotUsableYet wallClockPeriod keyStartPeriod) = - mkObject + mconcat [ "kind" .= String "TPraosCannotForgeKeyNotUsableYet" , "keyStart" .= keyStartPeriod , "wallClock" .= wallClockPeriod ] toObject _verb (TPraosCannotForgeWrongVRF genDlgVRFHash coreNodeVRFHash) = - mkObject + mconcat [ "kind" .= String "TPraosCannotLeadWrongVRF" , "expected" .= genDlgVRFHash , "actual" .= coreNodeVRFHash @@ -147,7 +147,7 @@ deriving newtype instance ToJSON KESPeriod instance ToObject HotKey.KESInfo where toObject _verb HotKey.KESInfo { kesStartPeriod, kesEndPeriod, kesEvolution } = - mkObject + mconcat [ "kind" .= String "KESInfo" , "startPeriod" .= kesStartPeriod , "endPeriod" .= kesEndPeriod @@ -156,13 +156,13 @@ instance ToObject HotKey.KESInfo where instance ToObject HotKey.KESEvolutionError where toObject verb (HotKey.KESCouldNotEvolve kesInfo targetPeriod) = - mkObject + mconcat [ "kind" .= String "KESCouldNotEvolve" , "kesInfo" .= toObject verb kesInfo , "targetPeriod" .= targetPeriod ] toObject verb (HotKey.KESKeyAlreadyPoisoned kesInfo targetPeriod) = - mkObject + mconcat [ "kind" .= String "KESKeyAlreadyPoisoned" , "kesInfo" .= toObject verb kesInfo , "targetPeriod" .= targetPeriod @@ -174,7 +174,7 @@ instance ( ShelleyBasedEra era , ToObject (PredicateFailure (Core.EraRule "BBODY" era)) ) => ToObject (ShelleyLedgerError era) where toObject verb (BBodyError (BlockTransitionError fs)) = - mkObject [ "kind" .= String "BBodyError" + mconcat [ "kind" .= String "BBodyError" , "failures" .= map (toObject verb) fs ] @@ -182,50 +182,50 @@ instance ( ShelleyBasedEra era , ToJSON (Ledger.PParamsDelta era) ) => ToObject (ShelleyLedgerUpdate era) where toObject verb (ShelleyUpdatedProtocolUpdates updates) = - mkObject [ "kind" .= String "ShelleyUpdatedProtocolUpdates" + mconcat [ "kind" .= String "ShelleyUpdatedProtocolUpdates" , "updates" .= map (toObject verb) updates ] instance (Ledger.Era era, ToJSON (Ledger.PParamsDelta era)) => ToObject (ProtocolUpdate era) where toObject verb ProtocolUpdate{protocolUpdateProposal, protocolUpdateState} = - mkObject [ "proposal" .= toObject verb protocolUpdateProposal + mconcat [ "proposal" .= toObject verb protocolUpdateProposal , "state" .= toObject verb protocolUpdateState ] instance ToJSON (Ledger.PParamsDelta era) => ToObject (UpdateProposal era) where toObject _verb UpdateProposal{proposalParams, proposalVersion, proposalEpoch} = - mkObject [ "params" .= proposalParams + mconcat [ "params" .= proposalParams , "version" .= proposalVersion , "epoch" .= proposalEpoch ] instance Core.Crypto crypto => ToObject (UpdateState crypto) where toObject _verb UpdateState{proposalVotes, proposalReachedQuorum} = - mkObject [ "proposal" .= proposalVotes + mconcat [ "proposal" .= proposalVotes , "reachedQuorum" .= proposalReachedQuorum ] instance Core.Crypto crypto => ToObject (ChainTransitionError crypto) where toObject verb (ChainTransitionError fs) = - mkObject [ "kind" .= String "ChainTransitionError" + mconcat [ "kind" .= String "ChainTransitionError" , "failures" .= map (toObject verb) fs ] instance ToObject ChainPredicateFailure where toObject _verb (HeaderSizeTooLargeCHAIN hdrSz maxHdrSz) = - mkObject [ "kind" .= String "HeaderSizeTooLarge" + mconcat [ "kind" .= String "HeaderSizeTooLarge" , "headerSize" .= hdrSz , "maxHeaderSize" .= maxHdrSz ] toObject _verb (BlockSizeTooLargeCHAIN blkSz maxBlkSz) = - mkObject [ "kind" .= String "BlockSizeTooLarge" + mconcat [ "kind" .= String "BlockSizeTooLarge" , "blockSize" .= blkSz , "maxBlockSize" .= maxBlkSz ] toObject _verb (ObsoleteNodeCHAIN currentPtcl supportedPtcl) = - mkObject [ "kind" .= String "ObsoleteNode" + mconcat [ "kind" .= String "ObsoleteNode" , "explanation" .= String explanation , "currentProtocol" .= currentPtcl , "supportedProtocol" .= supportedPtcl ] @@ -238,17 +238,17 @@ instance ToObject ChainPredicateFailure where instance ToObject (PrtlSeqFailure crypto) where toObject _verb (WrongSlotIntervalPrtclSeq (SlotNo lastSlot) (SlotNo currSlot)) = - mkObject [ "kind" .= String "WrongSlotInterval" + mconcat [ "kind" .= String "WrongSlotInterval" , "lastSlot" .= lastSlot , "currentSlot" .= currSlot ] toObject _verb (WrongBlockNoPrtclSeq lab currentBlockNo) = - mkObject [ "kind" .= String "WrongBlockNo" + mconcat [ "kind" .= String "WrongBlockNo" , "lastAppliedBlockNo" .= showLastAppBlockNo lab , "currentBlockNo" .= (String . textShow $ unBlockNo currentBlockNo) ] toObject _verb (WrongBlockSequencePrtclSeq lastAppliedHash currentHash) = - mkObject [ "kind" .= String "WrongBlockSequence" + mconcat [ "kind" .= String "WrongBlockSequence" , "lastAppliedBlockHash" .= String (textShow lastAppliedHash) , "currentBlockHash" .= String (textShow currentHash) ] @@ -260,12 +260,12 @@ instance ( ShelleyBasedEra era , ToObject (PredicateFailure (Core.EraRule "LEDGERS" era)) ) => ToObject (BbodyPredicateFailure era) where toObject _verb (WrongBlockBodySizeBBODY actualBodySz claimedBodySz) = - mkObject [ "kind" .= String "WrongBlockBodySizeBBODY" + mconcat [ "kind" .= String "WrongBlockBodySizeBBODY" , "actualBlockBodySize" .= actualBodySz , "claimedBlockBodySize" .= claimedBodySz ] toObject _verb (InvalidBodyHashBBODY actualHash claimedHash) = - mkObject [ "kind" .= String "InvalidBodyHashBBODY" + mconcat [ "kind" .= String "InvalidBodyHashBBODY" , "actualBodyHash" .= textShow actualHash , "claimedBodyHash" .= textShow claimedHash ] @@ -289,40 +289,40 @@ instance ( ShelleyBasedEra era toObject verb (UtxowFailure f) = toObject verb f toObject verb (DelegsFailure f) = toObject verb f -instance ToObject (AlonzoPredFail (Alonzo.AlonzoEra StandardCrypto)) where +instance ToObject (UtxowPredicateFail (Alonzo.AlonzoEra StandardCrypto)) where toObject v (WrappedShelleyEraFailure utxoPredFail) = toObject v utxoPredFail toObject _ (MissingRedeemers scripts) = - mkObject [ "kind" .= String "MissingRedeemers" + mconcat [ "kind" .= String "MissingRedeemers" , "scripts" .= renderMissingRedeemers scripts ] toObject _ (MissingRequiredDatums required received) = - mkObject [ "kind" .= String "MissingRequiredDatums" + mconcat [ "kind" .= String "MissingRequiredDatums" , "required" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList required) , "received" .= map (Crypto.hashToTextAsHex . SafeHash.extractHash) (Set.toList received) ] toObject _ (PPViewHashesDontMatch ppHashInTxBody ppHashFromPParams) = - mkObject [ "kind" .= String "PPViewHashesDontMatch" + mconcat [ "kind" .= String "PPViewHashesDontMatch" , "fromTxBody" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashInTxBody) , "fromPParams" .= renderScriptIntegrityHash (strictMaybeToMaybe ppHashFromPParams) ] toObject _ (MissingRequiredSigners missingKeyWitnesses) = - mkObject [ "kind" .= String "MissingRequiredSigners" + mconcat [ "kind" .= String "MissingRequiredSigners" , "witnesses" .= Set.toList missingKeyWitnesses ] toObject _ (UnspendableUTxONoDatumHash txins) = - mkObject [ "kind" .= String "MissingRequiredSigners" + mconcat [ "kind" .= String "MissingRequiredSigners" , "txins" .= Set.toList txins ] toObject _ (NonOutputSupplimentaryDatums disallowed acceptable) = - mkObject [ "kind" .= String "NonOutputSupplimentaryDatums" + mconcat [ "kind" .= String "NonOutputSupplimentaryDatums" , "disallowed" .= Set.toList disallowed , "acceptable" .= Set.toList acceptable ] toObject _ (ExtraRedeemers rdmrs) = - mkObject [ "kind" .= String "ExtraRedeemers" + mconcat [ "kind" .= String "ExtraRedeemers" , "rdmrs" .= map (Api.renderScriptWitnessIndex . Api.fromAlonzoRdmrPtr) rdmrs ] @@ -338,7 +338,8 @@ renderMissingRedeemers :: [(Alonzo.ScriptPurpose StandardCrypto, ScriptHash Stan renderMissingRedeemers scripts = Aeson.object $ map renderTuple scripts where renderTuple :: (Alonzo.ScriptPurpose StandardCrypto, ScriptHash StandardCrypto) -> Aeson.Pair - renderTuple (scriptPurpose, sHash) = renderScriptHash sHash .= renderScriptPurpose scriptPurpose + renderTuple (scriptPurpose, sHash) = + Aeson.fromText (renderScriptHash sHash) .= renderScriptPurpose scriptPurpose renderScriptPurpose :: Alonzo.ScriptPurpose StandardCrypto -> Aeson.Value renderScriptPurpose (Alonzo.Minting pid) = @@ -355,45 +356,45 @@ instance ( ShelleyBasedEra era , ToObject (PredicateFailure (Core.EraRule "UTXO" era)) ) => ToObject (UtxowPredicateFailure era) where toObject _verb (ExtraneousScriptWitnessesUTXOW extraneousScripts) = - mkObject [ "kind" .= String "InvalidWitnessesUTXOW" + mconcat [ "kind" .= String "InvalidWitnessesUTXOW" , "extraneousScripts" .= extraneousScripts ] toObject _verb (InvalidWitnessesUTXOW wits') = - mkObject [ "kind" .= String "InvalidWitnessesUTXOW" + mconcat [ "kind" .= String "InvalidWitnessesUTXOW" , "invalidWitnesses" .= map textShow wits' ] toObject _verb (MissingVKeyWitnessesUTXOW (WitHashes wits')) = - mkObject [ "kind" .= String "MissingVKeyWitnessesUTXOW" + mconcat [ "kind" .= String "MissingVKeyWitnessesUTXOW" , "missingWitnesses" .= wits' ] toObject _verb (MissingScriptWitnessesUTXOW missingScripts) = - mkObject [ "kind" .= String "MissingScriptWitnessesUTXOW" + mconcat [ "kind" .= String "MissingScriptWitnessesUTXOW" , "missingScripts" .= missingScripts ] toObject _verb (ScriptWitnessNotValidatingUTXOW failedScripts) = - mkObject [ "kind" .= String "ScriptWitnessNotValidatingUTXOW" + mconcat [ "kind" .= String "ScriptWitnessNotValidatingUTXOW" , "failedScripts" .= failedScripts ] toObject verb (UtxoFailure f) = toObject verb f toObject _verb (MIRInsufficientGenesisSigsUTXOW genesisSigs) = - mkObject [ "kind" .= String "MIRInsufficientGenesisSigsUTXOW" + mconcat [ "kind" .= String "MIRInsufficientGenesisSigsUTXOW" , "genesisSigs" .= genesisSigs ] toObject _verb (MissingTxBodyMetadataHash metadataHash) = - mkObject [ "kind" .= String "MissingTxBodyMetadataHash" + mconcat [ "kind" .= String "MissingTxBodyMetadataHash" , "metadataHash" .= metadataHash ] toObject _verb (MissingTxMetadata txBodyMetadataHash) = - mkObject [ "kind" .= String "MissingTxMetadata" + mconcat [ "kind" .= String "MissingTxMetadata" , "txBodyMetadataHash" .= txBodyMetadataHash ] toObject _verb (ConflictingMetadataHash txBodyMetadataHash fullMetadataHash) = - mkObject [ "kind" .= String "ConflictingMetadataHash" + mconcat [ "kind" .= String "ConflictingMetadataHash" , "txBodyMetadataHash" .= txBodyMetadataHash , "fullMetadataHash" .= fullMetadataHash ] toObject _verb InvalidMetadata = - mkObject [ "kind" .= String "InvalidMetadata" + mconcat [ "kind" .= String "InvalidMetadata" ] instance ( ShelleyBasedEra era @@ -403,38 +404,38 @@ instance ( ShelleyBasedEra era ) => ToObject (UtxoPredicateFailure era) where toObject _verb (BadInputsUTxO badInputs) = - mkObject [ "kind" .= String "BadInputsUTxO" + mconcat [ "kind" .= String "BadInputsUTxO" , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] toObject _verb (ExpiredUTxO ttl slot) = - mkObject [ "kind" .= String "ExpiredUTxO" + mconcat [ "kind" .= String "ExpiredUTxO" , "ttl" .= ttl , "slot" .= slot ] toObject _verb (MaxTxSizeUTxO txsize maxtxsize) = - mkObject [ "kind" .= String "MaxTxSizeUTxO" + mconcat [ "kind" .= String "MaxTxSizeUTxO" , "size" .= txsize , "maxSize" .= maxtxsize ] -- TODO: Add the minimum allowed UTxO value to OutputTooSmallUTxO toObject _verb (OutputTooSmallUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooSmallUTxO" + mconcat [ "kind" .= String "OutputTooSmallUTxO" , "outputs" .= badOutputs , "error" .= String "The output is smaller than the allow minimum \ \UTxO value defined in the protocol parameters" ] toObject _verb (OutputBootAddrAttrsTooBig badOutputs) = - mkObject [ "kind" .= String "OutputBootAddrAttrsTooBig" + mconcat [ "kind" .= String "OutputBootAddrAttrsTooBig" , "outputs" .= badOutputs , "error" .= String "The Byron address attributes are too big" ] toObject _verb InputSetEmptyUTxO = - mkObject [ "kind" .= String "InputSetEmptyUTxO" ] + mconcat [ "kind" .= String "InputSetEmptyUTxO" ] toObject _verb (FeeTooSmallUTxO minfee txfee) = - mkObject [ "kind" .= String "FeeTooSmallUTxO" + mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= txfee ] toObject _verb (ValueNotConservedUTxO consumed produced) = - mkObject [ "kind" .= String "ValueNotConservedUTxO" + mconcat [ "kind" .= String "ValueNotConservedUTxO" , "consumed" .= consumed , "produced" .= produced , "error" .= renderValueNotConservedErr consumed produced @@ -442,12 +443,12 @@ instance ( ShelleyBasedEra era toObject verb (UpdateFailure f) = toObject verb f toObject _verb (WrongNetwork network addrs) = - mkObject [ "kind" .= String "WrongNetwork" + mconcat [ "kind" .= String "WrongNetwork" , "network" .= network , "addrs" .= addrs ] toObject _verb (WrongNetworkWithdrawal network addrs) = - mkObject [ "kind" .= String "WrongNetworkWithdrawal" + mconcat [ "kind" .= String "WrongNetworkWithdrawal" , "network" .= network , "addrs" .= addrs ] @@ -468,57 +469,57 @@ instance ( ShelleyBasedEra era , ToObject (PredicateFailure (Core.EraRule "PPUP" era)) ) => ToObject (MA.UtxoPredicateFailure era) where toObject _verb (MA.BadInputsUTxO badInputs) = - mkObject [ "kind" .= String "BadInputsUTxO" + mconcat [ "kind" .= String "BadInputsUTxO" , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] toObject _verb (MA.OutsideValidityIntervalUTxO validityInterval slot) = - mkObject [ "kind" .= String "ExpiredUTxO" + mconcat [ "kind" .= String "ExpiredUTxO" , "validityInterval" .= validityInterval , "slot" .= slot ] toObject _verb (MA.MaxTxSizeUTxO txsize maxtxsize) = - mkObject [ "kind" .= String "MaxTxSizeUTxO" + mconcat [ "kind" .= String "MaxTxSizeUTxO" , "size" .= txsize , "maxSize" .= maxtxsize ] toObject _verb MA.InputSetEmptyUTxO = - mkObject [ "kind" .= String "InputSetEmptyUTxO" ] + mconcat [ "kind" .= String "InputSetEmptyUTxO" ] toObject _verb (MA.FeeTooSmallUTxO minfee txfee) = - mkObject [ "kind" .= String "FeeTooSmallUTxO" + mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= txfee ] toObject _verb (MA.ValueNotConservedUTxO consumed produced) = - mkObject [ "kind" .= String "ValueNotConservedUTxO" + mconcat [ "kind" .= String "ValueNotConservedUTxO" , "consumed" .= consumed , "produced" .= produced , "error" .= renderValueNotConservedErr consumed produced ] toObject _verb (MA.WrongNetwork network addrs) = - mkObject [ "kind" .= String "WrongNetwork" + mconcat [ "kind" .= String "WrongNetwork" , "network" .= network , "addrs" .= addrs ] toObject _verb (MA.WrongNetworkWithdrawal network addrs) = - mkObject [ "kind" .= String "WrongNetworkWithdrawal" + mconcat [ "kind" .= String "WrongNetworkWithdrawal" , "network" .= network , "addrs" .= addrs ] -- TODO: Add the minimum allowed UTxO value to OutputTooSmallUTxO toObject _verb (MA.OutputTooSmallUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooSmallUTxO" + mconcat [ "kind" .= String "OutputTooSmallUTxO" , "outputs" .= badOutputs , "error" .= String "The output is smaller than the allow minimum \ \UTxO value defined in the protocol parameters" ] toObject verb (MA.UpdateFailure f) = toObject verb f toObject _verb (MA.OutputBootAddrAttrsTooBig badOutputs) = - mkObject [ "kind" .= String "OutputBootAddrAttrsTooBig" + mconcat [ "kind" .= String "OutputBootAddrAttrsTooBig" , "outputs" .= badOutputs , "error" .= String "The Byron address attributes are too big" ] toObject _verb MA.TriesToForgeADA = - mkObject [ "kind" .= String "TriesToForgeADA" ] + mconcat [ "kind" .= String "TriesToForgeADA" ] toObject _verb (MA.OutputTooBigUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooBigUTxO" + mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs , "error" .= String "Too many asset ids in the tx output" ] @@ -534,16 +535,16 @@ renderValueNotConservedErr consumed produced = String $ instance Ledger.Era era => ToObject (PpupPredicateFailure era) where toObject _verb (NonGenesisUpdatePPUP proposalKeys genesisKeys) = - mkObject [ "kind" .= String "NonGenesisUpdatePPUP" + mconcat [ "kind" .= String "NonGenesisUpdatePPUP" , "keys" .= proposalKeys Set.\\ genesisKeys ] toObject _verb (PPUpdateWrongEpoch currEpoch intendedEpoch votingPeriod) = - mkObject [ "kind" .= String "PPUpdateWrongEpoch" + mconcat [ "kind" .= String "PPUpdateWrongEpoch" , "currentEpoch" .= currEpoch , "intendedEpoch" .= intendedEpoch , "votingPeriod" .= String (show votingPeriod) ] toObject _verb (PVCannotFollowPPUP badPv) = - mkObject [ "kind" .= String "PVCannotFollowPPUP" + mconcat [ "kind" .= String "PVCannotFollowPPUP" , "badProtocolVersion" .= badPv ] @@ -552,11 +553,11 @@ instance ( ShelleyBasedEra era , ToObject (PredicateFailure (Core.EraRule "DELPL" era)) ) => ToObject (DelegsPredicateFailure era) where toObject _verb (DelegateeNotRegisteredDELEG targetPool) = - mkObject [ "kind" .= String "DelegateeNotRegisteredDELEG" + mconcat [ "kind" .= String "DelegateeNotRegisteredDELEG" , "targetPool" .= targetPool ] toObject _verb (WithdrawalsNotInRewardsDELEGS incorrectWithdrawals) = - mkObject [ "kind" .= String "WithdrawalsNotInRewardsDELEGS" + mconcat [ "kind" .= String "WithdrawalsNotInRewardsDELEGS" , "incorrectWithdrawals" .= incorrectWithdrawals ] toObject verb (DelplFailure f) = toObject verb f @@ -570,43 +571,43 @@ instance ( ToObject (PredicateFailure (Core.EraRule "POOL" era)) instance Ledger.Era era => ToObject (DelegPredicateFailure era) where toObject _verb (StakeKeyAlreadyRegisteredDELEG alreadyRegistered) = - mkObject [ "kind" .= String "StakeKeyAlreadyRegisteredDELEG" + mconcat [ "kind" .= String "StakeKeyAlreadyRegisteredDELEG" , "credential" .= String (textShow alreadyRegistered) , "error" .= String "Staking credential already registered" ] toObject _verb (StakeKeyInRewardsDELEG alreadyRegistered) = - mkObject [ "kind" .= String "StakeKeyInRewardsDELEG" + mconcat [ "kind" .= String "StakeKeyInRewardsDELEG" , "credential" .= String (textShow alreadyRegistered) , "error" .= String "Staking credential registered in rewards map" ] toObject _verb (StakeKeyNotRegisteredDELEG notRegistered) = - mkObject [ "kind" .= String "StakeKeyNotRegisteredDELEG" + mconcat [ "kind" .= String "StakeKeyNotRegisteredDELEG" , "credential" .= String (textShow notRegistered) , "error" .= String "Staking credential not registered" ] toObject _verb (StakeKeyNonZeroAccountBalanceDELEG remBalance) = - mkObject [ "kind" .= String "StakeKeyNonZeroAccountBalanceDELEG" + mconcat [ "kind" .= String "StakeKeyNonZeroAccountBalanceDELEG" , "remainingBalance" .= remBalance ] toObject _verb (StakeDelegationImpossibleDELEG unregistered) = - mkObject [ "kind" .= String "StakeDelegationImpossibleDELEG" + mconcat [ "kind" .= String "StakeDelegationImpossibleDELEG" , "credential" .= String (textShow unregistered) , "error" .= String "Cannot delegate this stake credential because it is not registered" ] toObject _verb WrongCertificateTypeDELEG = - mkObject [ "kind" .= String "WrongCertificateTypeDELEG" ] + mconcat [ "kind" .= String "WrongCertificateTypeDELEG" ] toObject _verb (GenesisKeyNotInMappingDELEG (KeyHash genesisKeyHash)) = - mkObject [ "kind" .= String "GenesisKeyNotInMappingDELEG" + mconcat [ "kind" .= String "GenesisKeyNotInMappingDELEG" , "unknownKeyHash" .= String (textShow genesisKeyHash) , "error" .= String "This genesis key is not in the delegation mapping" ] toObject _verb (DuplicateGenesisDelegateDELEG (KeyHash genesisKeyHash)) = - mkObject [ "kind" .= String "DuplicateGenesisDelegateDELEG" + mconcat [ "kind" .= String "DuplicateGenesisDelegateDELEG" , "duplicateKeyHash" .= String (textShow genesisKeyHash) , "error" .= String "This genesis key has already been delegated to" ] toObject _verb (InsufficientForInstantaneousRewardsDELEG mirpot neededMirAmount reserves) = - mkObject [ "kind" .= String "InsufficientForInstantaneousRewardsDELEG" + mconcat [ "kind" .= String "InsufficientForInstantaneousRewardsDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") @@ -614,22 +615,22 @@ instance Ledger.Era era => ToObject (DelegPredicateFailure era) where , "reserves" .= reserves ] toObject _verb (MIRCertificateTooLateinEpochDELEG currSlot boundSlotNo) = - mkObject [ "kind" .= String "MIRCertificateTooLateinEpochDELEG" + mconcat [ "kind" .= String "MIRCertificateTooLateinEpochDELEG" , "currentSlotNo" .= currSlot , "mustBeSubmittedBeforeSlotNo" .= boundSlotNo ] toObject _verb (DuplicateGenesisVRFDELEG vrfKeyHash) = - mkObject [ "kind" .= String "DuplicateGenesisVRFDELEG" + mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" , "keyHash" .= vrfKeyHash ] toObject _verb MIRTransferNotCurrentlyAllowed = - mkObject [ "kind" .= String "MIRTransferNotCurrentlyAllowed" + mconcat [ "kind" .= String "MIRTransferNotCurrentlyAllowed" ] toObject _verb MIRNegativesNotCurrentlyAllowed = - mkObject [ "kind" .= String "MIRNegativesNotCurrentlyAllowed" + mconcat [ "kind" .= String "MIRNegativesNotCurrentlyAllowed" ] toObject _verb (InsufficientForTransferDELEG mirpot attempted available) = - mkObject [ "kind" .= String "DuplicateGenesisVRFDELEG" + mconcat [ "kind" .= String "DuplicateGenesisVRFDELEG" , "pot" .= String (case mirpot of ReservesMIR -> "Reserves" TreasuryMIR -> "Treasury") @@ -637,10 +638,10 @@ instance Ledger.Era era => ToObject (DelegPredicateFailure era) where , "available" .= available ] toObject _verb MIRProducesNegativeUpdate = - mkObject [ "kind" .= String "MIRProducesNegativeUpdate" + mconcat [ "kind" .= String "MIRProducesNegativeUpdate" ] toObject _verb (MIRNegativeTransfer pot coin) = - mkObject [ "kind" .= String "MIRNegativeTransfer" + mconcat [ "kind" .= String "MIRNegativeTransfer" , "error" .= String "Attempt to transfer a negative amount from a pot." , "pot" .= String (case pot of ReservesMIR -> "Reserves" @@ -650,24 +651,24 @@ instance Ledger.Era era => ToObject (DelegPredicateFailure era) where instance ToObject (PoolPredicateFailure era) where toObject _verb (StakePoolNotRegisteredOnKeyPOOL (KeyHash unregStakePool)) = - mkObject [ "kind" .= String "StakePoolNotRegisteredOnKeyPOOL" + mconcat [ "kind" .= String "StakePoolNotRegisteredOnKeyPOOL" , "unregisteredKeyHash" .= String (textShow unregStakePool) , "error" .= String "This stake pool key hash is unregistered" ] toObject _verb (StakePoolRetirementWrongEpochPOOL currentEpoch intendedRetireEpoch maxRetireEpoch) = - mkObject [ "kind" .= String "StakePoolRetirementWrongEpochPOOL" + mconcat [ "kind" .= String "StakePoolRetirementWrongEpochPOOL" , "currentEpoch" .= String (textShow currentEpoch) , "intendedRetirementEpoch" .= String (textShow intendedRetireEpoch) , "maxEpochForRetirement" .= String (textShow maxRetireEpoch) ] toObject _verb (StakePoolCostTooLowPOOL certCost protCost) = - mkObject [ "kind" .= String "StakePoolCostTooLowPOOL" + mconcat [ "kind" .= String "StakePoolCostTooLowPOOL" , "certificateCost" .= String (textShow certCost) , "protocolParCost" .= String (textShow protCost) , "error" .= String "The stake pool cost is too low" ] toObject _verb (PoolMedataHashTooBig poolID hashSize) = - mkObject [ "kind" .= String "PoolMedataHashTooBig" + mconcat [ "kind" .= String "PoolMedataHashTooBig" , "poolID" .= String (textShow poolID) , "hashSize" .= String (textShow hashSize) , "error" .= String "The stake pool metadata hash is too large" @@ -676,22 +677,22 @@ instance ToObject (PoolPredicateFailure era) where -- Apparently this should never happen according to the Shelley exec spec toObject _verb (WrongCertificateTypePOOL index) = case index of - 0 -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + 0 -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "error" .= String "Wrong certificate type: Delegation certificate" ] - 1 -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + 1 -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "error" .= String "Wrong certificate type: MIR certificate" ] - 2 -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + 2 -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "error" .= String "Wrong certificate type: Genesis certificate" ] - k -> mkObject [ "kind" .= String "WrongCertificateTypePOOL" + k -> mconcat [ "kind" .= String "WrongCertificateTypePOOL" , "certificateType" .= k , "error" .= String "Wrong certificate type: Unknown certificate type" ] toObject _verb (WrongNetworkPOOL networkId listedNetworkId poolId) = - mkObject [ "kind" .= String "WrongNetworkPOOL" + mconcat [ "kind" .= String "WrongNetworkPOOL" , "networkId" .= String (textShow networkId) , "listedNetworkId" .= String (textShow listedNetworkId) , "poolId" .= String (textShow poolId) @@ -713,7 +714,7 @@ instance ( ToObject (PredicateFailure (Core.EraRule "EPOCH" era)) toObject verb (EpochFailure f) = toObject verb f toObject verb (MirFailure f) = toObject verb f toObject _verb (CorruptRewardUpdate update) = - mkObject [ "kind" .= String "CorruptRewardUpdate" + mconcat [ "kind" .= String "CorruptRewardUpdate" , "update" .= String (show update) ] @@ -736,7 +737,7 @@ instance ToObject (SnapPredicateFailure era) where -- TODO: Need to elaborate more on this error instance ToObject (NewppPredicateFailure era) where toObject _verb (UnexpectedDepositPot outstandingDeposits depositPot) = - mkObject [ "kind" .= String "UnexpectedDepositPot" + mconcat [ "kind" .= String "UnexpectedDepositPot" , "outstandingDeposits" .= String (textShow outstandingDeposits) , "depositPot" .= String (textShow depositPot) ] @@ -757,51 +758,51 @@ instance Core.Crypto crypto => ToObject (PrtclPredicateFailure crypto) where instance Core.Crypto crypto => ToObject (OverlayPredicateFailure crypto) where toObject _verb (UnknownGenesisKeyOVERLAY (KeyHash genKeyHash)) = - mkObject [ "kind" .= String "UnknownGenesisKeyOVERLAY" + mconcat [ "kind" .= String "UnknownGenesisKeyOVERLAY" , "unknownKeyHash" .= String (textShow genKeyHash) ] toObject _verb (VRFKeyBadLeaderValue seedNonce (SlotNo currSlotNo) prevHashNonce leaderElecVal) = - mkObject [ "kind" .= String "VRFKeyBadLeaderValueOVERLAY" + mconcat [ "kind" .= String "VRFKeyBadLeaderValueOVERLAY" , "seedNonce" .= String (textShow seedNonce) , "currentSlot" .= String (textShow currSlotNo) , "previousHashAsNonce" .= String (textShow prevHashNonce) , "leaderElectionValue" .= String (textShow leaderElecVal) ] toObject _verb (VRFKeyBadNonce seedNonce (SlotNo currSlotNo) prevHashNonce blockNonce) = - mkObject [ "kind" .= String "VRFKeyBadNonceOVERLAY" + mconcat [ "kind" .= String "VRFKeyBadNonceOVERLAY" , "seedNonce" .= String (textShow seedNonce) , "currentSlot" .= String (textShow currSlotNo) , "previousHashAsNonce" .= String (textShow prevHashNonce) , "blockNonce" .= String (textShow blockNonce) ] toObject _verb (VRFKeyWrongVRFKey issuerHash regVRFKeyHash unregVRFKeyHash) = - mkObject [ "kind" .= String "VRFKeyWrongVRFKeyOVERLAY" + mconcat [ "kind" .= String "VRFKeyWrongVRFKeyOVERLAY" , "poolHash" .= textShow issuerHash , "registeredVRFKeHash" .= textShow regVRFKeyHash , "unregisteredVRFKeyHash" .= textShow unregVRFKeyHash ] --TODO: Pipe slot number with VRFKeyUnknown toObject _verb (VRFKeyUnknown (KeyHash kHash)) = - mkObject [ "kind" .= String "VRFKeyUnknownOVERLAY" + mconcat [ "kind" .= String "VRFKeyUnknownOVERLAY" , "keyHash" .= String (textShow kHash) ] toObject _verb (VRFLeaderValueTooBig leadElecVal weightOfDelegPool actSlotCoefff) = - mkObject [ "kind" .= String "VRFLeaderValueTooBigOVERLAY" + mconcat [ "kind" .= String "VRFLeaderValueTooBigOVERLAY" , "leaderElectionValue" .= String (textShow leadElecVal) , "delegationPoolWeight" .= String (textShow weightOfDelegPool) , "activeSlotCoefficient" .= String (textShow actSlotCoefff) ] toObject _verb (NotActiveSlotOVERLAY notActiveSlotNo) = -- TODO: Elaborate on NotActiveSlot error - mkObject [ "kind" .= String "NotActiveSlotOVERLAY" + mconcat [ "kind" .= String "NotActiveSlotOVERLAY" , "slot" .= String (textShow notActiveSlotNo) ] toObject _verb (WrongGenesisColdKeyOVERLAY actual expected) = - mkObject [ "kind" .= String "WrongGenesisColdKeyOVERLAY" + mconcat [ "kind" .= String "WrongGenesisColdKeyOVERLAY" , "actual" .= actual , "expected" .= expected ] toObject _verb (WrongGenesisVRFKeyOVERLAY issuer actual expected) = - mkObject [ "kind" .= String "WrongGenesisVRFKeyOVERLAY" + mconcat [ "kind" .= String "WrongGenesisVRFKeyOVERLAY" , "issuer" .= issuer , "actual" .= actual , "expected" .= expected ] @@ -810,14 +811,14 @@ instance Core.Crypto crypto => ToObject (OverlayPredicateFailure crypto) where instance ToObject (OcertPredicateFailure crypto) where toObject _verb (KESBeforeStartOCERT (KESPeriod oCertstart) (KESPeriod current)) = - mkObject [ "kind" .= String "KESBeforeStartOCERT" + mconcat [ "kind" .= String "KESBeforeStartOCERT" , "opCertKESStartPeriod" .= String (textShow oCertstart) , "currentKESPeriod" .= String (textShow current) , "error" .= String "Your operational certificate's KES start period \ \is before the KES current period." ] toObject _verb (KESAfterEndOCERT (KESPeriod current) (KESPeriod oCertstart) maxKESEvolutions) = - mkObject [ "kind" .= String "KESAfterEndOCERT" + mconcat [ "kind" .= String "KESAfterEndOCERT" , "currentKESPeriod" .= String (textShow current) , "opCertKESStartPeriod" .= String (textShow oCertstart) , "maxKESEvolutions" .= String (textShow maxKESEvolutions) @@ -825,25 +826,25 @@ instance ToObject (OcertPredicateFailure crypto) where \greater than the max number of KES + the KES current period" ] toObject _verb (CounterTooSmallOCERT lastKEScounterUsed currentKESCounter) = - mkObject [ "kind" .= String "CounterTooSmallOCert" + mconcat [ "kind" .= String "CounterTooSmallOCert" , "currentKESCounter" .= String (textShow currentKESCounter) , "lastKESCounter" .= String (textShow lastKEScounterUsed) , "error" .= String "The operational certificate's last KES counter is greater \ \than the current KES counter." ] toObject _verb (InvalidSignatureOCERT oCertCounter oCertKESStartPeriod) = - mkObject [ "kind" .= String "InvalidSignatureOCERT" + mconcat [ "kind" .= String "InvalidSignatureOCERT" , "opCertKESStartPeriod" .= String (textShow oCertKESStartPeriod) , "opCertCounter" .= String (textShow oCertCounter) ] toObject _verb (InvalidKesSignatureOCERT currKESPeriod startKESPeriod expectedKESEvolutions err) = - mkObject [ "kind" .= String "InvalidKesSignatureOCERT" + mconcat [ "kind" .= String "InvalidKesSignatureOCERT" , "opCertKESStartPeriod" .= String (textShow startKESPeriod) , "opCertKESCurrentPeriod" .= String (textShow currKESPeriod) , "opCertExpectedKESEvolutions" .= String (textShow expectedKESEvolutions) , "error" .= err ] toObject _verb (NoCounterForKeyHashOCERT (KeyHash stakePoolKeyHash)) = - mkObject [ "kind" .= String "NoCounterForKeyHashOCERT" + mconcat [ "kind" .= String "NoCounterForKeyHashOCERT" , "stakePoolKeyHash" .= String (textShow stakePoolKeyHash) , "error" .= String "A counter was not found for this stake pool key hash" ] @@ -855,7 +856,7 @@ instance ToObject (UpdnPredicateFailure crypto) where instance ToObject (UpecPredicateFailure era) where toObject _verb (NewPpFailure (UnexpectedDepositPot totalOutstanding depositPot)) = - mkObject [ "kind" .= String "UnexpectedDepositPot" + mconcat [ "kind" .= String "UnexpectedDepositPot" , "totalOutstanding" .= String (textShow totalOutstanding) , "depositPot" .= String (textShow depositPot) ] @@ -868,45 +869,45 @@ instance ToObject (UpecPredicateFailure era) where instance ToObject (Alonzo.UtxoPredicateFailure (Alonzo.AlonzoEra StandardCrypto)) where toObject _verb (Alonzo.BadInputsUTxO badInputs) = - mkObject [ "kind" .= String "BadInputsUTxO" + mconcat [ "kind" .= String "BadInputsUTxO" , "badInputs" .= badInputs , "error" .= renderBadInputsUTxOErr badInputs ] toObject _verb (Alonzo.OutsideValidityIntervalUTxO validtyInterval slot) = - mkObject [ "kind" .= String "ExpiredUTxO" + mconcat [ "kind" .= String "ExpiredUTxO" , "validityInterval" .= validtyInterval , "slot" .= slot ] toObject _verb (Alonzo.MaxTxSizeUTxO txsize maxtxsize) = - mkObject [ "kind" .= String "MaxTxSizeUTxO" + mconcat [ "kind" .= String "MaxTxSizeUTxO" , "size" .= txsize , "maxSize" .= maxtxsize ] toObject _verb Alonzo.InputSetEmptyUTxO = - mkObject [ "kind" .= String "InputSetEmptyUTxO" ] + mconcat [ "kind" .= String "InputSetEmptyUTxO" ] toObject _verb (Alonzo.FeeTooSmallUTxO minfee currentFee) = - mkObject [ "kind" .= String "FeeTooSmallUTxO" + mconcat [ "kind" .= String "FeeTooSmallUTxO" , "minimum" .= minfee , "fee" .= currentFee ] toObject _verb (Alonzo.ValueNotConservedUTxO consumed produced) = - mkObject [ "kind" .= String "ValueNotConservedUTxO" + mconcat [ "kind" .= String "ValueNotConservedUTxO" , "consumed" .= consumed , "produced" .= produced , "error" .= renderValueNotConservedErr consumed produced ] toObject _verb (Alonzo.WrongNetwork network addrs) = - mkObject [ "kind" .= String "WrongNetwork" + mconcat [ "kind" .= String "WrongNetwork" , "network" .= network , "addrs" .= addrs ] toObject _verb (Alonzo.WrongNetworkWithdrawal network addrs) = - mkObject [ "kind" .= String "WrongNetworkWithdrawal" + mconcat [ "kind" .= String "WrongNetworkWithdrawal" , "network" .= network , "addrs" .= addrs ] toObject _verb (Alonzo.OutputTooSmallUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooSmallUTxO" + mconcat [ "kind" .= String "OutputTooSmallUTxO" , "outputs" .= badOutputs , "error" .= String "The output is smaller than the allow minimum \ \UTxO value defined in the protocol parameters" @@ -914,60 +915,60 @@ instance ToObject (Alonzo.UtxoPredicateFailure (Alonzo.AlonzoEra StandardCrypto) toObject verb (Alonzo.UtxosFailure predFailure) = toObject verb predFailure toObject _verb (Alonzo.OutputBootAddrAttrsTooBig txouts) = - mkObject [ "kind" .= String "OutputBootAddrAttrsTooBig" + mconcat [ "kind" .= String "OutputBootAddrAttrsTooBig" , "outputs" .= txouts , "error" .= String "The Byron address attributes are too big" ] toObject _verb Alonzo.TriesToForgeADA = - mkObject [ "kind" .= String "TriesToForgeADA" ] + mconcat [ "kind" .= String "TriesToForgeADA" ] toObject _verb (Alonzo.OutputTooBigUTxO badOutputs) = - mkObject [ "kind" .= String "OutputTooBigUTxO" + mconcat [ "kind" .= String "OutputTooBigUTxO" , "outputs" .= badOutputs , "error" .= String "Too many asset ids in the tx output" ] toObject _verb (Alonzo.InsufficientCollateral computedBalance suppliedFee) = - mkObject [ "kind" .= String "InsufficientCollateral" + mconcat [ "kind" .= String "InsufficientCollateral" , "balance" .= computedBalance , "txfee" .= suppliedFee ] toObject _verb (Alonzo.ScriptsNotPaidUTxO utxos) = - mkObject [ "kind" .= String "ScriptsNotPaidUTxO" + mconcat [ "kind" .= String "ScriptsNotPaidUTxO" , "utxos" .= utxos ] toObject _verb (Alonzo.ExUnitsTooBigUTxO pParamsMaxExUnits suppliedExUnits) = - mkObject [ "kind" .= String "ExUnitsTooBigUTxO" + mconcat [ "kind" .= String "ExUnitsTooBigUTxO" , "maxexunits" .= pParamsMaxExUnits , "exunits" .= suppliedExUnits ] toObject _verb (Alonzo.CollateralContainsNonADA inputs) = - mkObject [ "kind" .= String "CollateralContainsNonADA" + mconcat [ "kind" .= String "CollateralContainsNonADA" , "inputs" .= inputs ] toObject _verb (Alonzo.WrongNetworkInTxBody actualNetworkId netIdInTxBody) = - mkObject [ "kind" .= String "WrongNetworkInTxBody" + mconcat [ "kind" .= String "WrongNetworkInTxBody" , "networkid" .= actualNetworkId , "txbodyNetworkId" .= netIdInTxBody ] toObject _verb (Alonzo.OutsideForecast slotNum) = - mkObject [ "kind" .= String "OutsideForecast" + mconcat [ "kind" .= String "OutsideForecast" , "slot" .= slotNum ] toObject _verb (Alonzo.TooManyCollateralInputs maxCollateralInputs numberCollateralInputs) = - mkObject [ "kind" .= String "TooManyCollateralInputs" + mconcat [ "kind" .= String "TooManyCollateralInputs" , "max" .= maxCollateralInputs , "inputs" .= numberCollateralInputs ] toObject _verb Alonzo.NoCollateralInputs = - mkObject [ "kind" .= String "NoCollateralInputs" ] + mconcat [ "kind" .= String "NoCollateralInputs" ] instance ToObject (Alonzo.UtxosPredicateFailure (AlonzoEra StandardCrypto)) where toObject _ (Alonzo.ValidationTagMismatch isValidating reason) = - mkObject [ "kind" .= String "ValidationTagMismatch" + mconcat [ "kind" .= String "ValidationTagMismatch" , "isvalidating" .= isValidating , "reason" .= reason ] toObject _ (Alonzo.CollectErrors errors) = - mkObject [ "kind" .= String "CollectErrors" + mconcat [ "kind" .= String "CollectErrors" , "errors" .= errors ] toObject verb (Alonzo.UpdateFailure pFailure) = @@ -1028,16 +1029,16 @@ instance ToJSON Alonzo.FailureDescription where , "error" .= String "OnePhaseFailure" , "description" .= t ] - Alonzo.PlutusFailure t bs -> + Alonzo.PlutusFailure t _bs -> object [ "kind" .= String "FailureDescription" , "error" .= String "PlutusFailure" , "description" .= t - , "reconstructionDetail" .= bs + -- , "reconstructionDetail" .= bs ] instance ToObject (AlonzoBbodyPredFail (Alonzo.AlonzoEra StandardCrypto)) where - toObject _ err = mkObject [ "kind" .= String "AlonzoBbodyPredFail" + toObject _ err = mconcat [ "kind" .= String "AlonzoBbodyPredFail" , "error" .= String (show err) ] diff --git a/cardano-node/src/Cardano/Tracing/Peer.hs b/cardano-node/src/Cardano/Tracing/Peer.hs index 0b1adad7704..2d26155bfb3 100644 --- a/cardano-node/src/Cardano/Tracing/Peer.hs +++ b/cardano-node/src/Cardano/Tracing/Peer.hs @@ -22,7 +22,6 @@ import NoThunks.Class (AllowThunk (..), NoThunks) import Text.Printf (printf) import Cardano.BM.Data.LogItem (LOContent (..)) -import Cardano.BM.Data.Tracer (emptyObject, mkObject) import Cardano.BM.Trace (traceNamedObject) import Cardano.BM.Tracing @@ -121,9 +120,9 @@ tracePeers tr peers = do -- | Instances for converting [Peer blk] to Object. instance ToObject [Peer blk] where - toObject MinimalVerbosity _ = emptyObject - toObject _ [] = emptyObject - toObject verb xs = mkObject + toObject MinimalVerbosity _ = mempty + toObject _ [] = mempty + toObject verb xs = mconcat [ "kind" .= String "NodeKernelPeers" , "peers" .= toJSON (foldl' (\acc x -> toObject verb x : acc) [] xs) @@ -131,10 +130,10 @@ instance ToObject [Peer blk] where instance ToObject (Peer blk) where toObject _verb (Peer cid _af status inflight) = - mkObject [ "peerAddress" .= String (Text.pack . show . remoteAddress $ cid) - , "peerStatus" .= String (Text.pack . ppStatus $ status) - , "peerSlotNo" .= String (Text.pack . ppMaxSlotNo . peerFetchMaxSlotNo $ inflight) - , "peerReqsInF" .= String (show . peerFetchReqsInFlight $ inflight) - , "peerBlocksInF" .= String (show . Set.size . peerFetchBlocksInFlight $ inflight) - , "peerBytesInF" .= String (show . peerFetchBytesInFlight $ inflight) - ] + mconcat [ "peerAddress" .= String (Text.pack . show . remoteAddress $ cid) + , "peerStatus" .= String (Text.pack . ppStatus $ status) + , "peerSlotNo" .= String (Text.pack . ppMaxSlotNo . peerFetchMaxSlotNo $ inflight) + , "peerReqsInF" .= String (show . peerFetchReqsInFlight $ inflight) + , "peerBlocksInF" .= String (show . Set.size . peerFetchBlocksInFlight $ inflight) + , "peerBytesInF" .= String (show . peerFetchBytesInFlight $ inflight) + ] diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 7d0247a4885..ce8406dbc38 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -124,6 +124,7 @@ import qualified Cardano.Node.STM as STM import qualified Control.Concurrent.STM as STM import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) +import qualified Data.Aeson.KeyMap as KeyMap {- HLINT ignore "Redundant bracket" -} {- HLINT ignore "Use record patterns" -} @@ -940,7 +941,7 @@ traceLeadershipChecks _ft nodeKern _tverb tr = Tracer $ traceCounter "delegMapSize" tr delegMapSize traceNamedObject (appendName "LeadershipCheck" tr) ( meta - , LogStructured $ Map.fromList $ + , LogStructured $ KeyMap.fromList $ [("kind", String "TraceStartLeadershipCheck") ,("credentials", String creds) ,("slot", toJSON $ unSlotNo slot)] diff --git a/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs b/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs index 31d050ac7a6..03ce7cab014 100644 --- a/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs +++ b/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs @@ -8,7 +8,7 @@ module Cardano.TxSubmit.Tracing.ToObjectOrphans () where import Cardano.BM.Data.Severity (Severity (Debug, Error, Notice, Warning)) import Cardano.BM.Data.Tracer (HasPrivacyAnnotation, HasSeverityAnnotation (..), - HasTextFormatter, ToObject (toObject), Transformable (..), mkObject, + HasTextFormatter, ToObject (toObject), Transformable (..), trStructured) import Data.Aeson ((.=)) import Data.String (String) @@ -18,6 +18,7 @@ import System.IO (IO) import Text.Show (Show (..)) import qualified Network.Socket as Socket +import Data.Monoid (mconcat) instance HasPrivacyAnnotation (WithAddr Socket.SockAddr ErrorPolicyTrace) instance HasSeverityAnnotation (WithAddr Socket.SockAddr ErrorPolicyTrace) where @@ -41,6 +42,6 @@ instance Transformable Text IO (WithAddr Socket.SockAddr ErrorPolicyTrace) where instance ToObject (WithAddr Socket.SockAddr ErrorPolicyTrace) where toObject _verb (WithAddr addr ev) = - mkObject [ "kind" .= ("ErrorPolicyTrace" :: String) - , "address" .= show addr - , "event" .= show ev ] + mconcat [ "kind" .= ("ErrorPolicyTrace" :: String) + , "address" .= show addr + , "event" .= show ev ] diff --git a/cardano-testnet/src/Testnet/Byron.hs b/cardano-testnet/src/Testnet/Byron.hs index 048a894db7c..a66d8a0afdb 100644 --- a/cardano-testnet/src/Testnet/Byron.hs +++ b/cardano-testnet/src/Testnet/Byron.hs @@ -239,7 +239,7 @@ testnet testnetOptions H.Conf {..} = do sprocket <- H.noteShow $ Sprocket tempBaseAbsPath (socketDir "node-" <> si) _spocketSystemNameFile <- H.noteShow $ IO.sprocketSystemName sprocket -- TODO: Better error message need to indicate a sprocket was not created - H.waitByDeadlineM deadline $ H.doesSprocketExist sprocket + H.assertByDeadlineM deadline $ H.doesSprocketExist sprocket forM_ nodeIndexes $ \i -> do si <- H.noteShow $ show @Int i diff --git a/cardano-testnet/src/Testnet/Cardano.hs b/cardano-testnet/src/Testnet/Cardano.hs index 2e834b269e3..edccae75bea 100644 --- a/cardano-testnet/src/Testnet/Cardano.hs +++ b/cardano-testnet/src/Testnet/Cardano.hs @@ -806,7 +806,7 @@ testnet testnetOptions H.Conf {..} = do forM_ allNodes $ \node -> do sprocket <- H.noteShow $ Sprocket tempBaseAbsPath (socketDir node) _spocketSystemNameFile <- H.noteShow $ IO.sprocketSystemName sprocket - H.waitByDeadlineM deadline $ H.doesSprocketExist sprocket + H.assertByDeadlineM deadline $ H.doesSprocketExist sprocket forM_ allNodes $ \node -> do nodeStdoutFile <- H.noteTempFile logDir $ node <> ".stdout.log" diff --git a/cardano-testnet/src/Testnet/Shelley.hs b/cardano-testnet/src/Testnet/Shelley.hs index 20b804a1ee4..10b4ee4d51e 100644 --- a/cardano-testnet/src/Testnet/Shelley.hs +++ b/cardano-testnet/src/Testnet/Shelley.hs @@ -472,7 +472,7 @@ testnet testnetOptions H.Conf {..} = do forM_ allNodes $ \node -> do sprocket <- H.noteShow $ Sprocket tempBaseAbsPath (socketDir node) _spocketSystemNameFile <- H.noteShow $ IO.sprocketSystemName sprocket - H.waitByDeadlineM deadline $ H.doesSprocketExist sprocket + H.assertByDeadlineM deadline $ H.doesSprocketExist sprocket forM_ allNodes $ \node -> do nodeStdoutFile <- H.noteTempFile logDir $ node <> ".stdout.log" diff --git a/trace-dispatcher/examples/Examples/Configuration.hs b/trace-dispatcher/examples/Examples/Configuration.hs index 06e4ec243da..2ca2001fb3a 100644 --- a/trace-dispatcher/examples/Examples/Configuration.hs +++ b/trace-dispatcher/examples/Examples/Configuration.hs @@ -7,11 +7,11 @@ module Examples.Configuration ( import Control.Monad.IO.Class import qualified Data.Aeson as AE -import qualified Data.HashMap.Strict as HM import qualified Data.Map as Map import Data.Text (Text) import Cardano.Logging +import qualified Data.Aeson.KeyMap as KeyMap newtype TestMessage = TestMessage Text deriving Show @@ -19,7 +19,7 @@ newtype TestMessage = TestMessage Text instance LogFormatting TestMessage where forHuman (TestMessage text) = text forMachine _verb (TestMessage text) = - HM.fromList + KeyMap.fromList [ "kind" AE..= AE.String "TestMessage" , "text" AE..= AE.String text ] diff --git a/trace-dispatcher/examples/Examples/TestObjects.hs b/trace-dispatcher/examples/Examples/TestObjects.hs index 8d28a072bcf..60c16b0bc27 100644 --- a/trace-dispatcher/examples/Examples/TestObjects.hs +++ b/trace-dispatcher/examples/Examples/TestObjects.hs @@ -1,13 +1,13 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} module Examples.TestObjects ( traceForgeEventDocu @@ -23,7 +23,7 @@ module Examples.TestObjects ( import Cardano.Logging import qualified Data.Aeson as AE -import qualified Data.HashMap.Strict as HM +import qualified Data.Aeson.KeyMap as KeyMap import Data.Kind (Type) import Data.Text (pack) import Data.Word (Word64) @@ -120,19 +120,19 @@ instance LogFormatting (TraceForgeEvent LogBlock) where (unSlotNo currentSlot) forMachine _verb (TraceStartLeadershipCheck slotNo) = - HM.fromList + KeyMap.fromList [ "kind" AE..= AE.String "TraceStartLeadershipCheck" , "slot" AE..= AE.toJSON (unSlotNo slotNo) ] forMachine _verb (TraceSlotIsImmutable slotNo tipPoint tipBlkNo) = - HM.fromList + KeyMap.fromList [ "kind" AE..= AE.String "TraceSlotIsImmutable" , "slot" AE..= AE.toJSON (unSlotNo slotNo) , "tip" AE..= showT tipPoint , "tipBlockNo" AE..= AE.toJSON (unBlockNo tipBlkNo) ] forMachine _verb (TraceBlockFromFuture currentSlot tip) = - HM.fromList + KeyMap.fromList [ "kind" AE..= AE.String "TraceBlockFromFuture" , "current slot" AE..= AE.toJSON (unSlotNo currentSlot) , "tip" AE..= AE.toJSON (unSlotNo tip) diff --git a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs index 05dc6ab84d1..3c99466e16e 100644 --- a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs +++ b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs @@ -50,16 +50,16 @@ instance LogFormatting LimitingMessage where ". Suppressed " <> pack (show num) <> " messages." forHuman (RememberLimiting txt num) = "Frequency limiting still active for " <> txt <> ". Suppressed so far " <> pack (show num) <> " messages." - forMachine _dtl (StartLimiting txt) = mkObject + forMachine _dtl (StartLimiting txt) = mconcat [ "kind" .= String "StartLimiting" , "name" .= String txt ] - forMachine _dtl (StopLimiting txt num) = mkObject + forMachine _dtl (StopLimiting txt num) = mconcat [ "kind" .= String "StopLimiting" , "name" .= String txt , "numSuppressed" .= Number (fromIntegral num) ] - forMachine _dtl (RememberLimiting txt num) = mkObject + forMachine _dtl (RememberLimiting txt num) = mconcat [ "kind" .= String "RememberLimiting" , "name" .= String txt , "numSuppressed" .= Number (fromIntegral num) diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 07f6d420492..396e83f30c8 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -432,17 +432,17 @@ instance LogFormatting b => LogFormatting (Folding a b) where asMetrics (Folding b) = asMetrics b instance LogFormatting Double where - forMachine _dtal d = mkObject [ "val" .= AE.String ((pack . show) d)] + forMachine _dtal d = "val" .= AE.String ((pack . show) d) forHuman = pack . show asMetrics d = [DoubleM "" d] instance LogFormatting Int where - forMachine _dtal i = mkObject [ "val" .= AE.String ((pack . show) i)] + forMachine _dtal i = "val" .= AE.String ((pack . show) i) forHuman = pack . show asMetrics i = [IntM "" (fromIntegral i)] instance LogFormatting Integer where - forMachine _dtal i = mkObject [ "val" .= AE.String ((pack . show) i)] + forMachine _dtal i = "val" .= AE.String ((pack . show) i) forHuman = pack . show asMetrics i = [IntM "" i] diff --git a/trace-dispatcher/test/Cardano/Logging/Test/Types.hs b/trace-dispatcher/test/Cardano/Logging/Test/Types.hs index 5174756721f..62695767383 100644 --- a/trace-dispatcher/test/Cardano/Logging/Test/Types.hs +++ b/trace-dispatcher/test/Cardano/Logging/Test/Types.hs @@ -24,24 +24,24 @@ data Message = instance LogFormatting Message where forMachine _dtal (Message1 mid i) = - mkObject [ "kind" .= String "Message1" - , "mid" .= ("<" <> showT mid <> ">") - , "workload" .= String (showT i) - ] + mconcat [ "kind" .= String "Message1" + , "mid" .= ("<" <> showT mid <> ">") + , "workload" .= String (showT i) + ] forMachine DMinimal (Message2 mid _s) = - mkObject [ "mid" .= ("<" <> showT mid <> ">") - , "kind" .= String "Message2" - ] + mconcat [ "mid" .= ("<" <> showT mid <> ">") + , "kind" .= String "Message2" + ] forMachine _dtal (Message2 mid s) = - mkObject [ "kind" .= String "Message2" - , "mid" .= String ("<" <> showT mid <> ">") - , "workload" .= String s - ] + mconcat [ "kind" .= String "Message2" + , "mid" .= String ("<" <> showT mid <> ">") + , "workload" .= String s + ] forMachine _dtal (Message3 mid d) = - mkObject [ "kind" .= String "Message3" - , "mid" .= String (showT mid) - , "workload" .= String (showT d) - ] + mconcat [ "kind" .= String "Message3" + , "mid" .= String (showT mid) + , "workload" .= String (showT d) + ] forHuman (Message1 mid i) = "Message1 <" <> showT mid <> "> " <> showT i forHuman (Message2 mid s) = diff --git a/trace-resources/src/Cardano/Logging/Resources/Types.hs b/trace-resources/src/Cardano/Logging/Resources/Types.hs index 01a21befcdb..773cade7f37 100644 --- a/trace-resources/src/Cardano/Logging/Resources/Types.hs +++ b/trace-resources/src/Cardano/Logging/Resources/Types.hs @@ -99,7 +99,7 @@ instance LogFormatting ResourceStats where <> ", Threads " <> (pack . show) (rThreads rs) <> "." - forMachine _dtal rs = mkObject + forMachine _dtal rs = mconcat [ "kind" .= String "ResourceStats" , "Cputicks" .= Number (fromIntegral $ rCentiCpu rs) , "Resident" .= Number (fromIntegral $ rRSS rs) From 8780706c566bc318663598adef2dbf5268a12bd0 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Tue, 15 Mar 2022 14:27:23 +0100 Subject: [PATCH 04/15] Update hedgehox-extras. --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index e9ce10f0168..4afae6adcdf 100644 --- a/cabal.project +++ b/cabal.project @@ -161,7 +161,7 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/hedgehog-extras - tag: 678b9661750ccbe8a86aa5f56442cb30904ed0bc + tag: 967d79533c21e33387d0227a5f6cc185203fe658 --sha256: 0rbqb7a64aya1qizlr3im06hdydg9zr6sl3i8bvqqlf7kpa647sd source-repository-package From 8e372c8f16043a577ac7f996f77eabb921dd91e5 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Tue, 15 Mar 2022 14:36:51 +0100 Subject: [PATCH 05/15] Update with additional tracing. This information isn't necessarily correct, should be reviewed by the network team. --- cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs | 2 ++ cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs | 7 +++++++ .../src/Cardano/Tracing/OrphanInstances/Network.hs | 6 ++++++ .../src/Cardano/Tracing/OrphanInstances/Shelley.hs | 4 ++++ cardano-node/src/Cardano/Tracing/Tracers.hs | 1 - 5 files changed, 19 insertions(+), 1 deletion(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs index 255855f3ff7..e88c4e64d47 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Diffusion.hs @@ -103,6 +103,7 @@ severityMux' MuxTraceStartOnDemand {} = Debug severityMux' MuxTraceStartedOnDemand {} = Debug severityMux' MuxTraceTerminating {} = Debug severityMux' MuxTraceShutdown {} = Debug +severityMux' MuxTraceTCPInfo {} = Debug namesForMux :: WithMuxBearer peer MuxTrace -> [Text] namesForMux (WithMuxBearer _ mt) = namesForMux' mt @@ -135,6 +136,7 @@ namesForMux' MuxTraceStartOnDemand {} = ["StartOnDemand"] namesForMux' MuxTraceStartedOnDemand {} = ["StartedOnDemand"] namesForMux' MuxTraceTerminating {} = ["Terminating"] namesForMux' MuxTraceShutdown {} = ["Shutdown"] +namesForMux' MuxTraceTCPInfo {} = ["TCPInfo"] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 344ae496470..ef4117d2f12 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -744,6 +744,7 @@ namesForConnectionManager TrConnectionManagerCounters {} = ["ConnectionManagerCo namesForConnectionManager TrState {} = ["State"] namesForConnectionManager ConnectionManager.TrUnexpectedlyFalseAssertion {} = ["UnexpectedlyFalseAssertion"] +namesForConnectionManager TrUnknownConnection {} = ["UnknownConnection"] severityConnectionManager :: ConnectionManagerTrace addr @@ -778,6 +779,7 @@ severityConnectionManager TrConnectionManagerCounters {} = Info severityConnectionManager TrState {} = Info severityConnectionManager ConnectionManager.TrUnexpectedlyFalseAssertion {} = Error +severityConnectionManager TrUnknownConnection {} = Debug instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, ToJSON addr, ToJSON versionNumber, ToJSON agreedOptions) @@ -914,6 +916,11 @@ instance (Show addr, Show versionNumber, Show agreedOptions, LogFormatting addr, [ "kind" .= String "UnexpectedlyFalseAssertion" , "info" .= String (pack . show $ info) ] + forMachine _dtal (TrUnknownConnection info) = + mconcat + [ "kind" .= String "UnknownConnection" + , "info" .= String (pack . show $ info) + ] forHuman = pack . show asMetrics (TrConnectionManagerCounters ConnectionManagerCounters {..}) = [ IntM diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index ea78e2cd64f..ed1a211117d 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -369,6 +369,7 @@ instance HasSeverityAnnotation (WithMuxBearer peer MuxTrace) where MuxTraceStartedOnDemand _ _ -> Info MuxTraceShutdown -> Debug MuxTraceTerminating {} -> Debug + MuxTraceTCPInfo {} -> Debug instance HasPrivacyAnnotation (TraceLocalRootPeers RemoteAddress exception) instance HasSeverityAnnotation (TraceLocalRootPeers RemoteAddress exception) where @@ -461,6 +462,7 @@ instance HasSeverityAnnotation (ConnectionManagerTrace addr (ConnectionHandlerTr TrConnectionManagerCounters {} -> Info TrState {} -> Info ConnMgr.TrUnexpectedlyFalseAssertion {} -> Error + TrUnknownConnection {} -> Debug instance HasPrivacyAnnotation (ConnMgr.AbstractTransitionTrace addr) instance HasSeverityAnnotation (ConnMgr.AbstractTransitionTrace addr) where @@ -1943,6 +1945,10 @@ instance (Show addr, Show versionNumber, Show agreedOptions, ToObject addr, [ "kind" .= String "UnexpectedlyFalseAssertion" , "info" .= String (pack . show $ info) ] + TrUnknownConnection {} -> + mconcat + [ "kind" .= String "UnknownConnection" + ] instance ToJSON state => ToJSON (ConnMgr.MaybeUnknown state) where toJSON (ConnMgr.Known st) = diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 69b5b7b9b8d..49fb6da4eaf 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -1005,6 +1005,10 @@ instance ToJSON (Alonzo.CollectError StandardCrypto) where Alonzo.ByronOutputInContext -> String "Byron output in the presence of a plutus script" Alonzo.TranslationLogicErrorInput -> String "Logic error translating inputs" Alonzo.TranslationLogicErrorRedeemer -> String "Logic error translating redeemers" + Alonzo.TranslationLogicErrorDoubleDatum -> String "Logic error double datum" + Alonzo.LanguageNotSupported -> String "Language not supported" + Alonzo.InlineDatumsNotSupported -> String "Inline datums not supported" + Alonzo.ReferenceScriptsNotSupported -> String "Reference scripts not supported" ] instance ToJSON Alonzo.TagMismatchDescription where diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index ce8406dbc38..40f6f77c873 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -34,7 +34,6 @@ import GHC.Clock (getMonotonicTimeNSec) import Codec.CBOR.Read (DeserialiseFailure) import Data.Aeson (ToJSON (..), Value (..)) -import qualified Data.HashMap.Strict as Map import Data.IntPSQ (IntPSQ) import qualified Data.IntPSQ as Pq import qualified Data.Map.Strict as SMap From 5dd0be8ff39086c0d278f597ce10f72dc2f1cc6b Mon Sep 17 00:00:00 2001 From: Jean-Baptiste Giraudeau Date: Tue, 15 Mar 2022 16:10:08 +0100 Subject: [PATCH 06/15] Bump haskellNix and follow haskellNix/nixpkgs-unstable this also fix legacy nix-shell and nix build. --- cabal.project | 1 + flake.lock | 102 +++++++++++++++++++++++++------------------------- flake.nix | 5 +-- 3 files changed, 54 insertions(+), 54 deletions(-) diff --git a/cabal.project b/cabal.project index 4afae6adcdf..2f459911fe9 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,4 @@ +-- run `nix flake lock --update-input hackageNix` after updating index-state. index-state: 2022-02-18T00:00:00Z packages: diff --git a/flake.lock b/flake.lock index 520f6940e34..38a270d15dc 100644 --- a/flake.lock +++ b/flake.lock @@ -68,10 +68,10 @@ "flake": false, "locked": { "lastModified": 1603716527, - "narHash": "sha256-sDbrmur9Zfp4mPKohCD8IDZfXJ0Tjxpmr2R+kg5PpSY=", + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", "owner": "haskell", "repo": "cabal", - "rev": "94aaa8e4720081f9c75497e2735b90f6a819b08e", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", "type": "github" }, "original": { @@ -135,11 +135,11 @@ "cabal-34": { "flake": false, "locked": { - "lastModified": 1622475795, - "narHash": "sha256-chwTL304Cav+7p38d9mcb+egABWmxo2Aq+xgVBgEb/U=", + "lastModified": 1640353650, + "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", "owner": "haskell", "repo": "cabal", - "rev": "b086c1995cdd616fc8d91f46a21e905cc50a1049", + "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", "type": "github" }, "original": { @@ -203,11 +203,11 @@ "cabal-36": { "flake": false, "locked": { - "lastModified": 1640163203, - "narHash": "sha256-TwDWP2CffT0j40W6zr0J1Qbu+oh3nsF1lUx9446qxZM=", + "lastModified": 1641652457, + "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", "owner": "haskell", "repo": "cabal", - "rev": "ecf418050c1821f25e2e218f1be94c31e0465df1", + "rev": "f27667f8ec360c475027dcaee0138c937477b070", "type": "github" }, "original": { @@ -529,11 +529,11 @@ }, "flake-utils": { "locked": { - "lastModified": 1623875721, - "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", "owner": "numtide", "repo": "flake-utils", - "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", "type": "github" }, "original": { @@ -732,9 +732,7 @@ "hackageNix" ], "hpc-coveralls": "hpc-coveralls", - "nix-tools": [ - "nixTools" - ], + "nix-tools": "nix-tools", "nixpkgs": [ "nixpkgs" ], @@ -746,11 +744,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1646278384, - "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", + "lastModified": 1647315229, + "narHash": "sha256-GRS3fA7jnPY6c+p7xssXthsGG1nG7M+u22DMz9jDZQ4=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "7e06e14ae1b894445254fe41288bfa7dd4ccbc6f", + "rev": "eb49a3b7213470e36570f4aa1ed7a64e6d6cf160", "type": "github" }, "original": { @@ -770,7 +768,7 @@ "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", "hackage": "hackage", "hpc-coveralls": "hpc-coveralls_2", - "nix-tools": "nix-tools", + "nix-tools": "nix-tools_2", "nixpkgs": [ "membench", "cardano-node-snapshot", @@ -808,7 +806,7 @@ "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_3", "hackage": "hackage_2", "hpc-coveralls": "hpc-coveralls_3", - "nix-tools": "nix-tools_2", + "nix-tools": "nix-tools_3", "nixpkgs": [ "membench", "cardano-node-snapshot", @@ -847,7 +845,7 @@ "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_4", "hackage": "hackage_3", "hpc-coveralls": "hpc-coveralls_4", - "nix-tools": "nix-tools_3", + "nix-tools": "nix-tools_4", "nixpkgs": [ "membench", "cardano-node-snapshot", @@ -1131,6 +1129,22 @@ } }, "nix-tools": { + "flake": false, + "locked": { + "lastModified": 1644395812, + "narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "nix-tools", + "type": "github" + } + }, + "nix-tools_2": { "flake": false, "locked": { "lastModified": 1636018067, @@ -1146,7 +1160,7 @@ "type": "github" } }, - "nix-tools_2": { + "nix-tools_3": { "flake": false, "locked": { "lastModified": 1636018067, @@ -1162,7 +1176,7 @@ "type": "github" } }, - "nix-tools_3": { + "nix-tools_4": { "flake": false, "locked": { "lastModified": 1636018067, @@ -1274,11 +1288,11 @@ }, "nixpkgs-2105": { "locked": { - "lastModified": 1640283157, - "narHash": "sha256-6Ddfop+rKE+Gl9Tjp9YIrkfoYPzb8F80ergdjcq3/MY=", + "lastModified": 1642244250, + "narHash": "sha256-vWpUEqQdVP4srj+/YLJRTN9vjpTs4je0cdWKXPbDItc=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "dde1557825c5644c869c5efc7448dc03722a8f09", + "rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00", "type": "github" }, "original": { @@ -1338,11 +1352,11 @@ }, "nixpkgs-2111": { "locked": { - "lastModified": 1640283207, - "narHash": "sha256-SCwl7ZnCfMDsuSYvwIroiAlk7n33bW8HFfY8NvKhcPA=", + "lastModified": 1644510859, + "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "64c7e3388bbd9206e437713351e814366e0c3284", + "rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3", "type": "github" }, "original": { @@ -1402,11 +1416,11 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1641285291, - "narHash": "sha256-KYaOBNGar3XWTxTsYPr9P6u74KAqNq0wobEC236U+0c=", + "lastModified": 1644486793, + "narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "0432195a4b8d68faaa7d3d4b355260a3120aeeae", + "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", "type": "github" }, "original": { @@ -1492,21 +1506,6 @@ "type": "indirect" } }, - "nixpkgs_4": { - "locked": { - "lastModified": 1644486793, - "narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=", - "owner": "nixos", - "repo": "nixpkgs", - "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", - "type": "github" - }, - "original": { - "owner": "nixos", - "repo": "nixpkgs.nix", - "type": "github" - } - }, "old-ghc-nix": { "flake": false, "locked": { @@ -1682,7 +1681,10 @@ "iohkNix": "iohkNix", "membench": "membench", "nixTools": "nixTools", - "nixpkgs": "nixpkgs_4", + "nixpkgs": [ + "haskellNix", + "nixpkgs-unstable" + ], "plutus-example": "plutus-example_2", "utils": "utils_4" } @@ -1690,11 +1692,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1643073493, - "narHash": "sha256-5cPd1+i/skvJY9vJO1BhVRPcJObqkxDSywBEppDmb1U=", + "lastModified": 1647307016, + "narHash": "sha256-5aaOk8EYVifi9nSdqR60ZyshgXYCiLrYrKRtPtM5iAQ=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "48e1188855ca38f3b7e2a8dba5352767a2f0a8f7", + "rev": "66c6141c830c277ad919fb2a6180ee461ca0238b", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index b8e03a42721..f061aa6433e 100644 --- a/flake.nix +++ b/flake.nix @@ -3,9 +3,7 @@ inputs = { # IMPORTANT: report any change to nixpkgs channel in nix/default.nix: - nixpkgs = { - url = "github:nixos/nixpkgs.nix"; - }; + nixpkgs.follows = "haskellNix/nixpkgs-unstable"; hostNixpkgs.follows = "nixpkgs"; hackageNix = { url = "github:input-output-hk/hackage.nix"; @@ -19,7 +17,6 @@ url = "github:input-output-hk/haskell.nix"; inputs.nixpkgs.follows = "nixpkgs"; inputs.hackage.follows = "hackageNix"; - inputs.nix-tools.follows = "nixTools"; }; utils.url = "github:numtide/flake-utils"; iohkNix = { From 5ee966832b4ba3968235ac384069cc252356e0db Mon Sep 17 00:00:00 2001 From: Jean-Baptiste Giraudeau Date: Thu, 17 Mar 2022 12:51:11 +0100 Subject: [PATCH 07/15] Restore build of plutus-example, now from plutus-apps repo. --- flake.lock | 35 +++++++++++++++++------------------ flake.nix | 19 ++++++++++--------- 2 files changed, 27 insertions(+), 27 deletions(-) diff --git a/flake.lock b/flake.lock index 38a270d15dc..24d4e9eecc1 100644 --- a/flake.lock +++ b/flake.lock @@ -1622,6 +1622,22 @@ "type": "github" } }, + "plutus-apps": { + "flake": false, + "locked": { + "lastModified": 1647347289, + "narHash": "sha256-dxKZ1Zvflyt6igYm39POV6X/0giKbfb4U7D1TvevQls=", + "owner": "input-output-hk", + "repo": "plutus-apps", + "rev": "2a40552f4654d695f21783c86e8ae59243ce9dfa", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "plutus-apps", + "type": "github" + } + }, "plutus-example": { "inputs": { "customConfig": "customConfig_4", @@ -1651,23 +1667,6 @@ "type": "github" } }, - "plutus-example_2": { - "flake": false, - "locked": { - "lastModified": 1640022647, - "narHash": "sha256-M+YnF7Zj/7QK2pu0T75xNVaX0eEeijtBH8yz+jEHIMM=", - "owner": "input-output-hk", - "repo": "cardano-node", - "rev": "814df2c146f5d56f8c35a681fe75e85b905aed5d", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "ref": "1.33.0", - "repo": "cardano-node", - "type": "github" - } - }, "root": { "inputs": { "cardano-node-workbench": "cardano-node-workbench", @@ -1685,7 +1684,7 @@ "haskellNix", "nixpkgs-unstable" ], - "plutus-example": "plutus-example_2", + "plutus-apps": "plutus-apps", "utils": "utils_4" } }, diff --git a/flake.nix b/flake.nix index f061aa6433e..5adee8089ec 100644 --- a/flake.nix +++ b/flake.nix @@ -34,6 +34,11 @@ inputs.cardano-node-snapshot.url = "github:input-output-hk/cardano-node/7f00e3ea5a61609e19eeeee4af35241571efdf5c"; inputs.nixpkgs.follows = "nixpkgs"; }; + plutus-apps = { + url = "github:input-output-hk/plutus-apps"; + flake = false; + }; + # Custom user config (default: empty), eg.: # { outputs = {...}: { # # Cutomize listeming port of node scripts: @@ -42,10 +47,6 @@ # }; # }; customConfig.url = "github:input-output-hk/empty-flake"; - plutus-example = { - url = "github:input-output-hk/cardano-node/1.33.0"; - flake = false; - }; ## This pin is to prevent workbench-produced geneses being regenerated each time the node is bumped. cardano-node-workbench = { @@ -54,7 +55,7 @@ }; }; - outputs = { self, nixpkgs, hostNixpkgs, utils, haskellNix, iohkNix, membench, plutus-example, cardano-node-workbench, ... }@input: + outputs = { self, nixpkgs, hostNixpkgs, utils, haskellNix, iohkNix, membench, plutus-apps, cardano-node-workbench, ... }@input: let inherit (nixpkgs) lib; inherit (lib) head systems mapAttrs recursiveUpdate mkDefault @@ -122,10 +123,9 @@ (name: { configureFlags = [ "--ghc-option=-eventlog" ]; }); }]; }; - inherit ((import plutus-example { + inherit ((import plutus-apps { inherit (project.pkgs) system; - gitrev = plutus-example.rev; - }).haskellPackages.plutus-example.components.exes) plutus-example; + }).plutus-apps.haskell.packages.plutus-example.components.exes) plutus-example; pinned-workbench = (import cardano-node-workbench {}).workbench.x86_64-linux; hsPkgsWithPassthru = lib.mapAttrsRecursiveCond (v: !(lib.isDerivation v)) @@ -151,6 +151,7 @@ inherit (bech32.components.exes) bech32; } // lib.optionalAttrs hostPlatform.isUnix { inherit (network-mux.components.exes) cardano-ping; + inherit plutus-example; }); }; @@ -380,7 +381,7 @@ overlay = final: prev: { cardanoNodeProject = flake.project.${final.system}; cardanoNodePackages = mkCardanoNodePackages final.cardanoNodeProject; - inherit (final.cardanoNodePackages) cardano-node cardano-cli cardano-submit-api bech32; + inherit (final.cardanoNodePackages) cardano-node cardano-cli cardano-submit-api bech32 plutus-example; }; nixosModules = { cardano-node = { pkgs, lib, ... }: { From 82ed5957e5147cc5a4407a96edec82bb680adac1 Mon Sep 17 00:00:00 2001 From: Jean-Baptiste Giraudeau Date: Thu, 17 Mar 2022 16:54:20 +0100 Subject: [PATCH 08/15] flake-compat: use builtins.fetchTree if available --- flake.lock | 6 +++--- nix/flake-compat.nix | 17 +++++++---------- 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/flake.lock b/flake.lock index 24d4e9eecc1..e9051d932e0 100644 --- a/flake.lock +++ b/flake.lock @@ -513,11 +513,11 @@ "flake-compat": { "flake": false, "locked": { - "lastModified": 1638445031, - "narHash": "sha256-dtIZLlf2tfYeLvpZa/jFxP5HvfoXAzr7X76yn6FQAdM=", + "lastModified": 1647532380, + "narHash": "sha256-wswAxyO8AJTH7d5oU8VK82yBCpqwA+p6kLgpb1f1PAY=", "owner": "input-output-hk", "repo": "flake-compat", - "rev": "20f79e3976b76a37090fbeec7b49dc08dac96b8e", + "rev": "7da118186435255a30b5ffeabba9629c344c0bec", "type": "github" }, "original": { diff --git a/nix/flake-compat.nix b/nix/flake-compat.nix index 47ec2b7ed71..e62cfa47e55 100644 --- a/nix/flake-compat.nix +++ b/nix/flake-compat.nix @@ -4,16 +4,13 @@ let lock = builtins.fromJSON (builtins.readFile (src + "/flake.lock")); flake-compate-input = lock.nodes.root.inputs.flake-compat; nixpkgs-input = lock.nodes.haskellNix.inputs.${builtins.elemAt lock.nodes.root.inputs.nixpkgs 1}; - flake-compat = import (builtins.fetchTarball { - url = "https://api.github.com/repos/input-output-hk/flake-compat/tarball/${lock.nodes.${flake-compate-input}.locked.rev}"; - sha256 = lock.nodes.${flake-compate-input}.locked.narHash; - }); - pkgs = import - (builtins.fetchTarball { - url = "https://api.github.com/repos/NixOS/nixpkgs/tarball/${lock.nodes.${nixpkgs-input}.locked.rev}"; - sha256 = lock.nodes.${nixpkgs-input}.locked.narHash; - }) - { }; + fetchTree = builtins.fetchTree or (info: + builtins.fetchTarball { + url = "https://api.github.com/repos/${info.owner}/${info.repo}/tarball/${info.rev}"; + sha256 = info.narHash; + }); + flake-compat = import (fetchTree lock.nodes.${flake-compate-input}.locked); + pkgs = import (fetchTree lock.nodes.${nixpkgs-input}.locked) { }; in flake-compat { inherit src pkgs; From 52ad7337b84349b73c645ab679138ad8d42ac801 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Mon, 21 Mar 2022 12:42:03 +0100 Subject: [PATCH 09/15] Run stylish-haskell over changed files --- .../src/Cardano/Benchmarking/Tracer.hs | 30 +++++++++---------- cardano-api/gen/Gen/Cardano/Api/Metadata.hs | 4 +-- cardano-api/src/Cardano/Api/Query.hs | 4 +-- cardano-api/src/Cardano/Api/ScriptData.hs | 6 ++-- cardano-api/src/Cardano/Api/TxMetadata.hs | 18 +++++------ .../Test/Golden/Shelley/Genesis/Create.hs | 2 +- .../src/Cardano/Node/TraceConstraints.hs | 18 +++++------ .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 2 +- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 14 ++++----- .../Cardano/Tracing/OrphanInstances/Byron.hs | 2 +- .../Tracing/OrphanInstances/Consensus.hs | 6 ++-- .../Tracing/OrphanInstances/HardFork.hs | 10 +++---- cardano-node/src/Cardano/Tracing/Peer.hs | 2 +- cardano-node/src/Cardano/Tracing/Tracers.hs | 4 +-- .../TxSubmit/Tracing/ToObjectOrphans.hs | 5 ++-- .../src/Cardano/Logging/FrequencyLimiter.hs | 4 +-- trace-dispatcher/src/Cardano/Logging/Types.hs | 10 +++---- 17 files changed, 69 insertions(+), 72 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index f0c4d6090f9..abde92800c0 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -1,8 +1,8 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -25,40 +25,40 @@ module Cardano.Benchmarking.Tracer ) where -import Prelude (Show(..), String) -import Data.Aeson (ToJSON (..), (.=), encode) +import Data.Aeson (ToJSON (..), encode, (.=)) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy.Char8 as BSL (unpack) import qualified Data.Text as T import Data.Time.Clock (DiffTime, NominalDiffTime, getCurrentTime) +import Prelude (Show (..), String) import Control.Tracer (debugTracer) -import qualified Codec.CBOR.Term as CBOR import Cardano.Api +import qualified Codec.CBOR.Term as CBOR import Cardano.Prelude hiding (TypeError, show) -import Cardano.BM.Tracing import Cardano.BM.Data.Tracer (trStructured) -import Network.Mux (WithMuxBearer(..)) +import Cardano.BM.Tracing +import Network.Mux (WithMuxBearer (..)) -import Cardano.Node.Configuration.Logging (LOContent(..), LoggingLayer (..)) -import Cardano.Tracing.OrphanInstances.Byron() -import Cardano.Tracing.OrphanInstances.Common() -import Cardano.Tracing.OrphanInstances.Consensus() -import Cardano.Tracing.OrphanInstances.Network() -import Cardano.Tracing.OrphanInstances.Shelley() +import Cardano.Node.Configuration.Logging (LOContent (..), LoggingLayer (..)) +import Cardano.Tracing.OrphanInstances.Byron () +import Cardano.Tracing.OrphanInstances.Common () +import Cardano.Tracing.OrphanInstances.Consensus () +import Cardano.Tracing.OrphanInstances.Network () +import Cardano.Tracing.OrphanInstances.Shelley () import Cardano.Benchmarking.OuroborosImports -import Ouroboros.Network.Driver (TraceSendRecv (..)) -import Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2) import Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId) -import Ouroboros.Network.NodeToNode (RemoteConnectionId, NodeToNodeVersion) +import Ouroboros.Network.Driver (TraceSendRecv (..)) +import Ouroboros.Network.NodeToNode (NodeToNodeVersion, RemoteConnectionId) import Ouroboros.Network.Protocol.Handshake.Type (Handshake) +import Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2) import Cardano.Benchmarking.Types import qualified Data.Aeson.KeyMap as KeyMap diff --git a/cardano-api/gen/Gen/Cardano/Api/Metadata.hs b/cardano-api/gen/Gen/Cardano/Api/Metadata.hs index 353c8dc8548..729596386a6 100644 --- a/cardano-api/gen/Gen/Cardano/Api/Metadata.hs +++ b/cardano-api/gen/Gen/Cardano/Api/Metadata.hs @@ -6,12 +6,13 @@ module Gen.Cardano.Api.Metadata , genJsonForTxMetadata ) where -import Cardano.Prelude import Cardano.Api +import Cardano.Prelude import Data.Aeson (ToJSON (..)) import Hedgehog (Gen) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import qualified Data.Map.Strict as Map @@ -20,7 +21,6 @@ import qualified Data.Text.Encoding as Text import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Internal.Gen as Gen import qualified Hedgehog.Range as Range -import qualified Data.Aeson.Key as Aeson -- ---------------------------------------------------------------------------- -- Generators diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index 4bdad3321f8..67cbccfdb2d 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -119,10 +119,10 @@ import Cardano.Api.ProtocolParameters import Cardano.Api.TxBody import Cardano.Api.Value -import Data.Word (Word64) import qualified Cardano.Protocol.TPraos.API as TPraos -import qualified Data.Compact.SplitMap as SplitMap import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Compact.SplitMap as SplitMap +import Data.Word (Word64) -- ---------------------------------------------------------------------------- -- Queries diff --git a/cardano-api/src/Cardano/Api/ScriptData.hs b/cardano-api/src/Cardano/Api/ScriptData.hs index a16493404f0..8d1b5e75c13 100644 --- a/cardano-api/src/Cardano/Api/ScriptData.hs +++ b/cardano-api/src/Cardano/Api/ScriptData.hs @@ -71,16 +71,16 @@ import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.Hash import Cardano.Api.KeysShelley -import Cardano.Api.SerialiseJSON import Cardano.Api.SerialiseCBOR +import Cardano.Api.SerialiseJSON import Cardano.Api.SerialiseRaw import qualified Cardano.Binary as CBOR import Cardano.Api.SerialiseUsing import Cardano.Api.TxMetadata (pBytes, pSigned, parseAll) -import Codec.Serialise.Class (Serialise(..)) -import qualified Data.Aeson.KeyMap as KeyMap +import Codec.Serialise.Class (Serialise (..)) import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as KeyMap -- ---------------------------------------------------------------------------- -- Script data diff --git a/cardano-api/src/Cardano/Api/TxMetadata.hs b/cardano-api/src/Cardano/Api/TxMetadata.hs index 9556040fa7e..72e06957fe1 100644 --- a/cardano-api/src/Cardano/Api/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/TxMetadata.hs @@ -43,23 +43,23 @@ module Cardano.Api.TxMetadata ( import Prelude import Data.Bifunctor (first) -import Data.Maybe (fromMaybe) -import Data.Word -import qualified Data.Scientific as Scientific import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy.Char8 as LBS -import qualified Data.ByteString.Base16 as Base16 +import qualified Data.List as List +import qualified Data.Map.Lazy as Map.Lazy +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) +import qualified Data.Scientific as Scientific import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as Text.Lazy -import qualified Data.Map.Lazy as Map.Lazy -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import qualified Data.List as List import qualified Data.Vector as Vector +import Data.Word import qualified Data.Aeson as Aeson import qualified Data.Aeson.Text as Aeson.Text @@ -76,8 +76,8 @@ import Cardano.Api.Eras import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.SerialiseCBOR -import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as KeyMap {- HLINT ignore "Use lambda-case" -} diff --git a/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs b/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs index 80f9ec7211d..bcf8d5230b2 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs @@ -11,8 +11,8 @@ import Prelude (String) import Test.OptParse as OP import qualified Data.Aeson as J -import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Key as J +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Types as J import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Lazy as HM diff --git a/cardano-node/src/Cardano/Node/TraceConstraints.hs b/cardano-node/src/Cardano/Node/TraceConstraints.hs index a79f208dcfd..dbdcf967ed2 100644 --- a/cardano-node/src/Cardano/Node/TraceConstraints.hs +++ b/cardano-node/src/Cardano/Node/TraceConstraints.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} module Cardano.Node.TraceConstraints (TraceConstraints) where @@ -9,8 +9,8 @@ import Data.Aeson import Cardano.BM.Tracing (ToObject) import Cardano.Logging (LogFormatting) -import Cardano.Node.Queries (ConvertTxId, GetKESInfo (..), - HasKESInfo (..), HasKESMetricsData (..), LedgerQueries) +import Cardano.Node.Queries (ConvertTxId, GetKESInfo (..), HasKESInfo (..), + HasKESMetricsData (..), LedgerQueries) import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Rules.Bbody (AlonzoBbodyPredFail) @@ -18,14 +18,12 @@ import Cardano.Ledger.Alonzo.Rules.Utxo (UtxoPredicateFailure) import Cardano.Ledger.Alonzo.Rules.Utxow (UtxowPredicateFail) import Cardano.Ledger.Crypto (StandardCrypto) -import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, - ConvertRawHash, ForgeStateUpdateError, Header) +import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ConvertRawHash, + ForgeStateUpdateError, Header) import Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError) import Ouroboros.Consensus.Ledger.Abstract (LedgerError) -import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent, LedgerUpdate, - LedgerWarning) -import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, - HasTxId, HasTxs (..)) +import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent, LedgerUpdate, LedgerWarning) +import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, HasTxId, HasTxs (..)) import Ouroboros.Consensus.Protocol.Abstract (ValidationErr) import Ouroboros.Consensus.Shelley.Ledger.Mempool (GenTx, TxId) import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index fad36a49b90..e5331d121f8 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -50,8 +50,8 @@ import qualified Ouroboros.Consensus.Storage.VolatileDB as VolDB import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb import Ouroboros.Consensus.Util.Condense (condense) -import qualified Ouroboros.Network.AnchoredFragment as AF import qualified Data.Aeson.KeyMap as KeyMap +import qualified Ouroboros.Network.AnchoredFragment as AF {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-} diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index f846858ef60..c7f32900e38 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -83,22 +83,23 @@ import Cardano.Prelude hiding (All, Show, show) import Cardano.Protocol.TPraos.OCert (KESPeriod (..)) +import Ouroboros.Network.Block hiding (blockPrevHash) import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch -import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) -import Ouroboros.Network.TxSubmission.Inbound hiding(txId) -import Ouroboros.Network.TxSubmission.Outbound -import Ouroboros.Network.Block hiding (blockPrevHash) import Ouroboros.Network.BlockFetch.Decision import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) +import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) +import Ouroboros.Network.TxSubmission.Inbound hiding (txId) +import Ouroboros.Network.TxSubmission.Outbound +import qualified Data.Aeson as Aeson import Ouroboros.Consensus.Block import Ouroboros.Consensus.BlockchainTime (SystemStart (..)) import Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..)) import Ouroboros.Consensus.Cardano.Block import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent (..), LedgerUpdate, LedgerWarning) -import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId, - LedgerSupportsMempool, txForgetValidated, txId, HasTxId) +import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId, HasTxId, + LedgerSupportsMempool, txForgetValidated, txId) import Ouroboros.Consensus.Ledger.SupportsProtocol import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server @@ -110,7 +111,6 @@ import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, estimateBlockSize) import Ouroboros.Consensus.Node.Tracers import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey -import qualified Data.Aeson as Aeson diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs index 02e0c07c812..c4551be85ae 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Byron.hs @@ -16,9 +16,9 @@ import Data.Aeson (Value (..)) import qualified Data.Set as Set import qualified Data.Text as Text -import Cardano.Tracing.Render (renderTxId) import Cardano.Tracing.OrphanInstances.Common import Cardano.Tracing.OrphanInstances.Consensus () +import Cardano.Tracing.Render (renderTxId) import Ouroboros.Consensus.Block (Header) import Ouroboros.Network.Block (blockHash, blockNo, blockSlot) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index d631fdfd611..95122a13419 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -57,9 +57,9 @@ import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (ChunkNo (..), chunkNoToInt) import Ouroboros.Consensus.Storage.LedgerDB.Types +import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) -import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB import Ouroboros.Consensus.Util.Condense import Ouroboros.Consensus.Util.Orphans () @@ -71,10 +71,10 @@ import Ouroboros.Network.Point (withOrigin) import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB -- TODO: 'TraceCacheEvent' should be exported by the 'Impl' module -import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB +import qualified Data.Aeson as Aeson import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB +import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB -import qualified Data.Aeson as Aeson {- HLINT ignore "Use const" -} diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs index 870af7afabf..0ca9e2adf6b 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/HardFork.hs @@ -29,15 +29,15 @@ import Cardano.Tracing.OrphanInstances.Consensus () import Cardano.Slotting.Slot (EpochSize (..)) import Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeStateInfo, - ForgeStateUpdateError) + ForgeStateUpdateError) import Ouroboros.Consensus.BlockchainTime (getSlotLength) import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..), - OneEraCannotForge (..), OneEraEnvelopeErr (..), OneEraForgeStateInfo (..), - OneEraForgeStateUpdateError (..), OneEraLedgerError (..), - OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraValidationErr (..), - mkEraMismatch) + OneEraCannotForge (..), OneEraEnvelopeErr (..), OneEraForgeStateInfo (..), + OneEraForgeStateUpdateError (..), OneEraLedgerError (..), + OneEraLedgerUpdate (..), OneEraLedgerWarning (..), OneEraValidationErr (..), + mkEraMismatch) import Ouroboros.Consensus.HardFork.Combinator.Condense () import Ouroboros.Consensus.HardFork.History.EraParams (EraParams (..), SafeZone) import Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError) diff --git a/cardano-node/src/Cardano/Tracing/Peer.hs b/cardano-node/src/Cardano/Tracing/Peer.hs index 2d26155bfb3..b29d925adaf 100644 --- a/cardano-node/src/Cardano/Tracing/Peer.hs +++ b/cardano-node/src/Cardano/Tracing/Peer.hs @@ -26,8 +26,8 @@ import Cardano.BM.Trace (traceNamedObject) import Cardano.BM.Tracing import Ouroboros.Consensus.Block (Header) -import Ouroboros.Network.ConnectionId (remoteAddress) import Ouroboros.Consensus.Util.Orphans () +import Ouroboros.Network.ConnectionId (remoteAddress) import qualified Ouroboros.Network.AnchoredFragment as Net import Ouroboros.Network.Block (unSlotNo) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 40f6f77c873..6c53b0d7cf1 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -44,7 +44,7 @@ import qualified System.Metrics.Gauge as Gauge import qualified System.Metrics.Label as Label import qualified System.Remote.Monitoring as EKG -import "contra-tracer" Control.Tracer +import "contra-tracer" Control.Tracer import Control.Tracer.Transformers import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..), WithOrigin (..)) @@ -104,8 +104,8 @@ import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB import Cardano.Tracing.Config import Cardano.Tracing.Metrics -import Cardano.Tracing.Startup () import Cardano.Tracing.Shutdown () +import Cardano.Tracing.Startup () import Cardano.Node.Configuration.Logging import Cardano.Node.TraceConstraints diff --git a/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs b/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs index 03ce7cab014..351ba4e7c90 100644 --- a/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs +++ b/cardano-submit-api/src/Cardano/TxSubmit/Tracing/ToObjectOrphans.hs @@ -8,8 +8,7 @@ module Cardano.TxSubmit.Tracing.ToObjectOrphans () where import Cardano.BM.Data.Severity (Severity (Debug, Error, Notice, Warning)) import Cardano.BM.Data.Tracer (HasPrivacyAnnotation, HasSeverityAnnotation (..), - HasTextFormatter, ToObject (toObject), Transformable (..), - trStructured) + HasTextFormatter, ToObject (toObject), Transformable (..), trStructured) import Data.Aeson ((.=)) import Data.String (String) import Data.Text (Text) @@ -17,8 +16,8 @@ import Ouroboros.Network.NodeToClient (ErrorPolicyTrace (..), WithAddr import System.IO (IO) import Text.Show (Show (..)) +import Data.Monoid (mconcat) import qualified Network.Socket as Socket -import Data.Monoid (mconcat) instance HasPrivacyAnnotation (WithAddr Socket.SockAddr ErrorPolicyTrace) instance HasSeverityAnnotation (WithAddr Socket.SockAddr ErrorPolicyTrace) where diff --git a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs index 3c99466e16e..841272ce12b 100644 --- a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs +++ b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Cardano.Logging.FrequencyLimiter ( diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 396e83f30c8..c0b8972d0ac 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeSynonymInstances #-} module Cardano.Logging.Types ( From eeff6842460c6021e7c0fda9d9ae3634e1ba30c1 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Tue, 22 Mar 2022 14:45:38 +0100 Subject: [PATCH 10/15] fixup! Update dependencies and pins. --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 2f459911fe9..fa92d5d54de 100644 --- a/cabal.project +++ b/cabal.project @@ -157,7 +157,7 @@ source-repository-package type: git location: https://github.com/vshabanov/ekg-json tag: 00ebe7211c981686e65730b7144fbf5350462608 - --sha256: sha256-VT8Ur585TCn03P2TVi6t92v2Z6tl8vKijICjse6ocv8= + --sha256: 1zvjm3pb38w0ijig5wk5mdkzcszpmlp5d4zxvks2jk1rkypi8gsm source-repository-package type: git @@ -257,7 +257,7 @@ source-repository-package type: git location: https://github.com/input-output-hk/ouroboros-network tag: 83744fe3b752fd8200de2ea1416e34c576c74f35 - --sha256: sha256-qOA2cF757RNYW1QkhfdPjdUee2Qa/BVaNv181w8eCmw= + --sha256: 0v0a3q7xfz7x6rd1bz0scixixmcd9zvqa92lbdc17vgrbrq3dq58 subdir: io-sim io-classes From 638e3a6d991f5142393c08006c3c7b7a849f61a6 Mon Sep 17 00:00:00 2001 From: Jean-Baptiste Giraudeau Date: Tue, 22 Mar 2022 15:42:16 +0100 Subject: [PATCH 11/15] bump haskell.nix for secp256k1 fix on musl (enable static build) --- flake.lock | 115 +++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 103 insertions(+), 12 deletions(-) diff --git a/flake.lock b/flake.lock index e9051d932e0..f17f5af1c4a 100644 --- a/flake.lock +++ b/flake.lock @@ -253,7 +253,7 @@ }, "cardano-mainnet-mirror": { "inputs": { - "nixpkgs": "nixpkgs" + "nixpkgs": "nixpkgs_2" }, "locked": { "lastModified": 1642701714, @@ -272,7 +272,7 @@ }, "cardano-mainnet-mirror_2": { "inputs": { - "nixpkgs": "nixpkgs_2" + "nixpkgs": "nixpkgs_3" }, "locked": { "lastModified": 1642701714, @@ -291,7 +291,7 @@ }, "cardano-mainnet-mirror_3": { "inputs": { - "nixpkgs": "nixpkgs_3" + "nixpkgs": "nixpkgs_4" }, "locked": { "lastModified": 1642701714, @@ -732,6 +732,7 @@ "hackageNix" ], "hpc-coveralls": "hpc-coveralls", + "hydra": "hydra", "nix-tools": "nix-tools", "nixpkgs": [ "nixpkgs" @@ -744,11 +745,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1647315229, - "narHash": "sha256-GRS3fA7jnPY6c+p7xssXthsGG1nG7M+u22DMz9jDZQ4=", + "lastModified": 1647960987, + "narHash": "sha256-Jb2xIncXlqvkMmEGsMDdWScdLGhEegNCdhSJswsOAkI=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "eb49a3b7213470e36570f4aa1ed7a64e6d6cf160", + "rev": "53ffd8eac65e3f029865b00f7eca49373388b691", "type": "github" }, "original": { @@ -937,6 +938,29 @@ "type": "github" } }, + "hydra": { + "inputs": { + "nix": "nix", + "nixpkgs": [ + "haskellNix", + "hydra", + "nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1646878427, + "narHash": "sha256-KtbrofMtN8GlM7D+n90kixr7QpSlVmdN+vK5CA/aRzc=", + "owner": "NixOS", + "repo": "hydra", + "rev": "28b682b85b7efc5cf7974065792a1f22203a5927", + "type": "github" + }, + "original": { + "id": "hydra", + "type": "indirect" + } + }, "iohkNix": { "inputs": { "nixpkgs": [ @@ -1026,6 +1050,22 @@ "type": "github" } }, + "lowdown-src": { + "flake": false, + "locked": { + "lastModified": 1633514407, + "narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=", + "owner": "kristapsdz", + "repo": "lowdown", + "rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8", + "type": "github" + }, + "original": { + "owner": "kristapsdz", + "repo": "lowdown", + "type": "github" + } + }, "membench": { "inputs": { "cardano-mainnet-mirror": "cardano-mainnet-mirror", @@ -1128,6 +1168,27 @@ "type": "github" } }, + "nix": { + "inputs": { + "lowdown-src": "lowdown-src", + "nixpkgs": "nixpkgs", + "nixpkgs-regression": "nixpkgs-regression" + }, + "locked": { + "lastModified": 1643066034, + "narHash": "sha256-xEPeMcNJVOeZtoN+d+aRwolpW8mFSEQx76HTRdlhPhg=", + "owner": "NixOS", + "repo": "nix", + "rev": "a1cd7e58606a41fcf62bf8637804cf8306f17f62", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "2.6.0", + "repo": "nix", + "type": "github" + } + }, "nix-tools": { "flake": false, "locked": { @@ -1210,15 +1271,16 @@ }, "nixpkgs": { "locked": { - "lastModified": 1642336556, - "narHash": "sha256-QSPPbFEwy0T0DrIuSzAACkaANPQaR1lZR/nHZGz9z04=", + "lastModified": 1632864508, + "narHash": "sha256-d127FIvGR41XbVRDPVvozUPQ/uRHbHwvfyKHwEt5xFM=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "f3d9d4bd898cca7d04af2ae4f6ef01f2219df3d6", + "rev": "82891b5e2c2359d7e58d08849e4c89511ab94234", "type": "github" }, "original": { "id": "nixpkgs", + "ref": "nixos-21.05-small", "type": "indirect" } }, @@ -1414,6 +1476,21 @@ "type": "github" } }, + "nixpkgs-regression": { + "locked": { + "lastModified": 1643052045, + "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "indirect" + } + }, "nixpkgs-unstable": { "locked": { "lastModified": 1644486793, @@ -1506,6 +1583,20 @@ "type": "indirect" } }, + "nixpkgs_4": { + "locked": { + "lastModified": 1642336556, + "narHash": "sha256-QSPPbFEwy0T0DrIuSzAACkaANPQaR1lZR/nHZGz9z04=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "f3d9d4bd898cca7d04af2ae4f6ef01f2219df3d6", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, "old-ghc-nix": { "flake": false, "locked": { @@ -1691,11 +1782,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1647307016, - "narHash": "sha256-5aaOk8EYVifi9nSdqR60ZyshgXYCiLrYrKRtPtM5iAQ=", + "lastModified": 1647911723, + "narHash": "sha256-SfHe7QWAH4A1gHj1LSEFNXMJACvzbgQn2KkjdJOkCQ4=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "66c6141c830c277ad919fb2a6180ee461ca0238b", + "rev": "00701d47768afdf1788a8bb1b84e3b1c7bf71581", "type": "github" }, "original": { From 87e4bf36244efe3595b0b5e8a14a425a66f4967f Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Thu, 24 Mar 2022 12:09:50 +0100 Subject: [PATCH 12/15] Apply hlint suggestions. Seems these are actually required for the build. --- .../src/Cardano/Tracing/OrphanInstances/Consensus.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 95122a13419..7ead15be00b 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -1158,7 +1158,7 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) => ToObject (TraceChainSyncClientEvent blk) where toObject verb ev = case ev of TraceDownloadedHeader h -> - mconcat $ + mconcat [ "kind" .= String "ChainSyncClientEvent.TraceDownloadedHeader" , tipToObject (tipFromHeader h) ] @@ -1178,22 +1178,22 @@ instance ConvertRawHash blk => ToObject (TraceChainSyncServerEvent blk) where toObject verb ev = case ev of TraceChainSyncServerRead tip AddBlock{} -> - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerRead.AddBlock" , tipToObject tip ] TraceChainSyncServerRead tip RollBack{} -> - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerRead.RollBack" , tipToObject tip ] TraceChainSyncServerReadBlocked tip AddBlock{} -> - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerReadBlocked.AddBlock" , tipToObject tip ] TraceChainSyncServerReadBlocked tip RollBack{} -> - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerEvent.TraceChainSyncServerReadBlocked.RollBack" , tipToObject tip ] From 17b0d8b9ce2ab4f148c872020b11736507460192 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Thu, 24 Mar 2022 12:24:12 +0100 Subject: [PATCH 13/15] Build libsecp256k1 on linux. This should fix the non-nix linux build. --- .github/workflows/haskell.yml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index ebaf880fdff..f8ddc40d727 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -105,6 +105,22 @@ jobs: sudo apt-get -y remove --purge software-properties-common sudo apt-get -y autoremove + - name: Install secp256k1 (Linux) + if: matrix.os == 'ubuntu-latest' + run: | + sudo apt-get -y install autoconf automake libtool + mkdir secp256k1-sources + cd secp256k1-sources + git clone https://github.com/bitcoin-core/secp256k1.git + cd secp256k1 + git reset --hard $SECP256K1_REF + ./autogen.sh + ./configure --prefix=/usr --enable-module-schnorrsig --enable-experimental + make + make check + sudo make install + cd ../.. + - name: Cabal update run: retry 2 cabal update From 0a7b4f75864e6aac4be13d287464dc6343c07ea2 Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Thu, 24 Mar 2022 15:01:43 +0100 Subject: [PATCH 14/15] Apply hlint everywhere --- .../src/Cardano/Node/Tracing/Tracers/Consensus.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index c7f32900e38..3abb7b2e5b9 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -265,22 +265,22 @@ namesForChainSyncServerEvent TraceChainSyncRollBackward {} = instance ConvertRawHash blk => LogFormatting (TraceChainSyncServerEvent blk) where forMachine _dtal (TraceChainSyncServerRead tip (AddBlock _hdr)) = - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerRead.AddBlock" , tipToObject tip ] forMachine _dtal (TraceChainSyncServerRead tip (RollBack _pt)) = - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerRead.RollBack" , tipToObject tip ] forMachine _dtal (TraceChainSyncServerReadBlocked tip (AddBlock _hdr)) = - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerReadBlocked.AddBlock" , tipToObject tip ] forMachine _dtal (TraceChainSyncServerReadBlocked tip (RollBack _pt)) = - mconcat $ + mconcat [ "kind" .= String "ChainSyncServerReadBlocked.RollBack" , tipToObject tip ] From f1dac088ac998457ac1c91411b6f7e1a21fa5dcc Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Wed, 30 Mar 2022 14:25:11 +0200 Subject: [PATCH 15/15] Move Aeson imports around. --- cardano-api/src/Cardano/Api/ScriptData.hs | 4 +-- cardano-api/src/Cardano/Api/TxBody.hs | 2 +- cardano-api/src/Cardano/Api/TxMetadata.hs | 31 ++++++++----------- cardano-api/src/Cardano/Api/Value.hs | 2 +- cardano-cli/src/Cardano/CLI/Run/Friendly.hs | 19 +++++------- cardano-cli/src/Cardano/CLI/Shelley/Output.hs | 12 +++---- cardano-node/src/Cardano/Tracing/Config.hs | 2 +- .../examples/Examples/Configuration.hs | 2 +- 8 files changed, 32 insertions(+), 42 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ScriptData.hs b/cardano-api/src/Cardano/Api/ScriptData.hs index 8d1b5e75c13..98be2270242 100644 --- a/cardano-api/src/Cardano/Api/ScriptData.hs +++ b/cardano-api/src/Cardano/Api/ScriptData.hs @@ -55,6 +55,8 @@ import qualified Data.Vector as Vector import Data.Word import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Text as Aeson.Text import qualified Data.Attoparsec.ByteString.Char8 as Atto @@ -79,8 +81,6 @@ import qualified Cardano.Binary as CBOR import Cardano.Api.SerialiseUsing import Cardano.Api.TxMetadata (pBytes, pSigned, parseAll) import Codec.Serialise.Class (Serialise (..)) -import qualified Data.Aeson.Key as Aeson -import qualified Data.Aeson.KeyMap as KeyMap -- ---------------------------------------------------------------------------- -- Script data diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index a356144b604..e52789b815b 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -147,6 +147,7 @@ import Control.Monad (guard) import Data.Aeson (object, withObject, withText, (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as KeyMap import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText) import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (first) @@ -244,7 +245,6 @@ import Cardano.Api.Value import Cardano.Api.ValueParser import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Crypto (StandardCrypto) -import qualified Data.Aeson.KeyMap as KeyMap {- HLINT ignore "Redundant flip" -} {- HLINT ignore "Use section" -} diff --git a/cardano-api/src/Cardano/Api/TxMetadata.hs b/cardano-api/src/Cardano/Api/TxMetadata.hs index 72e06957fe1..a3fc3338ae1 100644 --- a/cardano-api/src/Cardano/Api/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/TxMetadata.hs @@ -42,6 +42,19 @@ module Cardano.Api.TxMetadata ( import Prelude +import Cardano.Api.Eras +import Cardano.Api.Error +import Cardano.Api.HasTypeProxy +import Cardano.Api.SerialiseCBOR +import qualified Cardano.Binary as CBOR +import qualified Cardano.Ledger.Shelley.Metadata as Shelley +import Control.Applicative (Alternative (..)) +import Control.Monad (guard, when) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.Aeson.Text as Aeson.Text +import qualified Data.Attoparsec.ByteString.Char8 as Atto import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -61,24 +74,6 @@ import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Vector as Vector import Data.Word -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Text as Aeson.Text -import qualified Data.Attoparsec.ByteString.Char8 as Atto - -import Control.Applicative (Alternative (..)) -import Control.Monad (guard, when) - -import qualified Cardano.Binary as CBOR - -import qualified Cardano.Ledger.Shelley.Metadata as Shelley - -import Cardano.Api.Eras -import Cardano.Api.Error -import Cardano.Api.HasTypeProxy -import Cardano.Api.SerialiseCBOR -import qualified Data.Aeson.Key as Aeson -import qualified Data.Aeson.KeyMap as KeyMap - {- HLINT ignore "Use lambda-case" -} -- ---------------------------------------------------------------------------- diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 25f7c5ac15b..bc30a283573 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -60,6 +60,7 @@ import Prelude import Data.Aeson (FromJSON, FromJSONKey, ToJSON, object, parseJSON, toJSON, withObject) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as KeyMap import Data.Aeson.Types (Parser, ToJSONKey) import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -85,7 +86,6 @@ import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseRaw import Cardano.Api.SerialiseUsing import Cardano.Api.Utils (note) -import qualified Data.Aeson.KeyMap as KeyMap -- ---------------------------------------------------------------------------- diff --git a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs index ac1c579dcdf..6dbf438278c 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Friendly.hs @@ -10,10 +10,17 @@ -- | User-friendly pretty-printing for textual user interfaces (TUI) module Cardano.CLI.Run.Friendly (friendlyTxBS, friendlyTxBodyBS) where +import Cardano.Api as Api +import Cardano.Api.Byron (KeyWitness (ByronKeyWitness)) +import Cardano.Api.Shelley (Address (ShelleyAddress), + KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..)) +import Cardano.CLI.Helpers (textShow) +import Cardano.Ledger.Crypto (Crypto) +import qualified Cardano.Ledger.Shelley.API as Shelley import Cardano.Prelude - import Data.Aeson (Value (..), object, toJSON, (.=)) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Key as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.ByteString.Char8 as BSC import qualified Data.Map.Strict as Map @@ -22,16 +29,6 @@ import Data.Yaml (array) import Data.Yaml.Pretty (setConfCompare) import qualified Data.Yaml.Pretty as Yaml -import Cardano.Api as Api -import Cardano.Api.Byron (KeyWitness (ByronKeyWitness)) -import Cardano.Api.Shelley (Address (ShelleyAddress), - KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), StakeAddress (..)) -import Cardano.Ledger.Crypto (Crypto) -import qualified Cardano.Ledger.Shelley.API as Shelley - -import Cardano.CLI.Helpers (textShow) -import qualified Data.Aeson.Key as Aeson - yamlConfig :: Yaml.Config yamlConfig = Yaml.defConfig & setConfCompare compare diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs b/cardano-cli/src/Cardano/CLI/Shelley/Output.hs index e20853bfabc..65ccbdcfef9 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Output.hs @@ -13,20 +13,18 @@ module Cardano.CLI.Shelley.Output import Cardano.Api import Cardano.Api.Shelley -import Prelude - +import Cardano.CLI.Shelley.Orphans () +import Cardano.Ledger.Shelley.Scripts () +import Cardano.Slotting.Time (SystemStart (..)) import Data.Aeson +import qualified Data.Aeson.Key as Aeson import qualified Data.List as List import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Word - -import Cardano.CLI.Shelley.Orphans () -import Cardano.Ledger.Shelley.Scripts () -import Cardano.Slotting.Time (SystemStart (..)) -import qualified Data.Aeson.Key as Aeson +import Prelude data QueryKesPeriodInfoOutput = QueryKesPeriodInfoOutput diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index 113bacebaae..35e70dc2d09 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -26,13 +26,13 @@ import Cardano.Prelude import Prelude (String) import Data.Aeson +import qualified Data.Aeson.Key as Aeson import Data.Aeson.Types import qualified Data.Text as Text import Generic.Data (gmappend) import Cardano.BM.Tracing (TracingVerbosity (..)) import Cardano.Node.Orphans () -import qualified Data.Aeson.Key as Aeson data TraceOptions diff --git a/trace-dispatcher/examples/Examples/Configuration.hs b/trace-dispatcher/examples/Examples/Configuration.hs index 2ca2001fb3a..a73f89418cb 100644 --- a/trace-dispatcher/examples/Examples/Configuration.hs +++ b/trace-dispatcher/examples/Examples/Configuration.hs @@ -7,11 +7,11 @@ module Examples.Configuration ( import Control.Monad.IO.Class import qualified Data.Aeson as AE +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Map as Map import Data.Text (Text) import Cardano.Logging -import qualified Data.Aeson.KeyMap as KeyMap newtype TestMessage = TestMessage Text deriving Show