Merge pull request #1 from weaveworks/initial-implementation

Initial implementation

.circleci/config.yml

@@ -0,0 +1,19 @@
+version: 2
+jobs:
+  build:
+    docker:
+      # Update stack.yaml when you change this.
+      - image: fpco/stack-build:lts-11.8
+    steps:
+      - checkout
+      - setup_remote_docker
+      - run: apt update && apt install -y docker.io
+      - run: make all
+
+      - deploy:
+          name: Maybe push master images
+          command: |
+            if [ -z "${CIRCLE_TAG}" -a "${CIRCLE_BRANCH}" == "master" ]; then
+              docker login -u "$DOCKER_USER" -p "$DOCKER_PASS" quay.io
+              make publish-image
+            fi

.gitignore

@@ -1,3 +1,5 @@
 .stack-work/
 alertdiff.cabal
-*~
+*~
+.uptodate
+*.swp

Makefile

@@ -0,0 +1,26 @@
+.DEFAULT: all
+.PHONY: all clean build publish-image
+
+DH_ORG=weaveworks
+VERSION=$(shell git symbolic-ref --short HEAD)-$(shell git rev-parse --short HEAD)
+
+all: .uptodate
+
+clean:
+	stack clean
+	rm -f alertdiff-base/.uptodate
+	rm -f .uptodate
+
+build:
+	stack build
+
+publish-image:
+	docker push quay.io/$(DH_ORG)/alertdiff:$(VERSION)
+
+alertdiff-base/.uptodate: alertdiff-base/Dockerfile
+	docker build -t quay.io/weaveworks/alertdiff-base ./alertdiff-base
+	touch $@
+
+.uptodate: build alertdiff-base/.uptodate
+	stack image container
+	touch $@

alertdiff-base/Dockerfile

@@ -0,0 +1,2 @@
+FROM ubuntu:18.04
+RUN apt-get update && apt-get install -y netbase ca-certificates && apt-get clean

app/Main.hs

@@ -1,6 +1,43 @@
 module Main where
 
-import Lib
+import Control.Concurrent.STM       (newTVar)
+import Control.Monad.STM            (atomically)
+import qualified Data.Map.Strict    as Map
+
+import Network.HTTP.Client          (Manager,newManager)
+import Network.HTTP.Client.TLS      (tlsManagerSettings)
+import Network.Wai.Handler.Warp     (run)
+import Options.Applicative          (execParser)
+import Servant.Client               (parseBaseUrl)
+
+import AlertDiff.AlertManager.Model (Alert(..))
+import AlertDiff.Config             (Options(..),optionParser)
+import AlertDiff.Server             (app)
+import AlertDiff                    (State(..),AlertSource(..))
 
 main :: IO ()
-main = someFunc
+main = do
+    options         <- execParser optionParser
+    expectedSource  <- mkSource (expectedURL options) (expectedTokenFile options)
+    actualSource    <- mkSource (actualURL options) (actualTokenFile options)
+    let manager     = newManager tlsManagerSettings
+    let isImportant = mkFilter (ignoreAlerts options)
+
+    run (port options) $ app $ State manager expectedSource actualSource isImportant
+
+    where
+        -- Return a push or pull alert source depending on supplied arguments
+        mkSource :: Maybe String -> Maybe String -> IO AlertSource
+        mkSource Nothing (Just _) = fail "Token specified without URL"
+        mkSource Nothing _ = PushSource <$> (atomically $ newTVar [])
+        mkSource (Just url) token = do
+            url'   <- parseBaseUrl url
+            token' <- traverse readFile token
+            pure $ PullSource url' $ ("Scope-Probe token="++) <$> token'
+
+        -- Return a function that will filter a list of alerts by name
+        mkFilter :: [String] -> Alert -> Bool
+        mkFilter ignored (Alert labels _) =
+            case Map.lookup "alertname" labels of
+                Just name -> name `notElem` ignored
+                Nothing -> True -- Alert has no name label, keep it

package.yaml

@@ -24,9 +24,21 @@ dependencies:
 
 library:
   source-dirs: src
+  dependencies:
+  - aeson
+  - async
+  - bytestring
+  - containers
+  - http-client
+  - optparse-applicative
+  - split
+  - servant-client
+  - servant-server
+  - stm
+  - transformers
 
 executables:
-  alertdiff-exe:
+  alertdiff:
     main:                Main.hs
     source-dirs:         app
     ghc-options:
