alerta (empty) → 0.1.0.0
raw patch · 11 files changed
+1728/−0 lines, 11 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, containers, data-default, http-api-data, http-client, servant, servant-client, servant-server, text, time
Files
- CHANGELOG.md +17/−0
- LICENSE +30/−0
- README.md +3/−0
- Setup.hs +2/−0
- alerta.cabal +50/−0
- src/Alerta.hs +294/−0
- src/Alerta/Auth.hs +50/−0
- src/Alerta/Helpers.hs +70/−0
- src/Alerta/ServantExtras.hs +52/−0
- src/Alerta/Types.hs +1095/−0
- src/Alerta/Util.hs +65/−0
+ CHANGELOG.md view
@@ -0,0 +1,17 @@+# Change log++## 0.1.0.0+ Mark Hopkins <markjohnhopkins@gmail.com> Jun 2017++ - Basics of the alerta API, including+ - alerts+ - alert queries, history, top 10 and flapping+ - environments+ - services+ - blackouts+ - heartbeats+ - API keys+ - users+ - customers++ Not yet covered: OAuth integration.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Mark Hopkins (c) 2017++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 Mark Hopkins 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.
+ README.md view
@@ -0,0 +1,3 @@+# alerta-client++Haskell bindings for the [Alerta](http://alerta.io) REST API.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ alerta.cabal view
@@ -0,0 +1,50 @@+name: alerta+version: 0.1.0.0+synopsis: Bindings to the alerta REST API+homepage: https://github.com/mjhopkins/alerta-client+bug-reports: https://github.com/mjhopkins/alerta-client/issues+license: BSD3+license-file: LICENSE+author: Mark Hopkins+maintainer: markjohnhopkins@gmail.com+copyright: Mark Hopkins+category: Monitoring, API, Web+build-type: Simple+stability: experimental+extra-source-files: README.md CHANGELOG.md+cabal-version: >= 1.10+description:+ <http://alerta.io Alerta> is an alert monitoring tool developed by the+ <https://www.theguardian.com Guardian> newspaper+ .+ This package supplies bindings to the alerta REST API so that it can be used+ from Haskell.+ .+ Built with <http://hackage.haskell.org/package/servant Servant>.++library+ hs-source-dirs: src+ exposed-modules: Alerta+ other-modules: Alerta.Auth+ , Alerta.Helpers+ , Alerta.ServantExtras+ , Alerta.Types+ , Alerta.Util+ build-depends: base >= 4.7 && < 5+ , aeson+ , aeson-pretty+ , containers+ , data-default+ , http-api-data+ , http-client+ , servant+ , servant-client+ , servant-server+ , text+ , time+ ghc-options: -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/mjhopkins/alerta-client
+ src/Alerta.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++--------------------------------------------------------------------------------+-- |+-- Module: Alerta+-- Description: Bindings to the alerta API+--+-- The alerta API allows you to query and modify+--+-- * Alerts+--+-- * Environments+--+-- * Services+--+-- * Blackouts+--+-- * Heartbeats+--+-- * API Keys+--+-- * Users+--+-- * Customers+--------------------------------------------------------------------------------++module Alerta+ (+ -- * Bindings+ -- ** Alerts+ createAlert+ , getAlert+ , deleteAlert+ , setAlertStatus+ , tagAlert+ , untagAlert+ , updateAlertAttributes+ -- ** Alert history and alert queries+ , listAlerts+ , alertHistory+ , countAlerts+ , top10+ , flappingTop10+ -- ** Environments+ , listEnvironments+ -- ** Services+ , listServices+ -- ** Blackouts+ , createBlackout+ , deleteBlackout+ , listBlackouts+ -- ** Heartbeats+ , createHeartbeat+ , getHeartbeat+ , deleteHeartbeat+ , listHeartbeats+ -- ** API keys+ , createApiKey+ , deleteApiKey+ , listApiKeys+ -- ** Users+ , createUser+ , deleteUser+ , updateUser+ , listUsers+ -- ** Customers+ , createCustomer+ , deleteCustomer+ , listCustomers+ -- * Types+ , module Alerta.Types+ -- * Helpers+ , module Alerta.Helpers+ ) where++import Alerta.Auth+import Alerta.Helpers+import Alerta.ServantExtras+import Alerta.Types+import Servant+import Servant.Client++--------------------------------------------------------------------------------+-- query parameter types+--------------------------------------------------------------------------------++type Limited a = QueryParam "limit" Limit :> a++type Page a = QueryParam "page" PageNo :> a++type Sort a =+ QueryParam "reverse" ShouldReverse+ :> QueryParams "sort-by" AlertAttr+ :> a++type Grouped a =+ QueryParam "group-by" AlertAttr+ :> a++type Fields a =+ QueryParam "fields" [AlertAttr] -- NB not QueryParams "field" AlertAttr+ :> QueryParam "fields!" [AlertAttr] -- NB not QueryParams "field!" AlertAttr+ :> a++type Query a =+ QueryParam "q" QueryString -- TODO JSON+ :> QueryParams "id" UUID+ :> QueryFlag "repeat"+ :> FieldQueries+ :> a++--------------------------------------------------------------------------------+-- API types+--------------------------------------------------------------------------------++type AlertApi =+ WithApiKey :> "alert" :> ReqBody '[JSON] Alert :> Post '[JSON] CreateAlertResp+ :<|> WithApiKey :> "alert" :> Capture "id" UUID :> Get '[JSON] AlertResp+ :<|> WithApiKey :> "alert" :> Capture "id" UUID :> Delete '[JSON] Resp+ :<|> WithApiKey :> "alert" :> Capture "id" UUID :> "status" :> ReqBody '[JSON] StatusChange :> Put '[JSON] Resp+ :<|> WithApiKey :> "alert" :> Capture "id" UUID :> "tag" :> ReqBody '[JSON] Tags :> Put '[JSON] Resp+ :<|> WithApiKey :> "alert" :> Capture "id" UUID :> "untag" :> ReqBody '[JSON] Tags :> Put '[JSON] Resp+ :<|> WithApiKey :> "alert" :> Capture "id" UUID :> "attributes" :> ReqBody '[JSON] Attributes :> Put '[JSON] Resp++type AlertsApi =+ WithApiKey :> "alerts" :> Query (Fields (Sort (Page (Limited (Get '[JSON] AlertsResp)))))+ :<|> WithApiKey :> "alerts" :> "history" :> Query (Limited (Get '[JSON] AlertHistoryResp))+ :<|> WithApiKey :> "alerts" :> "count" :> Query (Get '[JSON] AlertCountResp)+ :<|> WithApiKey :> "alerts" :> "top10" :> Query (Grouped (Get '[JSON] Top10Resp))+ :<|> WithApiKey :> "alerts" :> "top10" :> "count" :> Query (Grouped (Get '[JSON] Top10Resp))+ :<|> WithApiKey :> "alerts" :> "top10" :> "flapping" :> Query (Grouped (Get '[JSON] Top10Resp))++-- An environment cannot be created – it is a dynamically derived resource based on existing alerts.+type EnvironmentApi =+ WithApiKey :> "environments" :> Query (Limited (Get '[JSON] EnvironmentsResp))++-- A service cannot be created – it is a dynamically derived resource based on existing alerts.+type ServiceApi =+ WithApiKey :> "services" :> Query (Limited (Get '[JSON] ServicesResp))++type BlackoutApi =+ WithApiKey :> "blackout" :> ReqBody '[JSON] Blackout :> Post '[JSON] BlackoutResp+ :<|> WithApiKey :> "blackout" :> Capture "blackout" UUID :> Delete '[JSON] Resp+ :<|> WithApiKey :> "blackouts" :> Get '[JSON] BlackoutsResp++type HeartbeatApi =+ WithApiKey :> "heartbeat" :> ReqBody '[JSON] Heartbeat :> Post '[JSON] CreateHeartbeatResp+ :<|> WithApiKey :> "heartbeat" :> Capture "id" UUID :> Get '[JSON] HeartbeatResp+ :<|> WithApiKey :> "heartbeat" :> Capture "id" UUID :> Delete '[JSON] Resp+ :<|> WithApiKey :> "heartbeats" :> Get '[JSON] HeartbeatsResp++type ApiKeyApi =+ NeedApiKey :> "key" :> ReqBody '[JSON] CreateApiKey :> Post '[JSON] CreateApiKeyResp+ :<|> WithApiKey :> "key" :> Capture "key" ApiKey :> Delete '[JSON] Resp+ :<|> WithApiKey :> "keys" :> Get '[JSON] ApiKeysResp++type UserApi =+ WithApiKey :> "user" :> ReqBody '[JSON] User :> Post '[JSON] UserResp+ :<|> WithApiKey :> "user" :> Capture "user" UUID :> Delete '[JSON] Resp+ :<|> WithApiKey :> "user" :> Capture "user" UUID :> ReqBody '[JSON] (UserAttr 'Nonempty) :> Put '[JSON] Resp+ :<|> WithApiKey :> "users" :> QueryParam "name" CustomerName :> QueryParam "login" Email :> Get '[JSON] UsersResp++type CustomerApi =+ WithApiKey :> "customer" :> ReqBody '[JSON] Customer :> Post '[JSON] CustomerResp+ :<|> WithApiKey :> "customer" :> Capture "customer" UUID :> Delete '[JSON] Resp+ :<|> WithApiKey :> "customers" :> Get '[JSON] CustomersResp+++--------------------------------------------------------------------------------+-- client methods+--------------------------------------------------------------------------------++createAlert :: Maybe ApiKey -> Alert -> ClientM CreateAlertResp+getAlert :: Maybe ApiKey -> UUID -> ClientM AlertResp+deleteAlert :: Maybe ApiKey -> UUID -> ClientM Resp+setAlertStatus :: Maybe ApiKey -> UUID -> StatusChange -> ClientM Resp+tagAlert :: Maybe ApiKey -> UUID -> Tags -> ClientM Resp+untagAlert :: Maybe ApiKey -> UUID -> Tags -> ClientM Resp+updateAlertAttributes :: Maybe ApiKey -> UUID -> Attributes -> ClientM Resp++createAlert :<|>+ getAlert :<|>+ deleteAlert :<|>+ setAlertStatus :<|>+ tagAlert :<|>+ untagAlert :<|>+ updateAlertAttributes = client (Proxy :: Proxy AlertApi)++listAlerts ::+ Maybe ApiKey+ -> Maybe QueryString+ -- ^ this is a JSON document describing a Mongo query+ -- see http://docs.mongodb.org/manual/reference/operator/query/+ -> [UUID]+ -> IsRepeat+ -> [FieldQuery]+ -> Maybe [AlertAttr] -- ^ alert attributes to show+ -> Maybe [AlertAttr] -- ^ alert attributes to hide+ -> Maybe ShouldReverse+ -> [AlertAttr]+ -> Maybe PageNo+ -> Maybe Limit+ -> ClientM AlertsResp+alertHistory ::+ Maybe ApiKey+ -> Maybe QueryString+ -> [UUID]+ -> IsRepeat+ -> [FieldQuery]+ -> Maybe Limit+ -> ClientM AlertHistoryResp+countAlerts ::+ Maybe ApiKey+ -> Maybe QueryString+ -> [UUID]+ -> IsRepeat+ -> [FieldQuery]+ -> ClientM AlertCountResp+top10 ::+ Maybe ApiKey+ -> Maybe QueryString+ -> [UUID]+ -> IsRepeat+ -> [FieldQuery]+ -> Maybe AlertAttr+ -> ClientM Top10Resp+flappingTop10 ::+ Maybe ApiKey+ -> Maybe QueryString+ -> [UUID]+ -> IsRepeat+ -> [FieldQuery]+ -> Maybe AlertAttr+ -> ClientM Top10Resp++listAlerts :<|>+ alertHistory :<|>+ countAlerts :<|>+ top10 :<|>+ _ :<|>+ flappingTop10 = client (Proxy :: Proxy AlertsApi)++listEnvironments ::+ Maybe ApiKey+ -> Maybe QueryString+ -> [UUID]+ -> IsRepeat+ -> [FieldQuery]+ -> Maybe Limit+ -> ClientM EnvironmentsResp+listEnvironments = client (Proxy :: Proxy EnvironmentApi)++listServices ::+ Maybe ApiKey+ -> Maybe QueryString+ -> [UUID]+ -> IsRepeat+ -> [FieldQuery]+ -> Maybe Limit+ -> ClientM ServicesResp+listServices = client (Proxy :: Proxy ServiceApi)++createBlackout :: Maybe ApiKey -> Blackout -> ClientM BlackoutResp+deleteBlackout :: Maybe ApiKey -> UUID -> ClientM Resp+listBlackouts :: Maybe ApiKey -> ClientM BlackoutsResp++createBlackout :<|> deleteBlackout :<|> listBlackouts = client (Proxy :: Proxy BlackoutApi)++createHeartbeat :: Maybe ApiKey -> Heartbeat -> ClientM CreateHeartbeatResp+getHeartbeat :: Maybe ApiKey -> UUID -> ClientM HeartbeatResp+deleteHeartbeat :: Maybe ApiKey -> UUID -> ClientM Resp+listHeartbeats :: Maybe ApiKey -> ClientM HeartbeatsResp++createHeartbeat :<|> getHeartbeat :<|> deleteHeartbeat :<|> listHeartbeats = client (Proxy :: Proxy HeartbeatApi)++createApiKey :: ApiKey -> CreateApiKey -> ClientM CreateApiKeyResp+deleteApiKey :: Maybe ApiKey -> ApiKey -> ClientM Resp+listApiKeys :: Maybe ApiKey -> ClientM ApiKeysResp++createApiKey :<|> deleteApiKey :<|> listApiKeys = client (Proxy :: Proxy ApiKeyApi)++createUser :: Maybe ApiKey -> User -> ClientM UserResp+deleteUser :: Maybe ApiKey -> UUID -> ClientM Resp+updateUser :: Maybe ApiKey -> UUID -> UserAttr 'Nonempty -> ClientM Resp+listUsers :: Maybe ApiKey -> Maybe CustomerName -> Maybe Email -> ClientM UsersResp++createUser :<|> deleteUser :<|> updateUser :<|> listUsers = client (Proxy :: Proxy UserApi)++createCustomer :: Maybe ApiKey -> Customer -> ClientM CustomerResp+deleteCustomer :: Maybe ApiKey -> UUID -> ClientM Resp+listCustomers :: Maybe ApiKey -> ClientM CustomersResp++createCustomer :<|> deleteCustomer :<|> listCustomers = client (Proxy :: Proxy CustomerApi)
+ src/Alerta/Auth.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++--------------------------------------------------------------------------------+-- |+-- Module: Alerta.Auth+--+-- Auth-related additions to Servant that we use.+--------------------------------------------------------------------------------+module Alerta.Auth+ ( WithApiKey+ , NeedApiKey+ ) where++import Alerta.Types (ApiKey(..))++import Data.Typeable (Typeable)+import Data.Monoid ((<>))+import Data.Proxy+import Servant.Common.Req (Req, addHeader)+import Servant.Client+import Servant.API ((:>))++data NeedApiKey deriving Typeable+data WithApiKey deriving Typeable++-- | Authenticate a request using an API key+addApiKey :: ApiKey -> Req -> Req+addApiKey (ApiKey key) = addHeader "Authorization" ("Key " <> key)++type instance AuthClientData NeedApiKey = ApiKey++instance HasClient api => HasClient (NeedApiKey :> api) where+ type Client (NeedApiKey :> api) = ApiKey -> Client api++ clientWithRoute _ req k =+ clientWithRoute (Proxy :: Proxy api) (addApiKey k req)++type instance AuthClientData WithApiKey = Maybe ApiKey++instance HasClient api => HasClient (WithApiKey :> api) where+ type Client (WithApiKey :> api) = Maybe ApiKey -> Client api++ clientWithRoute _ req m =+ clientWithRoute (Proxy :: Proxy api) (maybe id addApiKey m req)
+ src/Alerta/Helpers.hs view
@@ -0,0 +1,70 @@+--------------------------------------------------------------------------------+-- |+-- Module: Alerta.Helpers+--+-- Utilities for manual testing interaction with the API.+--------------------------------------------------------------------------------+module Alerta.Helpers+ ( run+ , run'+ , prettyPrintEncoding+ , now+ ) where++import Control.Monad (void)++import Data.Aeson+import Data.Aeson.Encode.Pretty+import Data.Bifunctor (bimap)+import qualified Data.Text as T+import Data.Text (Text)+import Data.Time (getCurrentTime, UTCTime)++import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)++import Servant.Client+import System.IO.Unsafe++clientEnv :: Manager -> ClientEnv+clientEnv m = ClientEnv m (BaseUrl Http "localhost" 8080 "")++-- | Run a Servant client function, pretty-printing the JSON returned.+run :: (Show a, FromJSON a, ToJSON a) => ClientM a -> IO a+run cl = do+ manager <- newManager defaultManagerSettings+ res <- runClientM cl (clientEnv manager)+ either handleError (\r -> prettyPrint r >> putStrLn "Success" >> return r) res++-- | Run a Servant client function, pretty-printing the JSON returned, and+-- discarding the return value.+run' :: (Show a, FromJSON a, ToJSON a) => ClientM a -> IO ()+run' = void . run++handleError :: (FromJSON a, ToJSON a) => ServantError -> IO a+handleError (FailureResponse status _ b) = either fail (\r -> putStrLn ("Failure response (status " ++ show status ++ ")") >> prettyPrint r >> return r) (eitherDecode b)+handleError (DecodeFailure e _ b) = fail ("decode failure\n\n" ++ e ++ "\n\n" ++ showUnescaped b)+handleError (UnsupportedContentType ct b) = fail ("unsupported content type\n\n" ++ show ct ++ "\n" ++ show b)+handleError (InvalidContentTypeHeader h b) = fail ("unsupported content type type\n\n" ++ show h ++ "\n" ++ show b)+handleError (ConnectionError e) = fail ("connection error\n\n" ++ show e)++showUnescaped :: Show a => a -> String+showUnescaped = replace [("\\n", "\n"), ("\\\"", "\"")] . show++prettyPrint :: ToJSON a => a -> IO ()+prettyPrint = putStrLn . showUnescaped . encodePretty++replace :: [(String, String)] -> String -> String+replace assocs s = T.unpack $ foldr replace' (T.pack s) assocs'+ where+ assocs' :: [(Text, Text)]+ assocs' = map (bimap T.pack T.pack) assocs+ replace' :: (Text, Text) -> Text -> Text+ replace' (a,b) = T.replace a b++-- | Pretty-print the JSON encoding of the supplied value.+prettyPrintEncoding :: ToJSON a => a -> IO ()+prettyPrintEncoding = putStrLn . showUnescaped . encodePretty++-- | Current time. Not referentially transparent!+now :: () -> UTCTime+now _ = unsafePerformIO getCurrentTime
+ src/Alerta/ServantExtras.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++--------------------------------------------------------------------------------+-- Module: Alerta.ServantExtras+--+-- Additions to Servant needed to cope with the peculiarities of+-- alerta's REST API.+--------------------------------------------------------------------------------+module Alerta.ServantExtras+ ( FieldQueries+ ) where++import Alerta.Types (FieldQuery, MatchType(..))++import Data.List+import Data.Monoid ((<>))+import Data.Proxy+import qualified Data.Text as T++import Servant.Common.Req (Req, appendToQueryString)+import Servant.Client+import Servant.API ((:>))+import Web.HttpApiData++-- | We need this because Alerta for some reason requires `field` and `field!`+-- parameters to be joined together with a comma rather than passed in the+-- usual way.+instance {-# OVERLAPPABLE #-} ToHttpApiData a => ToHttpApiData [a] where+ toQueryParam = T.intercalate "," . map toQueryParam++data FieldQueries++instance HasClient api => HasClient (FieldQueries :> api) where+ type Client (FieldQueries :> api) = [FieldQuery] -> Client api++ clientWithRoute Proxy req fqs =+ clientWithRoute (Proxy :: Proxy api) $ foldl' (flip f) req fqs where++ f :: FieldQuery -> Req -> Req+ f (attr, txt, t, b) = appendToQueryString k (Just v) where+ k = toUrlPiece attr <> suffix+ v = prefix <> txt+ suffix = if b then "" else "!"+ prefix = case t of+ Regex -> "~"+ Literal -> ""
+ src/Alerta/Types.hs view
@@ -0,0 +1,1095 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++--------------------------------------------------------------------------------+-- |+-- Module: Alerta.Types+--+-- Types used by the alerta bindings.+-- This includes request and return parameter types, as well as type synonyms used+-- to help document the bindings.+--+-- A record whose name ends in \"Resp\" indicates a response from the server.+-- A record whose name ends in \"Info\" indicates data contained within+-- responses from the server.+--------------------------------------------------------------------------------+module Alerta.Types+ (+ -- ** General domain terms+ Resource+ , Event+ , Service+ , Environment+ , Group+ , Origin+ , AlertType+ , UserName+ , CustomerName+ , Tag+ , Email+ , Password+ , Provider+ , UUID+ , Href+ -- ** Query and sorting options+ , ShouldReverse+ , Limit+ , PageNo+ , QueryString+ , IsRepeat+ -- ** Field queries+ , FieldQuery+ , MatchType(..)+ , (=.), (!=), (~.), (!~)+ -- ** Generic response+ , Resp(..)+ -- ** Alerts+ , Severity(..)+ , Status(..)+ , TrendIndication(..)+ , Alert(..)+ , mkAlert+ , AlertInfo(..)+ , AlertAttr(..)+ , QueryAttr(..)+ , HistoryItem(..)+ , ExtendedHistoryItem(..)+ , Tags(..)+ , Attributes(..)+ , StatusChange(..)+ , CreateAlertResp(..)+ , AlertResp(..)+ , AlertsResp(..)+ , AlertCountResp(..)+ , ResourceInfo(..)+ , Top10Info(..)+ , Top10Resp(..)+ , AlertHistoryResp(..)+ -- ** Environments+ , EnvironmentInfo(..)+ , EnvironmentsResp(..)+ -- ** Services+ , ServiceInfo(..)+ , ServicesResp(..)+ -- ** Blackouts+ , Blackout(..)+ , blackout+ , BlackoutInfo(..)+ , BlackoutStatus(..)+ , ExtendedBlackoutInfo(..)+ , BlackoutResp(..)+ , BlackoutsResp(..)+ -- ** Heartbeats+ , Heartbeat(..)+ , HeartbeatInfo(..)+ , CreateHeartbeatResp(..)+ , HeartbeatResp(..)+ , HeartbeatsResp(..)+ -- ** API keys+ , ApiKey(..)+ , CreateApiKey(..)+ , ApiKeyType(..)+ , ApiKeyInfo(..)+ , CreateApiKeyResp(..)+ , ApiKeysResp(..)+ -- ** Users+ , User(..)+ , user+ , UserAttr(..)+ , IsEmpty(..)+ , emptyUserAttr+ , checkNonempty+ , withUserName+ , withUserLogin+ , withUserPassword+ , withUserProvider+ , withUserText+ , withUserEmailVerified+ , UserInfo(..)+ , RoleType(..)+ , ExtendedUserInfo(..)+ , UserResp(..)+ , UsersResp(..)+ -- ** Customers+ , Customer(..)+ , CustomerInfo(..)+ , CustomerResp(..)+ , CustomersResp(..)+ ) where++import Alerta.Util++import Control.Applicative (empty)++import Data.Aeson+import qualified Data.Aeson.Encoding as E+import Data.Aeson.Types+import Data.Aeson.TH+import Data.Coerce (coerce)+import Data.Default+import Data.Ix+import Data.Map (Map)+import Data.Monoid ((<>))+import Data.String (IsString(..))+import qualified Data.Text as T+import Data.Text (Text)+import Data.Time (UTCTime)++import GHC.Generics++import Web.HttpApiData++type Resource = Text+type Event = Text+type Service = Text+type Environment = Text+type Group = Text+type Origin = Text+type AlertType = Text+type UserName = Text+type CustomerName = Text+type Tag = Text+type Email = Text -- TODO actual email type+type Password = Text+type Provider = Text -- TODO make into data type+type ShouldReverse = Bool -- ^ whether to reverse the order of a sort+type Limit = Int -- ^ maximum number of results to return (actually a positive int)+type PageNo = Int -- ^ what page of the results to return (actually a positive int)+type UUID = Text -- TODO actual UUID type?+type Href = Text -- TODO use URL type for hrefs+-- | This is a JSON document describing a Mongo query,+-- see http://docs.mongodb.org/manual/reference/operator/query/+type QueryString = Text -- TODO should be JSON or an ADT representing a Mongo query+type IsRepeat = Bool+-- ^ true for duplicate, false if an alert is correlated (in which case alerta appends an item to+-- the history)++--------------------------------------------------------------------------------+-- Field queries+--------------------------------------------------------------------------------++type FieldQuery = (QueryAttr, Text, MatchType, Bool)++-- | Matches can be either literal or regular expressions.+-- n.b. regexes are case-insensitive and are not anchored,+-- i.e. no need to write .*regex.*+data MatchType = Regex | Literal deriving (Eq, Enum, Show, Read, Generic)++-- | Convenient syntax for the four types of field queries+-- viz. literal, negated literal, regex, negated regex.+(=.), (!=), (~.), (!~) :: QueryAttr -> Text -> FieldQuery+k =. v = (k, v, Literal, True)+k != v = (k, v, Literal, False)+k ~. v = (k, v, Regex, True)+k !~ v = (k, v, Regex, False)++-- | These are the valid keys for use in field queries.+-- +-- NB no 'id', 'repeat' or 'duplicateCount' as these have special handling.+data QueryAttr =+ EventQueryAttr+ | EnvironmentQueryAttr+ | SeverityQueryAttr+ | CorrelateQueryAttr+ | StatusQueryAttr+ | ServiceQueryAttr+ | GroupQueryAttr+ | ValueQueryAttr+ | TextQueryAttr+ | TagsQueryAttr+ | AttributesQueryAttr+ | OriginQueryAttr+ | TypeQueryAttr+ | CreateTimeQueryAttr+ | TimeoutQueryAttr+ | RawDataQueryAttr+ | CustomerQueryAttr+ | RepeatQueryAttr+ | PreviousSeverityQueryAttr+ | TrendIndicationQueryAttr+ | ReceiveTimeQueryAttr+ | LastReceiveIdQueryAttr+ | LastReceiveTimeQueryAttr+ | HistoryQueryAttr+ | HrefQueryAttr+ deriving (Eq, Enum, Show, Generic)++instance IsString QueryAttr where+ fromString "event" = EventQueryAttr+ fromString "environment" = EnvironmentQueryAttr+ fromString "severity" = SeverityQueryAttr+ fromString "correlate" = CorrelateQueryAttr+ fromString "status" = StatusQueryAttr+ fromString "service" = ServiceQueryAttr+ fromString "group" = GroupQueryAttr+ fromString "value" = ValueQueryAttr+ fromString "text" = TextQueryAttr+ fromString "tags" = TagsQueryAttr+ fromString "attributes" = AttributesQueryAttr+ fromString "origin" = OriginQueryAttr+ fromString "type" = TypeQueryAttr+ fromString "createTime" = CreateTimeQueryAttr+ fromString "timeout" = TimeoutQueryAttr+ fromString "rawData" = RawDataQueryAttr+ fromString "customer" = CustomerQueryAttr+ fromString "repeat" = RepeatQueryAttr+ fromString "previousSeverity" = PreviousSeverityQueryAttr+ fromString "trendIndication" = TrendIndicationQueryAttr+ fromString "receiveTime" = ReceiveTimeQueryAttr+ fromString "lastReceiveId" = LastReceiveIdQueryAttr+ fromString "lastReceiveTime" = LastReceiveTimeQueryAttr+ fromString "history" = HistoryQueryAttr+ fromString "href" = HrefQueryAttr+ fromString other = error $ "\"" ++ other ++ "\" is not a valid QueryAttr"++instance ToHttpApiData QueryAttr where+ toQueryParam = T.pack . uncapitalise . onCamelComponents (dropRight 2) . show++-- | Alert severity+data Severity =+ Unknown+ | Trace -- ^ 8 (grey)+ | Debug -- ^ 7 (purple)+ | Informational -- ^ 6 (green)+ | Ok -- ^ 5 (green)+ | Normal -- ^ 5 (green)+ | Cleared -- ^ 5 (green)+ | Indeterminate -- ^ 5 (silver)+ | Warning -- ^ 4 (blue)+ | Minor -- ^ 3 (yellow)+ | Major -- ^ 2 (orange)+ | Critical -- ^ 1 (red)+ | Security -- ^ 0 (black)+ deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read, Generic)++instance ToHttpApiData Severity where+ toUrlPiece = T.pack . show++instance ToJSONKey Severity where+ toJSONKey = toJSONKeyText (T.toLower . T.pack . show)++instance FromJSONKey Severity where+ fromJSONKey = FromJSONKeyTextParser $ \case+ "security" -> pure Security+ "critical" -> pure Critical+ "major" -> pure Major+ "minor" -> pure Minor+ "warning" -> pure Warning+ "indeterminate" -> pure Indeterminate+ "cleared" -> pure Cleared+ "normal" -> pure Normal+ "ok" -> pure Ok+ "informational" -> pure Informational+ "debug" -> pure Debug+ "trace" -> pure Trace+ "unknown" -> pure Unknown+ other -> fail $ "Could not parse key \"" ++ T.unpack other ++ "\" as Severity"++-- | Status of an alert.+data Status = -- Status Code+ OpenStatus -- ^ status code 1+ | AssignStatus -- ^ status code 2+ | AckStatus -- ^ status code 3+ | ClosedStatus -- ^ status code 4+ | ExpiredStatus -- ^ status code 5+ | UnknownStatus -- ^ status code 9+ deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read, Generic)++instance ToHttpApiData Status where+ toUrlPiece = showTextLowercase++instance ToJSONKey Status where+ toJSONKey = toJSONKeyText (T.toLower . T.pack . show)++instance FromJSONKey Status where+ fromJSONKey = FromJSONKeyTextParser $ \case+ "open" -> pure OpenStatus+ "assign" -> pure AssignStatus+ "ack" -> pure AckStatus+ "closed" -> pure ClosedStatus+ "expired" -> pure ExpiredStatus+ "unknown" -> pure UnknownStatus+ other -> fail $ "Could not parse key \"" ++ T.unpack other ++ "\" as Status"++data TrendIndication = NoChange | LessSevere | MoreSevere+ deriving (Eq, Ord, Bounded, Enum, Ix, Show, Generic)++instance FromHttpApiData TrendIndication where+ parseQueryParam = parseBoundedTextData++--------------------------------------------------------------------------------+-- Basic response+--------------------------------------------------------------------------------++-- | This type is used for basic responses that have no content beyond whether they succeeded or+-- failed with an error message.+data Resp = OkResp | ErrorResp { respMessage :: Text }+ deriving (Eq, Show, Generic)++--------------------------------------------------------------------------------+-- Alerts+--------------------------------------------------------------------------------++-- | Data required to create (post) an alert.+data Alert = Alert {+ alertResource :: Resource+ , alertEvent :: Event+ , alertEnvironment :: Maybe Environment+ , alertSeverity :: Maybe Severity+ , alertCorrelate :: Maybe [Event]+ , alertStatus :: Maybe Status+ , alertService :: Maybe [Service]+ , alertGroup :: Maybe Group -- ^ defaults to @Misc@+ , alertValue :: Maybe Value -- ^ defaults to @n/a@+ , alertText :: Maybe Text+ , alertTags :: Maybe [Tag]+ , alertAttributes :: Maybe (Map Text Text)+ -- Attribute keys must not contain "." or "$"+ -- note that key "ip" will be overwritten+ , alertOrigin :: Maybe Origin -- ^ defaults to prog\/machine ('%s\/%s' % (os.path.basename(sys.argv[0]), platform.uname()[1]))+ , alertType :: Maybe AlertType -- ^ defaults to @exceptionAlert@+ , alertCreateTime :: Maybe UTCTime -- ^ defaults to @utcnow()@+ , alertTimeout :: Maybe Int -- ^ in seconds; defaults to 86400 (24 hours)+ , alertRawData :: Maybe Text+ , alertCustomer :: Maybe CustomerName+ } deriving (Eq, Show, Generic)++-- | Create an alert with just the mandatory fields.+mkAlert :: Resource -> Event -> Service -> Alert+mkAlert r e s = Alert {+ alertResource = r+ , alertEvent = e+ -- supposed to be optional, but RejectPolicy plugin requires it to be one of ALLOWED_ENVIRONMENTS+ , alertEnvironment = Just "Development"+ , alertSeverity = Nothing+ , alertCorrelate = Nothing+ , alertStatus = Nothing+ -- supposed to be optional, but RejectPolicy requires it to be set+ , alertService = Just [s]+ , alertGroup = Nothing+ , alertValue = Nothing+ , alertText = Nothing+ , alertTags = Nothing+ , alertAttributes = Nothing+ , alertOrigin = Nothing+ , alertType = Nothing+ , alertCreateTime = Nothing+ , alertTimeout = Nothing+ , alertRawData = Nothing+ , alertCustomer = Nothing+ }++-- | Data returned from the server about an alert+data AlertInfo = AlertInfo {+ alertInfoId :: UUID+ , alertInfoResource :: Resource+ , alertInfoEvent :: Event+ , alertInfoEnvironment :: Environment -- ^ defaults to empty string+ , alertInfoSeverity :: Maybe Severity+ , alertInfoCorrelate :: [Event]+ , alertInfoStatus :: Maybe Status+ , alertInfoService :: [Service]+ , alertInfoGroup :: Group -- ^ defaults to @misc@+ , alertInfoValue :: Value -- ^ defaults to @n/a@+ , alertInfoText :: Text -- ^ defaults to empty string+ , alertInfoTags :: [Tag]+ , alertInfoAttributes :: Map Text Text -- ^ Attribute keys must not contain "." or "$"+ , alertInfoOrigin :: Origin -- ^ defaults to prog\/machine+ , alertInfoType :: AlertType -- ^ defaults to @exceptionAlert@+ , alertInfoCreateTime :: UTCTime+ , alertInfoTimeout :: Int+ , alertInfoRawData :: Maybe Text+ , alertInfoCustomer :: Maybe CustomerName+ , alertInfoDuplicateCount :: Maybe Int+ , alertInfoRepeat :: Maybe Bool+ , alertInfoPreviousSeverity :: Maybe Severity+ , alertInfoTrendIndication :: Maybe TrendIndication+ , alertInfoReceiveTime :: UTCTime+ , alertInfoLastReceiveId :: Maybe UUID+ , alertInfoLastReceiveTime :: UTCTime+ , alertInfoHistory :: [HistoryItem]+ , alertInfoHref :: Href+ } deriving (Eq, Show, Generic)++-- | Alert attributes, used for sorting, grouping and for field-based queries+data AlertAttr =+ IdAlertAttr+ | ResourceAlertAttr+ | EventAlertAttr+ | EnvironmentAlertAttr+ | SeverityAlertAttr+ | CorrelateAlertAttr+ | StatusAlertAttr+ | ServiceAlertAttr+ | GroupAlertAttr+ | ValueAlertAttr+ | TextAlertAttr+ | TagsAlertAttr+ | AttributesAlertAttr+ | OriginAlertAttr+ | TypeAlertAttr+ | CreateTimeAlertAttr+ | TimeoutAlertAttr+ | RawDataAlertAttr+ | CustomerAlertAttr+ | DuplicateCountAlertAttr+ | RepeatAlertAttr+ | PreviousSeverityAlertAttr+ | TrendIndicationAlertAttr+ | ReceiveTimeAlertAttr+ | LastReceiveIdAlertAttr+ | LastReceiveTimeAlertAttr+ | HistoryAlertAttr+ | HrefAlertAttr+ deriving (Eq, Enum, Show, Generic)++instance IsString AlertAttr where+ fromString "id" = IdAlertAttr+ fromString "resource" = ResourceAlertAttr+ fromString "event" = EventAlertAttr+ fromString "environment" = EnvironmentAlertAttr+ fromString "severity" = SeverityAlertAttr+ fromString "correlate" = CorrelateAlertAttr+ fromString "status" = StatusAlertAttr+ fromString "service" = ServiceAlertAttr+ fromString "group" = GroupAlertAttr+ fromString "value" = ValueAlertAttr+ fromString "text" = TextAlertAttr+ fromString "tags" = TagsAlertAttr+ fromString "attributes" = AttributesAlertAttr+ fromString "origin" = OriginAlertAttr+ fromString "type" = TypeAlertAttr+ fromString "createTime" = CreateTimeAlertAttr+ fromString "timeout" = TimeoutAlertAttr+ fromString "rawData" = RawDataAlertAttr+ fromString "customer" = CustomerAlertAttr+ fromString "duplicateCount" = DuplicateCountAlertAttr+ fromString "repeat" = RepeatAlertAttr+ fromString "previousSeverity" = PreviousSeverityAlertAttr+ fromString "trendIndication" = TrendIndicationAlertAttr+ fromString "receiveTime" = ReceiveTimeAlertAttr+ fromString "lastReceiveId" = LastReceiveIdAlertAttr+ fromString "lastReceiveTime" = LastReceiveTimeAlertAttr+ fromString "history" = HistoryAlertAttr+ fromString "href" = HrefAlertAttr+ fromString other = error $ "\"" ++ other ++ "\" is not a valid AlertAttr"++instance ToHttpApiData AlertAttr where+ toQueryParam = T.pack . uncapitalise . onCamelComponents (dropRight 2) . show++data HistoryItem = StatusHistoryItem {+ historyItemEvent :: Event+ , historyItemStatus :: Status+ , historyItemText :: Text+ , historyItemId :: UUID+ , historyItemUpdateTime :: UTCTime+ } | SeverityHistoryItem {+ historyItemEvent :: Event+ , historyItemSeverity :: Severity+ , historyItemText :: Text+ , historyItemId :: UUID+ , historyItemUpdateTime :: UTCTime+ , historyItemValue :: Value+ } deriving (Eq, Show, Generic)++-- | When performing an alert history query an enriched version of the alert history is returned with extra fields.+data ExtendedHistoryItem = StatusExtendedHistoryItem {+ statusExtendedHistoryItemId :: UUID+ , statusExtendedHistoryItemResource :: Resource+ , statusExtendedHistoryItemEvent :: Event+ , statusExtendedHistoryItemEnvironment :: Environment+ , statusExtendedHistoryItemStatus :: Status+ , statusExtendedHistoryItemService :: [Service] -- ^ why this is an array I do not know+ , statusExtendedHistoryItemGroup :: Group+ , statusExtendedHistoryItemText :: Text+ , statusExtendedHistoryItemTags :: [Tag]+ , statusExtendedHistoryItemAttributes :: Map Text Text+ , statusExtendedHistoryItemOrigin :: Origin+ , statusExtendedHistoryItemUpdateTime :: UTCTime+ , statusExtendedHistoryItemCustomer :: Maybe CustomerName+ } | SeverityExtendedHistoryItem {+ severityExtendedHistoryItemId :: UUID+ , severityExtendedHistoryItemResource :: Resource+ , severityExtendedHistoryItemEvent :: Event+ , severityExtendedHistoryItemEnvironment :: Environment+ , severityExtendedHistoryItemSeverity :: Severity+ , severityExtendedHistoryItemService :: [Service] -- ^ why this is an array I do not know+ , severityExtendedHistoryItemGroup :: Group+ , severityExtendedHistoryItemValue :: Value+ , severityExtendedHistoryItemText :: Text+ , severityExtendedHistoryItemTags :: [Tag]+ , severityExtendedHistoryItemAttributes :: Map Text Text+ , severityExtendedHistoryItemOrigin :: Origin+ , severityExtendedHistoryItemUpdateTime :: UTCTime+ , severityExtendedHistoryItemCustomer :: Maybe CustomerName+ } deriving (Eq, Show, Generic)++newtype Tags = Tags { tags :: [Tag] } deriving (Eq, Show, Generic)++-- | Attributes are key-value pairs that can be attached to an alert.+newtype Attributes = Attributes { attributes :: Map Text Text } deriving (Eq, Show, Generic)++data StatusChange = StatusChange {+ statusChangeStatus :: Status -- docs say not "unknown" but the api allows it+ -- (in fact any text is accepted - but our parsing code need to be able+ -- to read it back from the alert history)+ , statusChangeText :: Maybe Text+ } deriving (Eq, Show, Generic)++data CreateAlertResp = OkCreateAlertResp {+ okCreateAlertRespId :: UUID+ , okCreateAlertRespAlert :: Maybe AlertInfo -- ^ not present if rate limited or in blackout+ , okCreateAlertRespMessage :: Maybe Text -- ^ present when rate limited or in blackout+ } | ErrorCreateAlertResp {+ errorCreateAlertRespMessage :: Text+ } deriving (Eq, Show, Generic)++data AlertResp = OkAlertResp {+ okAlertRespAlert :: AlertInfo+ , okAlertRespTotal :: Int+ } | ErrorAlertResp {+ errorAlertRespMessage :: Text+ } deriving (Eq, Show, Generic)++data AlertsResp = OkAlertsResp {+ okAlertsRespAlerts :: [AlertInfo]+ , okAlertsRespTotal :: Int+ , okAlertsRespPage :: PageNo+ , okAlertsRespPageSize :: Int+ , okAlertsRespPages :: Int+ , okAlertsRespMore :: Bool+ , okAlertsRespSeverityCounts :: Maybe (Map Severity Int)+ , okAlertsRespStatusCounts :: Maybe (Map Status Int)+ , okAlertsRespLastTime :: UTCTime+ , okAlertsRespAutoRefresh :: Bool+ , okAlertsRespMessage :: Maybe Text+ } | ErrorAlertsResp {+ errorAlertsRespMessage :: Text+ } deriving (Eq, Show, Generic)++data AlertCountResp = OkAlertCountResp {+ okAlertCountRespTotal :: Int+ , okAlertCountRespSeverityCounts :: Int+ , okAlertCountRespStatusCounts :: Int+ , okAlertCountRespMessage :: Maybe Text+ } | ErrorAlertCountResp {+ errorAlertCountRespMessage :: Text+ } deriving (Eq, Show, Generic)++data ResourceInfo = ResourceInfo {+ resourceInfoId :: UUID+ , resourceInfoResource :: Resource+ , resourceInfoHref :: Href+ } deriving (Eq, Show, Generic)++-- | This also has a field corresponding to the "group-by" query parameter used+-- i.e. if you group by origin, then the result will have an "origin" field.+--+-- This dependently-typed feature is not currently captured in the Haskell types.+data Top10Info = Top10Info {+ top10InfoCount :: Int+ , top10InfoDuplicateCount :: Int+ , top10InfoEnvironments :: [Environment]+ , top10InfoServices :: [Service]+ , top10InfoResources :: [ResourceInfo]+ } deriving (Eq, Show, Generic)++data Top10Resp = OkTop10Resp {+ okTop10RespTop10 :: [Top10Info]+ , okTop10RespTotal :: Int+ , okTop10RespMessage :: Maybe Text+ } | ErrorTop10Resp {+ errorTop10RespMessage :: Text+ } deriving (Eq, Show, Generic)++data AlertHistoryResp = OkAlertHistoryResp {+ okAlertHistoryRespHistory :: [ExtendedHistoryItem]+ , okAlertHistoryRespLastTime :: UTCTime+ , okAlertHistoryRespMessage :: Maybe Text+ } | ErrorAlertHistoryResp {+ errorAlertHistoryResp :: Text+ } deriving (Eq, Show, Generic)++--------------------------------------------------------------------------------+-- Environments+--------------------------------------------------------------------------------++data EnvironmentInfo = EnvironmentInfo {+ environmentInfoCount :: Int+ , environmentInfoEnvironment :: Environment+ } deriving (Eq, Show, Generic)++data EnvironmentsResp = OkEnvironmentsResp {+ okEnvironmentsRespMessage :: Maybe Text+ , okEnvironmentsRespTotal :: Int+ , okEnvironmentsRespEnvironments :: [EnvironmentInfo]+ } | ErrorEnvironmentsResp {+ errorEnvironmentsRespMessage :: Text+ } deriving (Eq, Show, Generic)++--------------------------------------------------------------------------------+-- Services+--------------------------------------------------------------------------------++data ServiceInfo = ServiceInfo {+ serviceInfoCount :: Int+ , serviceInfoEnvironment :: Environment+ , serviceInfoService :: Service+ } deriving (Eq, Show, Generic)++data ServicesResp = OkServicesResp {+ okServicesRespTotal :: Int+ , okServicesRespServices :: [ServiceInfo]+ , okServicesRespMessage :: Maybe Text+ } | ErrorServicesResp {+ errorServicesRespMessage :: Text+ } deriving (Eq, Show, Generic)++--------------------------------------------------------------------------------+-- Blackouts+--------------------------------------------------------------------------------++data Blackout = Blackout {+ blackoutEnvironment :: Environment+ , blackoutResource :: Maybe Resource+ , blackoutService :: Maybe Service+ , blackoutEvent :: Maybe Event+ , blackoutGroup :: Maybe Group+ , blackoutTags :: Maybe [Tag]+ , blackoutStartTime :: Maybe UTCTime -- ^ defaults to now+ , blackoutEndTime :: Maybe UTCTime -- ^ defaults to start + duration+ , blackoutDuration :: Maybe Int -- ^ in seconds; can be calculated from start and end, or else defaults to BLACKOUT_DURATION+ } deriving (Eq, Show, Generic)++-- | Create a blackout with only the mandatory fields+blackout :: Environment -> Blackout+blackout env = Blackout env Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++-- | A note on blackout priorities:+--+-- Priority is+--+-- 1. by default+--+-- 2. if resource and not event present+--+-- 3. if service present+--+-- 4. if event and not resource+--+-- 5. if group present+--+-- 6. if resource and event present+-- +-- 7. if tags present+--+-- Somewhat bizarrely, the saved blackout only includes an attribute+--+-- {resource,service,event,group,tags}+--+-- if it was used to deduce the priority,+-- i.e. a priority 6 blackout will have resource and event attributes,+-- but no tags attribute, even if it was supplied when it was created.+data BlackoutInfo = BlackoutInfo {+ blackoutInfoId :: UUID+ , blackoutInfoPriority :: Int+ , blackoutInfoEnvironment :: Environment+ , blackoutInfoResource :: Maybe Resource+ , blackoutInfoService :: Maybe [Service]+ , blackoutInfoEvent :: Maybe Event+ , blackoutInfoGroup :: Maybe Group+ , blackoutInfoTags :: Maybe [Tag]+ , blackoutInfoCustomer :: Maybe CustomerName+ , blackoutInfoStartTime :: UTCTime -- ^ defaults to now+ , blackoutInfoEndTime :: UTCTime -- ^ defaults to start + duration+ , blackoutInfoDuration :: Int -- ^ can be calculated from start and end, or else defaults to BLACKOUT_DURATION+ } deriving (Eq, Show, Generic)++data BlackoutStatus = Expired | Pending | Active deriving (Eq, Ord, Bounded, Enum, Ix, Show, Generic)++data ExtendedBlackoutInfo = ExtendedBlackoutInfo {+ extendedBlackoutInfoId :: UUID+ , extendedBlackoutInfoPriority :: Int -- see comment above+ , extendedBlackoutInfoEnvironment :: Environment+ , extendedBlackoutInfoResource :: Maybe Resource+ , extendedBlackoutInfoService :: Maybe [Service]+ , extendedBlackoutInfoEvent :: Maybe Event+ , extendedBlackoutInfoGroup :: Maybe Group+ , extendedBlackoutInfoTags :: Maybe [Tag]+ , extendedBlackoutInfoCustomer :: Maybe CustomerName+ , extendedBlackoutInfoStartTime :: UTCTime -- defaults to now+ , extendedBlackoutInfoEndTime :: UTCTime -- defaults to start + duration+ , extendedBlackoutInfoDuration :: Int -- can be calculated from start and end, or else defaults to BLACKOUT_DURATION+ , extendedBlackoutInfoRemaining :: Int+ , extendedBlackoutInfoStatus :: BlackoutStatus+ } deriving (Eq, Show, Generic)++data BlackoutResp = OkBlackoutResp {+ okBlackoutRespId :: UUID+ , okBlackoutRespBlackout :: BlackoutInfo+ } | ErrorBlackoutResp {+ errorBlackoutRespMessage :: Text+ } deriving (Eq, Show, Generic)++data BlackoutsResp = OkBlackoutsResp {+ okBlackoutsRespTotal :: Int+ , okBlackoutsRespBlackouts :: [ExtendedBlackoutInfo]+ , okBlackoutsRespMessage :: Maybe Text+ , okBlackoutsRespTime :: UTCTime+ } | ErrorBlackoutsResp {+ errorBlackoutsRespMessage :: Text+ } deriving (Eq, Show, Generic)+++--------------------------------------------------------------------------------+-- Heartbeats+--------------------------------------------------------------------------------++-- | Data needed to create a heartbeat+data Heartbeat = Heartbeat {+ heartbeatOrigin :: Maybe Origin -- defaults to prog/nodename+ , heartbeatTags :: [Tag]+ , heartbeatCreateTime :: Maybe UTCTime+ , heartbeatTimeout :: Maybe Int -- seconds+ , heartbeatCustomer :: Maybe CustomerName -- if not admin, gets overwritten+ } deriving (Eq, Show, Generic, Default)++-- | Information returned from the server about a heartbeat+data HeartbeatInfo = HeartbeatInfo {+ heartbeatInfoCreateTime :: UTCTime+ , heartbeatInfoCustomer :: Maybe CustomerName+ , heartbeatInfoHref :: Href+ , heartbeatInfoId :: UUID+ , heartbeatInfoOrigin :: Origin+ , heartbeatInfoReceiveTime :: UTCTime+ , heartbeatInfoTags :: [Tag]+ , heartbeatInfoTimeout :: Int+ , heartbeatInfoType :: Text+ } deriving (Eq, Show, Generic)++data CreateHeartbeatResp = OkCreateHeartbeatResp {+ createHeartbeatRespId :: UUID+ , createHeartbeatRespHeartbeat :: HeartbeatInfo+ } | ErrorCreateHeartbeatResp {+ createHeartbeatRespMessage :: Text+ } deriving (Eq, Show, Generic)++data HeartbeatResp = OkHeartbeatResp {+ heartbeatRespHeartbeat :: HeartbeatInfo+ , heartbeatRespTotal :: Int+ } | ErrorHeartbeatResp {+ heartbeatRespMessage :: Text+ } deriving (Eq, Show, Generic)++data HeartbeatsResp = OkHeartbeatsResp {+ heartbeatsRespHeartbeats :: [HeartbeatInfo]+ , heartbeatsRespTime :: Maybe UTCTime+ , heartbeatsRespTotal :: Int+ , heartbeatsRespMessage :: Maybe Text+ } | ErrorHeartbeatsResp {+ heartbeatsRespErrorMessage :: Text+ } deriving (Eq, Show, Generic)+++--------------------------------------------------------------------------------+-- API keys+--------------------------------------------------------------------------------++-- when using admin credentials, user must be present, or associated with account++-- | 40-char UTF8++-- TODO smart constructor+data ApiKey = ApiKey { unApiKey :: !Text }+ deriving (Eq, Show, Generic)++instance IsString ApiKey where+ fromString = ApiKey . T.pack++instance FromJSON ApiKey where+ parseJSON = withText "API key" (pure . ApiKey)++instance ToJSON ApiKey where+ toJSON (ApiKey k) = String k+ {-# INLINE toJSON #-}++ toEncoding (ApiKey k) = E.text k+ {-# INLINE toEncoding #-}++instance ToHttpApiData ApiKey where+ toUrlPiece (ApiKey k) = k++-- | Data needed to create an API key+data CreateApiKey = CreateApiKey {+ createApiKeyUser :: Maybe Email -- ^ only read if authorised as admin, defaults to current user+ , createApiKeyCustomer :: Maybe CustomerName -- ^ only read if authorised as admin, defaults to current customer+ , createApiKeyType :: Maybe ApiKeyType -- ^ defaults to read-only+ , createApiKeyText :: Maybe Text -- ^ defaults to "API Key for $user"+ } deriving (Eq, Show, Generic, Default)++data ApiKeyType = ReadOnly | ReadWrite deriving (Eq, Ord, Bounded, Enum, Ix, Generic)++instance Show ApiKeyType where+ show ReadWrite = "read-write"+ show ReadOnly = "read-only"++instance ToJSON ApiKeyType where+ toJSON = genericToJSON $ defaultOptions { constructorTagModifier = camelTo2 '-'}++instance FromJSON ApiKeyType where+ parseJSON = genericParseJSON $ defaultOptions { constructorTagModifier = camelTo2 '-'}++-- | Information returned from the server about an API key+data ApiKeyInfo = ApiKeyInfo {+ apiKeyInfoUser :: Email+ , apiKeyInfoKey :: ApiKey+ , apiKeyInfoType :: ApiKeyType+ , apiKeyInfoText :: Text+ , apiKeyInfoExpireTime :: UTCTime+ , apiKeyInfoCount :: Int -- number of times used+ , apiKeyInfoLastUsedTime :: Maybe UTCTime+ , apiKeyInfoCustomer :: Maybe CustomerName+ } deriving (Eq, Show, Generic)++data CreateApiKeyResp = OkCreateApiKeyResp {+ okCreateApiKeyRespKey :: ApiKey + , okCreateApiKeyRespData :: ApiKeyInfo+ } | ErrorCreateApiKeyResp {+ errorCreateApiKeyRespMessage :: Text+ } deriving (Eq, Show, Generic)++data ApiKeysResp = OkApiKeysResp {+ okApiKeysRespKeys :: [ApiKeyInfo]+ , okApiKeysRespTotal :: Int+ , okApiKeysRespTime :: UTCTime+ , okApiKeysRespMessage :: Maybe Text+ } | ErrorApiKeysResp {+ errorApiKeysRespMessage :: Text+ } deriving (Eq, Show, Generic)++--------------------------------------------------------------------------------+-- Users+--------------------------------------------------------------------------------++-- alerta doesn't require login, password but returns a 500 if they are missing+-- yay, cowboy coding++-- Data needed to create a user+data User = User {+ userName :: UserName+ , userLogin :: Email+ , userPassword :: Password+ , userProvider :: Maybe Provider+ , userText :: Maybe Text+ , userEmailVerified :: Maybe Bool+ } deriving (Show, Generic)++-- | Create a user with just the mandatory fields.+user :: UserName -> Email -> Password -> User+user name login password = User name login password Nothing Nothing Nothing++data IsEmpty = Empty | Nonempty | UnknownIfEmpty++-- | User attributes, used in updating a user.+-- It's an error to update a user with all attributes missing.+--+-- We track whether at least one attribute has been set with a phantom type.+--+-- Alerta bugs:+--+-- * can't update password without also passing provider=basic+-- as alerta checks the update message, not the user.+--+-- * can't set email_verified to false without providing another parameter.+--+-- The helper functions "withUserName" etc. can be used in conjunction with+-- the default empty "UserAttr" to build up a nonempty "UserAttr".++data UserAttr (u :: IsEmpty) = UserAttr {+ userAttrName :: Maybe UserName+ , userAttrLogin :: Maybe Email+ , userAttrPassword :: Maybe Password+ , userAttrProvider :: Maybe Provider+ , userAttrText :: Maybe Text+ , userAttrEmail_verified :: Maybe Bool+ } deriving (Eq, Show, Generic)++emptyUserAttr :: UserAttr 'Empty+emptyUserAttr = UserAttr Nothing Nothing Nothing Nothing Nothing Nothing++checkNonempty :: UserAttr u -> Either (UserAttr 'Empty) (UserAttr 'Nonempty)+checkNonempty a@(UserAttr Nothing Nothing Nothing Nothing Nothing Nothing) = Left $ coerce a+checkNonempty a = Right $ coerce a++instance Default (UserAttr 'Empty) where+ def = emptyUserAttr++-- TODO omitNothingFields doesn't work+instance ToJSON (UserAttr 'Nonempty) where+ toJSON = genericToJSON $ defaultOptions { omitNothingFields = True }++ toEncoding (UserAttr n l pw pr t ev) =+ pairs $+ "name" .= n <>+ "login" .= l <>+ "password" .= pw <>+ "provider" .= pr <>+ "text" .= t <>+ "email_verified" .= ev++instance FromJSON (UserAttr 'UnknownIfEmpty) where+ parseJSON (Object v) =+ UserAttr <$>+ v .:? "name" <*>+ v .:? "login" <*>+ v .:? "password" <*>+ v .:? "provider" <*>+ v .:? "text" <*>+ v .:? "email_verified"+ parseJSON _ = empty++-- TODO replace with lenses+withUserName :: UserAttr u -> UserName -> UserAttr 'Nonempty+withUserLogin :: UserAttr u -> Email -> UserAttr 'Nonempty+withUserPassword :: UserAttr u -> Password -> UserAttr 'Nonempty+withUserProvider :: UserAttr u -> Provider -> UserAttr 'Nonempty+withUserText :: UserAttr u -> Text -> UserAttr 'Nonempty+withUserEmailVerified :: UserAttr u -> Bool -> UserAttr u+withUserName u s = u { userAttrName = Just s }+withUserLogin u s = u { userAttrLogin = Just s }+-- sets the provider to basic to work around the bug mentioned above+withUserPassword u s = u { userAttrPassword = Just s, userAttrProvider = Just "basic" }+withUserProvider u s = u { userAttrProvider = Just s }+withUserText u s = u { userAttrText = Just s }+withUserEmailVerified u b = u { userAttrEmail_verified = Just b }++data UserInfo = UserInfo {+ userInfoCreateTime :: UTCTime+ , userInfoId :: UUID+ , userInfoName :: UserName+ , userInfoProvider :: Provider+ , userInfoLogin :: Email+ , userInfoText :: Text+ , userInfoEmail_verified :: Bool+ } deriving (Show, Generic)++data RoleType = UserRoleType | AdminRoleType+ deriving (Eq, Ord, Bounded, Enum, Ix, Show, Generic)++data ExtendedUserInfo = ExtendedUserInfo {+ extendedUserInfoCreateTime :: UTCTime+ , extendedUserInfoId :: UUID+ , extendedUserInfoName :: UserName+ , extendedUserInfoLogin :: Email+ , extendedUserInfoProvider :: Provider+ , extendedUserInfoRole :: RoleType+ , extendedUserInfoText :: Text+ , extendedUserInfoEmail_verified :: Bool+ } deriving (Show, Generic)++data UserResp = OkUserResp {+ okUserRespId :: UUID+ , okUserRespUser :: UserInfo+ } | ErrorUserResp {+ errorUserRespMessage :: Text+ } deriving (Show, Generic)++data UsersResp = OkUsersResp {+ okUsersRespUsers :: [ExtendedUserInfo]+ , okUsersRespTotal :: Int+ , okUsersRespDomains :: [Text] -- allowed email domains+ , okUsersRespGroups :: [Text] -- allowed Gitlab groups+ , okUsersRespOrgs :: [Text] -- allowed Github orgs+ , okUsersRespRoles :: Maybe [Text] -- allowed Keycloud roles+ , okUsersRespTime :: UTCTime+ , okUsersRespMessage :: Maybe Text+ } | ErrorUsersResp {+ errorUsersResp :: Text+ } deriving (Show, Generic)++--------------------------------------------------------------------------------+-- Customers+--------------------------------------------------------------------------------++data Customer = Customer {+ customerCustomer :: CustomerName+ , customerMatch :: Text -- regex, apparently+ } deriving (Show, Generic)++data CustomerInfo = CustomerInfo {+ customerInfoId :: UUID+ , customerInfoCustomer :: CustomerName+ , customerInfoMatch :: Text -- regex, apparently+ } deriving (Show, Generic)++data CustomerResp = OkCustomerResp {+ okCustomerRespId :: UUID+ , okCustomerRespCustomer :: CustomerInfo+ } | ErrorCustomerResp {+ errorCustomerRespMessage :: Text+ } deriving (Show, Generic)++data CustomersResp = OkCustomersResp {+ okCustomersRespCustomers :: [CustomerInfo]+ , okCustomersRespTotal :: Int+ , okCustomersRespMessage :: Maybe Text+ , okCustomersRespTime :: UTCTime+ } | ErrorCustomersResp {+ errorCustomersMessage :: Text+ } deriving (Show, Generic)++$( deriveJSON (toOpts 0 0 def) ''Severity )+$( deriveJSON (toOpts 1 1 def) ''Status )+$( deriveJSON (toOpts 1 1 def) ''Alert )+$( deriveJSON (toOpts 0 0 def { unwrap = False }) ''Tags )+$( deriveJSON (toOpts 0 0 def { unwrap = False }) ''Attributes )+$( deriveJSON (toOpts 2 2 def) ''AlertAttr )+$( deriveJSON (toOpts 2 2 def) ''AlertInfo )+$( deriveJSON (toOpts 4 3 def) ''CreateAlertResp )+$( deriveJSON (toOpts 3 2 def) ''AlertResp )+$( deriveJSON (toOpts 3 2 def) ''AlertsResp )+$( deriveJSON (toOpts 2 2 def) ''ResourceInfo )+$( deriveJSON (toOpts 2 2 def) ''Top10Info )+$( deriveJSON (toOpts 3 2 def) ''Top10Resp )+$( deriveJSON (toOpts 4 3 def) ''AlertCountResp )+$( deriveJSON (toOpts 4 3 def) ''AlertHistoryResp )+$( deriveJSON (toOpts 2 2 def) ''StatusChange )+$( deriveJSON (toOpts 2 1 def) ''Resp )+$( deriveJSON (toOpts 0 0 def) ''TrendIndication )+$( deriveJSON (toOpts 2 2 def { tag = "type" }) ''HistoryItem )+$( deriveJSON (toOpts 4 3 def { tag = "type" }) ''ExtendedHistoryItem )+$( deriveJSON (toOpts 2 2 def) ''EnvironmentInfo )+$( deriveJSON (toOpts 3 2 def) ''EnvironmentsResp )+$( deriveJSON (toOpts 2 2 def) ''ServiceInfo )+$( deriveJSON (toOpts 3 2 def) ''ServicesResp )+$( deriveJSON (toOpts 1 1 def) ''Blackout )+$( deriveJSON (toOpts 2 2 def) ''BlackoutInfo )+$( deriveJSON (toOpts 2 0 def) ''BlackoutStatus )+$( deriveJSON (toOpts 3 3 def) ''ExtendedBlackoutInfo )+$( deriveJSON (toOpts 3 2 def) ''BlackoutResp )+$( deriveJSON (toOpts 3 2 def) ''BlackoutsResp )+$( deriveJSON (toOpts 1 1 def) ''Heartbeat )+$( deriveJSON (toOpts 2 2 def) ''HeartbeatInfo )+$( deriveJSON (toOpts 3 3 def) ''CreateHeartbeatResp )+$( deriveJSON (toOpts 2 2 def) ''HeartbeatResp )+$( deriveJSON (toOpts 2 2 def) ''HeartbeatsResp )+$( deriveJSON (toOpts 3 3 def) ''CreateApiKey )+$( deriveJSON (toOpts 3 3 def) ''ApiKeyInfo )+$( deriveJSON (toOpts 5 4 def) ''CreateApiKeyResp )+$( deriveJSON (toOpts 4 3 def) ''ApiKeysResp )+$( deriveJSON (toOpts 3 2 def) ''RoleType )+$( deriveJSON (toOpts 1 1 def) ''User )+$( deriveJSON (toOpts 2 2 def) ''UserInfo )+$( deriveJSON (toOpts 3 3 def) ''ExtendedUserInfo )+$( deriveJSON (toOpts 3 2 def) ''UserResp )+$( deriveJSON (toOpts 3 2 def) ''UsersResp )+$( deriveJSON (toOpts 1 1 def) ''Customer )+$( deriveJSON (toOpts 2 2 def) ''CustomerInfo )+$( deriveJSON (toOpts 3 2 def) ''CustomerResp )+$( deriveJSON (toOpts 3 2 def) ''CustomersResp )
+ src/Alerta/Util.hs view
@@ -0,0 +1,65 @@+--------------------------------------------------------------------------------+-- |+-- Module: Alerta.Util+--+-- Internal utilities used by the Alerta package.+-- e.g. Aeson helper functions.+--------------------------------------------------------------------------------+module Alerta.Util+ ( toOpts+ , AesonOpts(..)+ , showTextLowercase+ , capitalise+ , uncapitalise+ , onCamelComponents+ , dropRight+ ) where++import Data.Aeson.TH+import Data.Char+import Data.Default +import qualified Data.Text as T+import Data.Text (Text)++data AesonOpts = AesonOpts { tag :: String, unwrap :: Bool }++instance Default AesonOpts where+ def = AesonOpts "status" True++-- TODO increment num words dropped from fieldLabel when tag is set, otherwise don't use TaggedObject+toOpts :: Int -> Int -> AesonOpts -> Data.Aeson.TH.Options+toOpts k n (AesonOpts f u) = Data.Aeson.TH.Options {+ fieldLabelModifier = uncapitalise . onCamelComponents (drop k)+ , constructorTagModifier = uncapitalise . onCamelComponents (dropRight n)+ , omitNothingFields = True+ , allNullaryToStringTag = True+ , unwrapUnaryRecords = u+ , sumEncoding = TaggedObject { tagFieldName = f, contentsFieldName = "contents" }+}++showTextLowercase :: Show a => a -> Text+showTextLowercase = T.toLower . T.pack . show++uncapitalise :: String -> String+uncapitalise [] = []+uncapitalise (h : t) = toLower h : t++capitalise :: String -> String+capitalise [] = []+capitalise (h : t) = toUpper h : t++dropRight :: Int -> [a] -> [a]+dropRight n = reverse . drop n . reverse++onCamelComponents :: ([String] -> [String]) -> String -> String+onCamelComponents f = concat . f. camelComponents++camelComponents :: String -> [String]+camelComponents = go [] ""+ where+ go :: [String] -> String -> String -> [String]+ go ws w (x:u:l:xs) | isUpper u && isLower l = go ((x:w):ws) [l, u] xs+ go ws w (l:u:xs) | isUpper u && isLower l = go ((l:w):ws) [u] xs+ go ws w (x:xs) = go ws (x:w) xs+ go ws w "" = reverse (map reverse (w:ws))+