WIP CAD-2069 locli: log analysis

benchmarks/shelley3pools/analyse.sh

@@ -31,7 +31,7 @@ else
 fi
 
 # stem of logfile names:
-LOGFILESTEM=${LOGFILESTEM:-"node"}
+LOGFILESTEM=${LOGFILESTEM:-"node-"}
 for N in $(seq 0 $((NNODES - 1))); do
   echo "analysing logs of node ${N}"
   ../../scripts/nodeisleader.sh ${LOGPATH}/${LOGFILESTEM}$((N+1))-*.json | sed -e 's/^\(.*\)$/'${N}',\1/' - > ${OUTDIR}/leader-${N}.csv

cabal.project

@@ -17,6 +17,7 @@ packages:
     -- ../cardano-node/cardano-cli
     -- ../cardano-node/cardano-node
     -- ../cardano-node/cardano-config
+    locli
 
 allow-newer: base
 

locli/NOTICE

@@ -0,0 +1,13 @@
+Copyright 2020 Input Output (Hong Kong) Ltd.
+
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
+
+       http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.

locli/app/locli.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import           Cardano.Prelude hiding (option)
+
+import           Control.Monad.Trans.Except.Exit (orDie)
+import qualified Options.Applicative as Opt
+
+import           Cardano.Unlog.Parsers (opts, pref)
+import           Cardano.Unlog.Run (renderClientCommandError, runClientCommand)
+import           Cardano.TopHandler
+
+
+main :: IO ()
+main = toplevelExceptionHandler $ do
+
+  co <- Opt.customExecParser pref opts
+
+  orDie renderClientCommandError $ runClientCommand co

locli/locli.cabal

@@ -0,0 +1,79 @@
+cabal-version: 2.4
+
+name:                  locli
+version:               1.21.1
+description:           Log parsing CLI.
+author:                IOHK
+maintainer:            operations@iohk.io
+license:               Apache-2.0
+license-files:
+  NOTICE
+build-type:            Simple
+
+library
+
+  hs-source-dirs:      src
+
+  exposed-modules:     Cardano.Config.Git.Rev
+                       Cardano.Config.Git.RevFromGit
+
+                       Cardano.TopHandler
+
+                       Cardano.Unlog.Analysis
+                       Cardano.Unlog.Commands
+                       Cardano.Unlog.Parsers
+                       Cardano.Unlog.Run
+
+  other-modules:       Paths_locli
+
+  build-depends:       base
+                     , aeson
+                     , aeson-pretty
+                     , attoparsec
+                     , attoparsec-iso8601
+                     , bytestring
+                     , cardano-prelude
+                     , containers
+                     , directory
+                     , filepath
+                     , file-embed
+                     , optparse-applicative
+                     , process
+                     , scientific
+                     , split
+                     , template-haskell
+                     , text
+                     , time
+                     , transformers
+                     , transformers-except
+                     , utf8-string
+
+  default-language:    Haskell2010
+  default-extensions:  NoImplicitPrelude
+                       OverloadedStrings
+                       TupleSections
+
+  ghc-options:         -Wall
+                       -Wincomplete-record-updates
+                       -Wincomplete-uni-patterns
+                       -Wredundant-constraints
+                       -Wpartial-fields
+                       -Wcompat
+                       -Wno-all-missed-specialisations
+
+executable locli
+  hs-source-dirs:      app
+  main-is:             locli.hs
+  default-language:    Haskell2010
+  ghc-options:         -threaded
+                       -Wall
+                       -rtsopts
+                       "-with-rtsopts=-T"
+  build-depends:       base
+                     , cardano-prelude
+                     , locli
+                     , optparse-applicative
+                     , text
+                     , transformers
+                     , transformers-except
+  default-extensions:  NoImplicitPrelude

locli/src/Cardano/Config/Git/Rev.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Cardano.Config.Git.Rev (
+      gitRev
+    ) where
+
+import           Cardano.Prelude
+
+import           Data.FileEmbed (dummySpaceWith)
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Data.Text.Encoding (decodeUtf8)
+
+import           Cardano.Config.Git.RevFromGit (gitRevFromGit)
+
+gitRev :: Text
+gitRev | gitRevEmbed /= zeroRev = gitRevEmbed
+       | T.null fromGit         = zeroRev
+       | otherwise              = fromGit
+    where
+        -- Git revision embedded after compilation using
+        -- Data.FileEmbed.injectWith. If nothing has been injected,
+        -- this will be filled with 0 characters.
+        gitRevEmbed :: Text
+        gitRevEmbed = decodeUtf8 $(dummySpaceWith "gitrev" 40)
+
+        -- Git revision found during compilation by running git. If
+        -- git could not be run, then this will be empty.
+#if defined(arm_HOST_ARCH)
+        -- cross compiling to arm fails; due to a linker bug
+        fromGit = ""
+#else
+        fromGit = T.strip (T.pack $(gitRevFromGit))
+#endif
+
+zeroRev :: Text
+zeroRev = "0000000000000000000000000000000000000000"