@@ -35,6 +47,13 @@ executables:
     - -with-rtsopts=-N
     dependencies:
     - alertdiff
+    - containers
+    - http-client
+    - http-client-tls
+    - optparse-applicative
+    - servant-client
+    - stm
+    - warp
 
 tests:
   alertdiff-test:

src/AlertDiff.hs

@@ -0,0 +1,33 @@
+module AlertDiff
+    ( AlertSource(..),
+      State(..)
+    ) where
+
+import Control.Concurrent.STM        (TVar)
+import Network.HTTP.Client           (Manager)
+import Servant.Client                (BaseUrl)
+
+import AlertDiff.AlertManager.Client (AuthToken)
+import AlertDiff.AlertManager.Model  (Alert)
+
+-- | The purpose of AlertDiff is to compare two sets of alerts; one expected
+-- and one actual. These sets of alerts can either be pushed to us by
+-- Prometheus, or we can poll for them from AlertManager. The mode of operation
+-- can be specified on a per-source basis.
+--
+-- In the case of alerts being pushed to us, we use a PushSource to keep a
+-- reference to some mutable state (the latest list of alerts) so that we have
+-- something to compare against when we are asked to perform a comparison.
+--
+-- In the case of us having to pull alerts, we use a PullSource to store the
+-- URL of the AlertManager from which to pull, and an optional token with which
+-- to authenticate.
+data AlertSource = PushSource (TVar [Alert]) | PullSource BaseUrl (Maybe AuthToken)
+
+-- | Environment for our application
+data State =
+    State { manager        :: IO Manager    -- ^ HTTP connection manager for pulling alerts
+          , expectedSource :: AlertSource   -- ^ Pull or push configuration for expected alerts
+          , actualSource   :: AlertSource   -- ^ Push or push configuration for actual alerts
+          , isImportant    :: Alert -> Bool -- ^ Predicate to filter out alerts from comparison
+          }

src/AlertDiff/AlertManager/Client.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+
+module AlertDiff.AlertManager.Client
+    ( AlertResponse(..)
+    , AuthToken
+    , getAlertResponse
+    ) where
+
+import Servant.Client               (ClientM,client)
+import Servant                      ((:>),Proxy(..),Header,Get,JSON)
+
+import AlertDiff.AlertManager.Model (AlertResponse(..))
+
+type AuthToken = String
+
+type AlertManagerClientAPI = "api" :> "v1" :> "alerts" :> Header "Authorization" AuthToken :> Get '[JSON] AlertResponse
+
+api :: Proxy AlertManagerClientAPI
+api = Proxy
+
+-- | Get some alerts with optional authentication
+getAlertResponse :: Maybe AuthToken -> ClientM AlertResponse
+getAlertResponse = client api

src/AlertDiff/AlertManager/Model.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module AlertDiff.AlertManager.Model
+    ( LabelSet,
+      AlertResponse(..),
+      Alert(..),
+    ) where
+
+import qualified Data.Map.Strict as Map
+import Data.Aeson                   (FromJSON(..),Value(Object),(.:))
+import Data.Map.Strict              (Map)
+import GHC.Generics                 (Generic)
+
+type LabelSet = Map String String
+
+data Alert =
+    Alert {labels      :: LabelSet
+          ,annotations :: LabelSet
+          } deriving (Show, Generic, Eq, Ord)
+
+instance FromJSON Alert
+
+data AlertResponse =
+    AlertResponse {status :: String
+                  ,alerts :: [Alert]
+                  } deriving (Show)
+
+-- Can't derive this generically because `data` is reserved
+instance FromJSON AlertResponse
+    where
+        parseJSON (Object v) = AlertResponse <$> v .: "status" <*> v .: "data"

src/AlertDiff/AlertManager/Server.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+
+module AlertDiff.AlertManager.Server
+    ( AlertManagerServerAPI
+    ) where
+
+import Servant ((:>),JSON,NoContent,Post,ReqBody)
+
+import AlertDiff.Model (Alert)
+
+-- | AlertManager API as documented here https://prometheus.io/docs/alerting/clients/
+type AlertManagerServerAPI = "api" :> "v1" :> "alerts" :> ReqBody '[JSON] [Alert] :> Post '[JSON] NoContent

src/AlertDiff/Config.hs

