Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Denis Shevchenko
committed
Jun 22, 2022
1 parent
fe4997a
commit 125773a
Showing
27 changed files
with
1,335 additions
and
142 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
31 changes: 31 additions & 0 deletions
31
cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Check.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,31 @@ | ||
| module Cardano.Tracer.Handlers.RTView.Notifications.Check | ||
| ( checkCommonErrors | ||
| ) where | ||
|
|
||
| --import Data.Text (Text) | ||
| --import qualified Data.Text as T | ||
|
|
||
| import Cardano.Logging (SeverityS (..)) | ||
|
|
||
| import Cardano.Tracer.Handlers.RTView.Notifications.Types | ||
| import Cardano.Tracer.Handlers.RTView.Notifications.Utils | ||
| import Cardano.Tracer.Handlers.RTView.State.TraceObjects | ||
| import Cardano.Tracer.Types | ||
|
|
||
| checkCommonErrors | ||
| :: NodeId | ||
| -> TraceObjectInfo | ||
| -> EventsQueues | ||
| -> IO () | ||
| checkCommonErrors nodeId (msg, sev, ts) eventsQueues = | ||
| case sev of | ||
| Warning -> addNewEventTo EventWarnings | ||
| Error -> addNewEventTo EventErrors | ||
| Critical -> addNewEventTo EventCriticals | ||
| Alert -> addNewEventTo EventAlerts | ||
| Emergency -> addNewEventTo EventEmergencies | ||
| _ -> return () | ||
| where | ||
| addNewEventTo eventGroup = | ||
| addNewEvent eventsQueues eventGroup $ Event nodeId ts sev msg | ||
|
|
56 changes: 56 additions & 0 deletions
56
cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Email.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,56 @@ | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE NamedFieldPuns #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
|
|
||
| module Cardano.Tracer.Handlers.RTView.Notifications.Email | ||
| ( StatusMessage | ||
| , createAndSendEmail | ||
| , createAndSendTestEmail | ||
| ) where | ||
|
|
||
| import Control.Exception.Extra (try_) | ||
| import Data.Text (Text) | ||
| import qualified Data.Text as T | ||
| import qualified Data.Text.Lazy as LT | ||
| import Network.Mail.Mime (Address (..), Mail (..), simpleMail') | ||
| import qualified Network.Mail.SMTP as SMTP | ||
|
|
||
| import Cardano.Tracer.Handlers.RTView.Notifications.Types | ||
|
|
||
| type StatusMessage = Text | ||
|
|
||
| createAndSendEmail | ||
| :: EmailSettings | ||
| -> Text | ||
| -> IO StatusMessage | ||
| createAndSendEmail settings@EmailSettings {esEmailTo, esEmailFrom, esSubject} bodyMessage = | ||
| sendEmail settings $ simpleMail' to from esSubject body | ||
| where | ||
| to = Address Nothing esEmailTo | ||
| from = Address (Just "Cardano RTView") esEmailFrom | ||
| body = LT.fromStrict bodyMessage | ||
|
|
||
| createAndSendTestEmail | ||
| :: EmailSettings | ||
| -> IO StatusMessage | ||
| createAndSendTestEmail settings = createAndSendEmail settings body | ||
| where | ||
| body = "This is a test notification from Cardano RTView. Congrats: your email settings are correct!" | ||
|
|
||
| sendEmail | ||
| :: EmailSettings | ||
| -> IO StatusMessage | ||
| sendEmail EmailSettings {esSMTPHost, esSMTPPort, esUsername, esPassword, esSSL} mail = | ||
| try_ (sender host port user pass mail) >>= \case | ||
| Left e -> return $ "Unable to send email: " <> T.pack (show e) | ||
| Right _ -> return "Yay! Notification is sent." | ||
| where | ||
| sender = case esSSL of | ||
| TLS -> SMTP.sendMailWithLoginTLS' | ||
| STARTTLS -> SMTP.sendMailWithLoginSTARTTLS' | ||
| NoSSL -> SMTP.sendMailWithLogin' | ||
| host = T.unpack esSMTPHost | ||
| port = fromIntegral esSMTPPort | ||
| user = T.unpack esUsername | ||
| pass = T.unpack esPassword |
79 changes: 79 additions & 0 deletions
79
cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Send.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,79 @@ | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
|
|
||
| module Cardano.Tracer.Handlers.RTView.Notifications.Send | ||
| ( makeAndSendNotification | ||
| ) where | ||
|
|
||
| import Control.Concurrent.STM (atomically) | ||
| import Control.Concurrent.STM.TBQueue (flushTBQueue) | ||
| import Control.Concurrent.STM.TVar (TVar, modifyTVar', readTVarIO) | ||
| import Control.Monad (forM, unless, void) | ||
| import Data.List (nub) | ||
| import Data.Maybe (fromMaybe) | ||
| import Data.Text (Text) | ||
| import qualified Data.Text as T | ||
| import Data.Time.Clock (UTCTime) | ||
| import Data.Time.Format (defaultTimeLocale, formatTime) | ||
|
|
||
| import Cardano.Node.Startup (NodeInfo (..)) | ||
|
|
||
| import Cardano.Tracer.Handlers.RTView.Notifications.Email | ||
| import Cardano.Tracer.Handlers.RTView.Notifications.Settings | ||
| import Cardano.Tracer.Handlers.RTView.Notifications.Types | ||
| import Cardano.Tracer.Handlers.RTView.Update.Utils | ||
| import Cardano.Tracer.Types | ||
| import Cardano.Tracer.Utils | ||
|
|
||
| makeAndSendNotification | ||
| :: DataPointRequestors | ||
| -> TVar UTCTime | ||
| -> EventsQueue | ||
| -> IO () | ||
| makeAndSendNotification dpRequestors lastTime eventsQueue = do | ||
| emailSettings <- readSavedEmailSettings | ||
| unless (incompleteEmailSettings emailSettings) $ do | ||
| events <- atomically $ nub <$> flushTBQueue eventsQueue | ||
| let (nodeIds, tss) = unzip $ nub [(nodeId, ts) | Event nodeId ts _ _ <- events] | ||
| unless (null nodeIds) $ do | ||
| nodeNames <- | ||
| forM nodeIds $ \nodeId@(NodeId anId) -> | ||
| askDataPoint dpRequestors nodeId "NodeInfo" >>= \case | ||
| Nothing -> return anId | ||
| Just ni -> return $ niName ni | ||
| lastEventTime <- readTVarIO lastTime | ||
| let onlyNewEvents = filter (\(Event _ ts _ _) -> ts > lastEventTime) events | ||
| sendNotification emailSettings onlyNewEvents $ zip nodeIds nodeNames | ||
| updateLastTime $ maximum tss | ||
| where | ||
| updateLastTime = atomically . modifyTVar' lastTime . const | ||
|
|
||
| sendNotification | ||
| :: EmailSettings | ||
| -> [Event] | ||
| -> [(NodeId, Text)] | ||
| -> IO () | ||
| sendNotification _ [] _ = return () | ||
| sendNotification emailSettings newEvents nodeIdsWithNames = | ||
| void $ createAndSendEmail emailSettings body | ||
| where | ||
| body = preface <> events | ||
|
|
||
| preface = T.intercalate nl | ||
| [ "This is a notification from Cardano RTView service." | ||
| , "" | ||
| , "The following " <> (if onlyOne then "event" else "events") <> " occurred:" | ||
| , "" | ||
| ] | ||
|
|
||
| events = T.intercalate nl | ||
| [ "[" <> formatTS ts <> "] [" <> getNodeName nodeId <> "] [" <> showT sev <> "] [" <> showT msg <> "]" | ||
| | Event nodeId ts sev msg <- newEvents | ||
| ] | ||
|
|
||
| onlyOne = length newEvents == 1 | ||
|
|
||
| formatTS = T.pack . formatTime defaultTimeLocale "%F %T %Z" | ||
|
|
||
| getNodeName nodeId@(NodeId anId) = | ||
| fromMaybe anId $ lookup nodeId nodeIdsWithNames |
98 changes: 98 additions & 0 deletions
98
cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Settings.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,98 @@ | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
|
|
||
| module Cardano.Tracer.Handlers.RTView.Notifications.Settings | ||
| ( incompleteEmailSettings | ||
| , readSavedEmailSettings | ||
| , readSavedEventsSettings | ||
| , saveEmailSettingsOnDisk | ||
| , saveEventsSettingsOnDisk | ||
| ) where | ||
|
|
||
| import Control.Exception.Extra (ignore, try_) | ||
| import Crypto.Cipher.AES (AES256) | ||
| import Crypto.Cipher.Types (BlockCipher (..), cipherInit, ctrCombine, nullIV) | ||
| import Crypto.Error (CryptoError, eitherCryptoError) | ||
| import Data.Aeson (decodeStrict', encode, encodeFile) | ||
| import qualified Data.ByteString as BS | ||
| import qualified Data.ByteString.Lazy as LBS | ||
| import qualified Data.Text as T | ||
|
|
||
| import Cardano.Tracer.Handlers.RTView.Notifications.Types | ||
| import Cardano.Tracer.Handlers.RTView.System | ||
|
|
||
| readSavedEmailSettings :: IO EmailSettings | ||
| readSavedEmailSettings = do | ||
| (pathToEmailSettings, _) <- getPathsToNotificationsSettings | ||
| try_ (BS.readFile pathToEmailSettings) >>= \case | ||
| Left _ -> return defaultSettings | ||
| Right encryptedSettings -> | ||
| case decryptJSON encryptedSettings of | ||
| Left _ -> return defaultSettings | ||
| Right jsonSettings -> | ||
| case decodeStrict' jsonSettings of | ||
| Nothing -> return defaultSettings | ||
| Just (settings :: EmailSettings) -> return settings | ||
| where | ||
| defaultSettings = EmailSettings | ||
| { esSMTPHost = "" | ||
| , esSMTPPort = -1 | ||
| , esUsername = "" | ||
| , esPassword = "" | ||
| , esSSL = TLS | ||
| , esEmailFrom = "" | ||
| , esEmailTo = "" | ||
| , esSubject = "" | ||
| } | ||
|
|
||
| decryptJSON :: BS.ByteString -> Either CryptoError BS.ByteString | ||
| decryptJSON = encryptJSON -- Encryption/decryption is symmetric. | ||
|
|
||
| incompleteEmailSettings :: EmailSettings -> Bool | ||
| incompleteEmailSettings emailSettings = T.null $ esSMTPHost emailSettings | ||
|
|
||
| encryptJSON :: BS.ByteString -> Either CryptoError BS.ByteString | ||
| encryptJSON plainJSON = ctrCombine | ||
| <$> cInit | ||
| <*> pure nullIV | ||
| <*> pure plainJSON | ||
| where | ||
| cInit :: Either CryptoError AES256 | ||
| cInit = eitherCryptoError $ cipherInit key | ||
|
|
||
| -- The length must be exactly 32 bytes (256 bits). | ||
| key :: BS.ByteString | ||
| key = "n3+d6^jrodGe$1Ljwt;iBtsi_mxzp-47" | ||
|
|
||
| readSavedEventsSettings :: IO EventsSettings | ||
| readSavedEventsSettings = do | ||
| (_, pathToEventsSettings) <- getPathsToNotificationsSettings | ||
| try_ (BS.readFile pathToEventsSettings) >>= \case | ||
| Left _ -> return defaultSettings | ||
| Right jsonSettings -> | ||
| case decodeStrict' jsonSettings of | ||
| Nothing -> return defaultSettings | ||
| Just (settings :: EventsSettings) -> return settings | ||
| where | ||
| defaultSettings = EventsSettings | ||
| { evsWarnings = defaultState | ||
| , evsErrors = defaultState | ||
| , evsCriticals = defaultState | ||
| , evsAlerts = defaultState | ||
| , evsEmergencies = defaultState | ||
| } | ||
| defaultState = (False, 1800) | ||
|
|
||
| saveEmailSettingsOnDisk :: EmailSettings -> IO () | ||
| saveEmailSettingsOnDisk settings = ignore $ do | ||
| (pathToEmailSettings, _) <- getPathsToNotificationsSettings | ||
| -- Encrypt JSON-content to avoid saving user's private data in "plain mode". | ||
| case encryptJSON . LBS.toStrict . encode $ settings of | ||
| Right encryptedJSON -> BS.writeFile pathToEmailSettings encryptedJSON | ||
| Left _ -> return () | ||
|
|
||
| saveEventsSettingsOnDisk :: EventsSettings -> IO () | ||
| saveEventsSettingsOnDisk settings = ignore $ do | ||
| (_, pathToEventsSettings) <- getPathsToNotificationsSettings | ||
| encodeFile pathToEventsSettings settings |
Oops, something went wrong.