locli/src/Cardano/Config/Git/RevFromGit.hs

@@ -0,0 +1,27 @@
+module Cardano.Config.Git.RevFromGit (
+      gitRevFromGit
+    ) where
+
+import           Cardano.Prelude
+import           Prelude (String)
+
+import qualified Language.Haskell.TH as TH
+import           System.Exit (ExitCode (..))
+import           System.IO.Error (ioeGetErrorType, isDoesNotExistErrorType)
+import           System.Process (readProcessWithExitCode)
+
+-- | Git revision found by running git rev-parse. If git could not be
+-- executed, then this will be an empty string.
+gitRevFromGit :: TH.Q TH.Exp
+gitRevFromGit = TH.LitE . TH.StringL <$> TH.runIO runGitRevParse
+    where
+        runGitRevParse :: IO String
+        runGitRevParse = handleJust missingGit (const $ pure "") $ do
+            (exitCode, output, _) <-
+                readProcessWithExitCode "git" ["rev-parse", "--verify", "HEAD"] ""
+            pure $ case exitCode of
+                ExitSuccess -> output
+                _           -> ""
+
+        missingGit e = if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing
+

locli/src/Cardano/TopHandler.hs

@@ -0,0 +1,106 @@
+module Cardano.TopHandler
+  ( toplevelExceptionHandler
+  ) where
+
+-- The code in this module derives from multiple authors over many years.
+-- It is all under the BSD3 license below.
+--
+-- Copyright (c) 2019 Input Output (Hong Kong) Ltd.
+--               2017 Edward Z. Yang
+--               2015 Edsko de Vries
+--               2009 Duncan Coutts
+--               2007 Galois Inc.
+--               2003 Isaac Jones, Simon Marlow
+--
+-- Copyright (c) 2003-2017, Cabal Development Team.
+-- See the AUTHORS file for the full list of copyright holders.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     * Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     * Redistributions in binary form must reproduce the above
+--       copyright notice, this list of conditions and the following
+--       disclaimer in the documentation and/or other materials provided
+--       with the distribution.
+--
+--     * Neither the name of Isaac Jones nor the names of other
+--       contributors may be used to endorse or promote products derived
+--       from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+import           Prelude
+
+import           Control.Exception
+
+import           System.Environment
+import           System.Exit
+import           System.IO
+
+
+-- | An exception handler to use for a program top level, as an alternative to
+-- the default top level handler provided by GHC.
+--
+-- Use like:
+--
+-- > main :: IO ()
+-- > main = toplevelExceptionHandler $ do
+-- >   ...
+--
+toplevelExceptionHandler :: IO a -> IO a
+toplevelExceptionHandler prog = do
+    -- Use line buffering in case we have to print big error messages, because
+    -- by default stderr to a terminal device is NoBuffering which is slow.
+    hSetBuffering stderr LineBuffering
+    catches prog [
+        Handler rethrowAsyncExceptions
+      , Handler rethrowExitCode
+      , Handler handleSomeException
+      ]
+  where
+    -- Let async exceptions rise to the top for the default GHC top-handler.
+    -- This includes things like CTRL-C.
+    rethrowAsyncExceptions :: SomeAsyncException -> IO a
+    rethrowAsyncExceptions = throwIO
+
+    -- We don't want to print ExitCode, and it should be handled by the default
+    -- top handler because that sets the actual OS process exit code.
+    rethrowExitCode :: ExitCode -> IO a
+    rethrowExitCode = throwIO
+
+    -- Print all other exceptions
+    handleSomeException :: SomeException -> IO a
+    handleSomeException e = do
+      hFlush stdout
+      progname <- getProgName
+      hPutStr stderr (renderSomeException progname e)
+      throwIO (ExitFailure 1)
+
+    -- Print the human-readable output of 'displayException' if it differs
+    -- from the default output (of 'show'), so that the user/sysadmin
+    -- sees something readable in the log.
+    renderSomeException :: String -> SomeException -> String
+    renderSomeException progname e
+      | showOutput /= displayOutput
+      = showOutput ++ "\n\n" ++ progname ++ ": " ++ displayOutput
+
+      | otherwise
+      = "\n" ++ progname ++ ": " ++ showOutput
+      where
+        showOutput    = show e
+        displayOutput = displayException e