@@ -0,0 +1,35 @@
+module AlertDiff.Config
+    ( Options(..),
+      optionParser
+    ) where
+
+import Data.List.Split     (splitOn)
+import Data.Semigroup      ((<>))
+import Options.Applicative (Parser,ReadM,ParserInfo,long,option,value,info,(<**>),fullDesc,strOption,optional,maybeReader,helper,auto,showDefault)
+
+-- | Runtime configuration
+data Options =
+    Options { port :: Int
+            , expectedURL       :: Maybe String -- ^ AlertManager from which to pull expected alerts
+            , actualURL         :: Maybe String -- ^ AlertManager from which to pull actual alerts
+            , expectedTokenFile :: Maybe String -- ^ Authentication token for pulling expected alerts
+            , actualTokenFile   :: Maybe String -- ^ Authentication token for pulling actual alerts
+            , ignoreAlerts      :: [String]     -- ^ Name of alerts which should be excluded from comparison
+            }
+
+stringList :: ReadM [String]
+stringList = maybeReader f
+    where f s = Just $ splitOn "," s
+
+argParser :: Parser Options
+argParser = Options
+    <$> option auto (long "port" <> value 80 <> showDefault)
+    <*> optional (strOption (long "expected-url"))
+    <*> optional (strOption (long "actual-url"))
+    <*> optional (strOption (long "expected-token-file"))
+    <*> optional (strOption (long "actual-token-file"))
+    <*> option stringList (long "ignore-alerts" <> value [])
+
+-- | Options parser yielding a runtime configuration from command line arguments
+optionParser :: ParserInfo Options
+optionParser = info (argParser <**> helper) fullDesc

src/AlertDiff/Model.hs

@@ -0,0 +1,67 @@
+module AlertDiff.Model
+    ( LabelSet
+    , Alert(..)
+    , Metric(..)
+    , diffAlerts
+    , renderMetrics
+    ) where
+
+import Data.List                    (intercalate)
+import Data.Set                     (Set)
+import qualified Data.Map.Strict    as Map
+import qualified Data.Set           as Set
+
+import AlertDiff.AlertManager.Model (Alert(..),LabelSet)
+
+data Metric = Metric String LabelSet Double deriving (Show, Eq, Ord)
+
+renderMetrics :: [Metric] -> String
+renderMetrics = concatMap renderMetric
+    where
+        -- TODO key & value need escaping
+        renderLabel :: String -> String -> [String]
+        renderLabel key value = [ key ++ "=\"" ++ value ++ "\"" ]
+
+        renderLabels :: LabelSet -> String
+        renderLabels labelSet = intercalate "," $ Map.foldMapWithKey renderLabel labelSet
+
+        renderMetric :: Metric -> String
+        renderMetric (Metric name labels value) =
+            name ++ "{" ++ renderLabels labels ++  "} " ++ show value ++  "\n"
+
+-- Represent an alert (labels + annotations) as a set of labels. For example,
+-- given an alert like this:
+--
+-- {
+--     "labels" : { "status" : "500" }
+--      "annotations" : { "detail" : "Internal server error"}
+-- }
+--
+-- Return a label set like this:
+--
+-- { "label_status" : "500", "annotation_detail" : "Internal server error"}
+--
+-- This enables us to build a metric detailing a missing or spurious alert.
+--
+alertToLabelSet :: Alert -> LabelSet
+alertToLabelSet alert = Map.union labelMap annotationMap
+    where
+        labelMap = Map.mapKeys ("label_" ++) (labels alert)
+        annotationMap = Map.mapKeys ("annotation_" ++) (annotations alert)
+
+-- Make a metric with labels derived from a set of alerts
+alertsToMetrics :: String -> Set Alert -> Set Metric
+alertsToMetrics metricName = Set.map alertToMetric
+    where
+        alertToMetric :: Alert -> Metric
+        alertToMetric alert = Metric metricName (alertToLabelSet alert) 1.0 
+
+-- Compare expected to actual alerts and return the differences
+-- as metrics on which we can base Prometheus alerts.
+diffAlerts :: [Alert] -> [Alert] -> [Metric]
+diffAlerts expected actual = Set.toList $ Set.union missing spurious
+    where
+        es = Set.fromList expected
+        as = Set.fromList actual
+        missing = alertsToMetrics "alertdiff_missing_alert" $ Set.difference es as
+        spurious = alertsToMetrics "alertdiff_spurious_alert" $ Set.difference as es