Merge pull request #3 from input-output-hk/js/add-other-pkgs

Add `ekg` and `ekg-json`

.github/workflows/haskell.yml

@@ -20,7 +20,7 @@ jobs:
     strategy:
        fail-fast: false
        matrix:
-         ghc: ["8.10.7", "9.2.8", "9.6.3", "9.8.1"]
+         ghc: ["8.4.4", "8.10.7", "9.2.8", "9.6.3", "9.8.1"]
          cabal: ["3.10.2.0"]
          os: [ubuntu-latest]
 

README.md

@@ -1,3 +1,7 @@
-# ekg-core 
+# EKG
 
-Library for tracking system metrics
+This repository contains packages to provide system metrics.
+
+- [`ekg-core`](ekg-core/README.md)
+- [`ekg-json`](ekg-json/README.md)
+- [`ekg`](ekg/README.md)

cabal.project

@@ -1 +1,8 @@
-packages: ./
+index-state:
+  , hackage.haskell.org 2023-11-10T00:00:00Z
+  , cardano-haskell-packages 2023-11-10T00:00:00Z
+
+packages:
+  ekg-core
+  ekg-json
+  ekg

CHANGELOG.md → ekg-core/CHANGELOG.md

@@ -1,4 +1,8 @@
-## 0.1.2.0
+# EKG-core Changelog
+
+# Changelog entries
+
+## 0.1.2.0 (2023-11-13)
 
  * GHC 8.4-9.8 support
    ([#1](https://github.com/input-output-hk/ekg-core/pull/1)).

ekg-core/README.md

@@ -0,0 +1,3 @@
+# ekg-core 
+
+Library for tracking system metrics

ekg-core.cabal → ekg-core/ekg-core.cabal

@@ -1,20 +1,21 @@
-cabal-version:      3.0
-name:               ekg-core
-version:            0.1.2.0
-synopsis:           Tracking of system metrics
-description:        This library lets you define and track system metrics.
-homepage:           https://github.com/tibbe/ekg-core
-bug-reports:        https://github.com/tibbe/ekg-core/issues
-license:            BSD-3-Clause
-license-file:       LICENSE
-author:             Johan Tibell
+cabal-version:   3.0
+name:            ekg-core
+version:         0.1.2.0
+synopsis:        Tracking of system metrics
+description:     This library lets you define and track system metrics.
+homepage:        https://github.com/input-output-hk/ekg
+bug-reports:     https://github.com/input-output-hk/ekg/issues
+license:         BSD-3-Clause
+license-file:    LICENSE
+author:          Johan Tibell
 maintainer:
   Johan Tibell <johan.tibell@gmail.com>,
-  Mikhail Glushenkov <mikhail.glushenkov@gmail.com>
+  Mikhail Glushenkov <mikhail.glushenkov@gmail.com>,
+  operations@iohk.io
 
-category:           System
-build-type:         Simple
-extra-source-files: CHANGELOG.md
+category:        System
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
 tested-with:
   GHC ==8.4.4
    || ==8.6.5
@@ -82,4 +83,5 @@ benchmark distribution
 
 source-repository head
   type:     git
-  location: https://github.com/tibbe/ekg-core.git
+  location: https://github.com/input-output-hk/ekg.git
+  subdir:   ekg-core

ekg-json/CHANGELOG.md

@@ -0,0 +1,23 @@
+# EKG-json Changelog
+
+# Changelog entries
+
+## 0.1.1.0 (2023-11-13)
+
+ * GHC 9.8 support.
+
+## 0.1.0.6 (2017-07-31)
+
+ * GHC 8.2 support.
+
+## 0.1.0.5 (2017-04-19)
+
+ * Support aeson 1.2.
+
+## 0.1.0.3 (2016-09-14)
+
+ * Support aeson 1.0.
+
+## 0.1.0.2 (2016-05-28)
+
+ * GHC 8.0 support.

ekg-json/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2015, Johan Tibell
+
+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 Johan Tibell 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.

ekg-json/README.md

@@ -0,0 +1,3 @@
+# ekg-json 
+
+JSON encoding of ekg metrics

ekg-json/System/Metrics/Json.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Encoding of ekg metrics as JSON. The encoding defined by the
+-- functions in this module are standardized and used by the ekg web
+-- UI. The purpose of this module is to let other web servers and
+-- frameworks than the one used by the ekg package expose ekg metrics.
+module System.Metrics.Json
+    ( -- * Converting metrics to JSON values
+      sampleToJson
+    , valueToJson
+
+      -- ** Newtype wrappers with instances
+    , Sample(..)
+    , Value(..)
+    ) where
+
+import Data.Aeson ((.=))
+import qualified Data.Aeson.Types as A
+import qualified Data.Aeson.Key as A
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.HashMap.Strict as M
+import Data.Int (Int64)
+import qualified Data.Text as T
+import qualified System.Metrics as Metrics
+import qualified System.Metrics.Distribution as Distribution
+
+------------------------------------------------------------------------
+-- * Converting metrics to JSON values
+
+
+-- | Encode metrics as nested JSON objects. Each "." in the metric
+-- name introduces a new level of nesting. For example, the metrics
+-- @[("foo.bar", 10), ("foo.baz", "label")]@ are encoded as
+--
+-- > {
+-- >   "foo": {
+-- >     "bar": {
+-- >       "type:", "c",
+-- >       "val": 10
+-- >     },
+-- >     "baz": {
+-- >       "type": "l",
+-- >       "val": "label"
+-- >     }
+-- >   }
+-- > }
+--
+sampleToJson :: Metrics.Sample -> A.Value
+sampleToJson metrics =
+    buildOne metrics A.emptyObject
+  where
+    buildOne :: M.HashMap T.Text Metrics.Value -> A.Value -> A.Value
+    buildOne m o = M.foldlWithKey' build o m
+
+    build :: A.Value -> T.Text -> Metrics.Value -> A.Value
+    build m name = go m (T.splitOn "." name)
+
+    go :: A.Value -> [T.Text] -> Metrics.Value -> A.Value
+    go (A.Object m) [str] val      = A.Object $ KM.insert (A.fromText str) metric m
+      where metric = valueToJson val
+    go (A.Object m) (str:rest) val = case KM.lookup (A.fromText str) m of
+        Nothing -> A.Object $ KM.insert (A.fromText str) (go A.emptyObject rest val) m
+        Just m' -> A.Object $ KM.insert (A.fromText str) (go m' rest val) m
+    go v _ _                        = typeMismatch "Object" v
+
+typeMismatch :: String   -- ^ The expected type
+             -> A.Value  -- ^ The actual value encountered
+             -> a
+typeMismatch expected actual =
+    error $ "when expecting a " ++ expected ++ ", encountered " ++ name ++
+    " instead"
+  where
+    name = case actual of
+        A.Object _ -> "Object"
+        A.Array _  -> "Array"
+        A.String _ -> "String"
+        A.Number _ -> "Number"
+        A.Bool _   -> "Boolean"
+        A.Null     -> "Null"
+
+-- | Encodes a single metric as a JSON object. Example:
+--
+-- > {
+-- >   "type": "c",
+-- >   "val": 89460
+-- > }
+--
+valueToJson :: Metrics.Value -> A.Value
+valueToJson (Metrics.Counter n)      = scalarToJson n CounterType
+valueToJson (Metrics.Gauge n)        = scalarToJson n GaugeType
+valueToJson (Metrics.Label l)        = scalarToJson l LabelType
+valueToJson (Metrics.Distribution l) = distrubtionToJson l
+
+-- | Convert a scalar metric (i.e. counter, gauge, or label) to a JSON
+-- value.
+scalarToJson :: A.ToJSON a => a -> MetricType -> A.Value
+scalarToJson val ty = A.object
+    ["val" .= val, "type" .= metricType ty]
+{-# SPECIALIZE scalarToJson :: Int64 -> MetricType -> A.Value #-}
+{-# SPECIALIZE scalarToJson :: T.Text -> MetricType -> A.Value #-}
+
+data MetricType =
+      CounterType
+    | GaugeType
+    | LabelType
+    | DistributionType
+
+metricType :: MetricType -> T.Text
+metricType CounterType      = "c"
+metricType GaugeType        = "g"
+metricType LabelType        = "l"
+metricType DistributionType = "d"
+
+-- | Convert a distribution to a JSON value.
+distrubtionToJson :: Distribution.Stats -> A.Value
+distrubtionToJson stats = A.object
+    [ "mean" .= Distribution.mean stats
+    , "variance" .= Distribution.variance stats
+    , "count" .= Distribution.count stats
+    , "sum" .= Distribution.sum stats
+    , "min" .= Distribution.min stats
+    , "max" .= Distribution.max stats
+    , "type" .= metricType DistributionType
+    ]
+
+------------------------------------------------------------------------
+-- ** Newtype wrappers with instances
+
+-- | Newtype wrapper that provides a 'A.ToJSON' instances for the
+-- underlying 'Metrics.Sample' without creating an orphan instance.
+newtype Sample = Sample Metrics.Sample
+    deriving Show
+
+-- | Uses 'sampleToJson'.
+instance A.ToJSON Sample where
+    toJSON (Sample s) = sampleToJson s
+
+-- | Newtype wrapper that provides a 'A.ToJSON' instances for the
+-- underlying 'Metrics.Value' without creating an orphan instance.
+newtype Value = Value Metrics.Value
+    deriving Show
+
+-- | Uses 'valueToJson'.
+instance A.ToJSON Value where
+    toJSON (Value v) = valueToJson v

ekg-json/changelog.d/scriv.ini

@@ -0,0 +1,13 @@
+[scriv]
+format = md
+insert_marker = Changelog entries
+md_header_level = 2
+version = literal: ekg-json.cabal: version
+categories = Patch, Non-Breaking, Breaking
+end_marker = scriv-end-here
+fragment_directory = changelog.d
+ghrel_template = {{body}}
+main_branches = master, main, develop
+new_fragment_template = file: new_fragment.${config:format}.j2
+output_file = CHANGELOG.${config:format}
+skip_fragments = README.*

ekg-json/ekg-json.cabal

@@ -0,0 +1,47 @@
+cabal-version:   3.0
+name:            ekg-json
+version:         0.1.1.0
+license:         BSD-3-Clause
+license-file:    LICENSE
+maintainer:
+  Johan Tibell <johan.tibell@gmail.com>,
+  Mikhail Glushenkov <mikhail.glushenkov@gmail.com>,
+  operations@iohk.io
+
+author:          Johan Tibell
+tested-with:
+  GHC ==8.4.4
+   || ==8.6.5
+   || ==8.8.4
+   || ==8.10.7
+   || ==9.2.8
+   || ==9.4.7
+   || ==9.6.3
+   || ==9.8.1
+
+homepage:        https://github.com/input-output-hk/ekg
+bug-reports:     https://github.com/input-output-hk/ekg/issues
+synopsis:        JSON encoding of ekg metrics
+description:
+  Encodes ekg metrics as JSON, using the same encoding as used by the
+  ekg package, thus allowing ekg metrics to be served by other HTTP
+  servers than the one used by the ekg package.
+
+category:        Distribution
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+source-repository head
+  type:     git
+  location: https://github.com/input-output-hk/ekg.git
+  subdir:   ekg-json
+
+library
+  exposed-modules:  System.Metrics.Json
+  default-language: Haskell2010
+  build-depends:
+    , aeson                 ^>=2.2
+    , base                  >=4.11   && <4.20
+    , ekg-core              ^>=0.1.2
+    , text                  >=1.2.4  && <2.2
+    , unordered-containers  <0.3