From 597fbe3937adb80eacab7fbd15dd279adb3ac7c0 Mon Sep 17 00:00:00 2001 From: Adam Harrison Date: Thu, 10 May 2018 17:18:27 +0100 Subject: [PATCH] Initial implementation --- .circleci/config.yml | 19 ++++++ .gitignore | 4 +- Makefile | 26 ++++++++ alertdiff-base/Dockerfile | 2 + app/Main.hs | 41 ++++++++++++- package.yaml | 21 ++++++- src/AlertDiff.hs | 33 ++++++++++ src/AlertDiff/AlertManager/Client.hs | 24 ++++++++ src/AlertDiff/AlertManager/Model.hs | 32 ++++++++++ src/AlertDiff/AlertManager/Server.hs | 13 ++++ src/AlertDiff/Config.hs | 35 +++++++++++ src/AlertDiff/Model.hs | 67 ++++++++++++++++++++ src/AlertDiff/Server.hs | 91 ++++++++++++++++++++++++++++ src/Lib.hs | 6 -- stack.yaml | 11 +++- 15 files changed, 414 insertions(+), 11 deletions(-) create mode 100644 .circleci/config.yml create mode 100644 Makefile create mode 100644 alertdiff-base/Dockerfile create mode 100644 src/AlertDiff.hs create mode 100644 src/AlertDiff/AlertManager/Client.hs create mode 100644 src/AlertDiff/AlertManager/Model.hs create mode 100644 src/AlertDiff/AlertManager/Server.hs create mode 100644 src/AlertDiff/Config.hs create mode 100644 src/AlertDiff/Model.hs create mode 100644 src/AlertDiff/Server.hs delete mode 100644 src/Lib.hs diff --git a/.circleci/config.yml b/.circleci/config.yml new file mode 100644 index 0000000..2b7408c --- /dev/null +++ b/.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 diff --git a/.gitignore b/.gitignore index 2d7bf9b..49170c9 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ .stack-work/ alertdiff.cabal -*~ \ No newline at end of file +*~ +.uptodate +*.swp diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..07ddad2 --- /dev/null +++ b/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 $@ diff --git a/alertdiff-base/Dockerfile b/alertdiff-base/Dockerfile new file mode 100644 index 0000000..332c933 --- /dev/null +++ b/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 diff --git a/app/Main.hs b/app/Main.hs index de1c1ab..5468cf6 100644 --- a/app/Main.hs +++ b/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 diff --git a/package.yaml b/package.yaml index 34ec7a3..a0c881b 100644 --- a/package.yaml +++ b/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: diff --git a/src/AlertDiff.hs b/src/AlertDiff.hs new file mode 100644 index 0000000..653141e --- /dev/null +++ b/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 + } diff --git a/src/AlertDiff/AlertManager/Client.hs b/src/AlertDiff/AlertManager/Client.hs new file mode 100644 index 0000000..33917f3 --- /dev/null +++ b/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 diff --git a/src/AlertDiff/AlertManager/Model.hs b/src/AlertDiff/AlertManager/Model.hs new file mode 100644 index 0000000..d0cb13b --- /dev/null +++ b/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" diff --git a/src/AlertDiff/AlertManager/Server.hs b/src/AlertDiff/AlertManager/Server.hs new file mode 100644 index 0000000..04165bd --- /dev/null +++ b/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 diff --git a/src/AlertDiff/Config.hs b/src/AlertDiff/Config.hs new file mode 100644 index 0000000..1a560d8 --- /dev/null +++ b/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 diff --git a/src/AlertDiff/Model.hs b/src/AlertDiff/Model.hs new file mode 100644 index 0000000..92203c4 --- /dev/null +++ b/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 diff --git a/src/AlertDiff/Server.hs b/src/AlertDiff/Server.hs new file mode 100644 index 0000000..32f5688 --- /dev/null +++ b/src/AlertDiff/Server.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} + +module AlertDiff.Server + ( AlertDiffServerAPI + , AppM + , alertDiffServer + , app + ) where + +import Control.Concurrent.Async (concurrently) +import Control.Concurrent.STM (readTVar, writeTVar) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.STM (atomically) +import Control.Monad.Trans.Reader (ReaderT, ask) +import Control.Monad.Trans.Reader (runReaderT) +import Network.HTTP.Client (Manager) +import qualified Data.ByteString.Lazy.Char8 as BS +import Servant.Client (ServantError,runClientM,showBaseUrl,mkClientEnv,parseBaseUrl) +import Servant ((:<|>)(..),(:>),Get,JSON,PlainText,NoContent(..),MimeRender(..)) +import Servant (Proxy(..),ServerT,Application,Handler,hoistServer,serve) +import Servant (ServantErr,err400,err502,errBody,throwError) + +import AlertDiff.AlertManager.Client (AlertResponse(..),getAlertResponse) +import AlertDiff.AlertManager.Server (AlertManagerServerAPI) +import AlertDiff (AlertSource(..),State(..)) +import AlertDiff.Model (Alert,Metric,diffAlerts,renderMetrics) + +-- | The Alertdiff server API definition +type AlertDiffServerAPI = "expected" :> AlertManagerServerAPI + :<|> "actual" :> AlertManagerServerAPI + :<|> "metrics" :> Get '[PlainText] [Metric] + +-- Use a custom monad that stores our configuration and state +type AppM = ReaderT State Handler + +api :: Proxy AlertDiffServerAPI +api = Proxy + +nt :: State -> AppM a -> Handler a +nt s x = runReaderT x s + +-- Server implementation +alertDiffServer :: ServerT AlertDiffServerAPI AppM +alertDiffServer = postAlerts expectedSource :<|> postAlerts actualSource :<|> getMetrics + where + postAlerts :: (State -> AlertSource) -> [Alert] -> AppM NoContent + postAlerts source alerts = do + state <- ask + case source state of + PushSource t -> liftIO $ do + atomically $ writeTVar t alerts + pure NoContent + PullSource url _ -> throwError err400 { errBody = BS.pack $ "Push disabled (pulling from " ++ showBaseUrl url ++ ")"} + + getMetrics :: AppM [Metric] + getMetrics = do + State{manager, expectedSource, actualSource, isImportant} <- ask + (expected, actual) <- liftIO $ concurrently (getAlerts manager expectedSource) (getAlerts manager actualSource) + let expected' = filter isImportant <$> expected + let actual' = filter isImportant <$> actual + returnDiff expected' actual' + + getAlerts :: IO Manager -> AlertSource -> IO (Either ServantErr [Alert]) + getAlerts _ (PushSource t) = Right <$> (atomically $ readTVar t) + getAlerts manager (PullSource url authHeader) = do + manager' <- manager + liftError <$> runClientM (getAlertResponse authHeader) (mkClientEnv manager' url) + + liftError :: Either ServantError AlertResponse -> Either ServantErr [Alert] + liftError (Right ar@AlertResponse{status = "success"}) = Right $ alerts ar + liftError (Right ar) = Left err502 { errBody = BS.pack $ status ar } + liftError (Left err) = Left err502 { errBody = BS.pack $ show err } + + returnDiff :: Either ServantErr [Alert] -> Either ServantErr [Alert] -> AppM [Metric] + returnDiff (Right expected) (Right actual) = pure $ diffAlerts expected actual + returnDiff (Left expected) (Left actual) = throwError err502 { errBody = BS.pack $ show expected ++ show actual } + returnDiff (Left err) _ = throwError err502 { errBody = BS.pack $ show err } + returnDiff _ (Left err) = throwError err502 { errBody = BS.pack $ show err } + +-- | Teach Servant how to convert a list of metrics into Prometheus exposition +-- format. +instance MimeRender PlainText [Metric] where + mimeRender _ = BS.pack . renderMetrics + +-- Runnable application +app :: State -> Application +app s = serve api $ hoistServer api (nt s) alertDiffServer diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 index d36ff27..0000000 --- a/src/Lib.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Lib - ( someFunc - ) where - -someFunc :: IO () -someFunc = putStrLn "someFunc" diff --git a/stack.yaml b/stack.yaml index 1962baa..eda7092 100644 --- a/stack.yaml +++ b/stack.yaml @@ -18,6 +18,8 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml + +# Update .circleci/config.yaml when you update this resolver: lts-11.8 # User packages to be built. @@ -62,4 +64,11 @@ packages: # extra-lib-dirs: [/path/to/dir] # # Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor \ No newline at end of file +# compiler-check: newer-minor + +image: + container: + base: quay.io/weaveworks/alertdiff-base + name: quay.io/weaveworks/alertdiff + executables: + - alertdiff