{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ImplicitParams #-} module Monitor.Telegram where import Data.ByteString (ByteString) import Data.Text (pack, Text) import Data.Text.Encoding (decodeUtf8) import Telegram.Bot.API.MakingRequests import Telegram.Bot.API.Methods import Telegram.Bot.API.Types import Telegram.Bot.Simple.BotApp (getEnvToken) import Monitor.DataModel standardRequest :: SomeChatId -> Text -> SendMessageRequest standardRequest :: SomeChatId -> Text -> SendMessageRequest standardRequest SomeChatId chan Text txt = SendMessageRequest :: SomeChatId -> Text -> Maybe ParseMode -> Maybe [MessageEntity] -> Maybe Bool -> Maybe Bool -> Maybe Bool -> Maybe MessageId -> Maybe Bool -> Maybe SomeReplyMarkup -> SendMessageRequest SendMessageRequest { sendMessageChatId :: SomeChatId sendMessageChatId = SomeChatId chan , sendMessageText :: Text sendMessageText = Text txt , sendMessageParseMode :: Maybe ParseMode sendMessageParseMode = ParseMode -> Maybe ParseMode forall a. a -> Maybe a Just ParseMode Markdown , sendMessageDisableWebPagePreview :: Maybe Bool sendMessageDisableWebPagePreview = Bool -> Maybe Bool forall a. a -> Maybe a Just Bool True , sendMessageDisableNotification :: Maybe Bool sendMessageDisableNotification = Bool -> Maybe Bool forall a. a -> Maybe a Just Bool False , sendMessageReplyToMessageId :: Maybe MessageId sendMessageReplyToMessageId = Maybe MessageId forall a. Maybe a Nothing , sendMessageReplyMarkup :: Maybe SomeReplyMarkup sendMessageReplyMarkup = Maybe SomeReplyMarkup forall a. Maybe a Nothing , sendMessageEntities :: Maybe [MessageEntity] sendMessageEntities = Maybe [MessageEntity] forall a. Maybe a Nothing , sendMessageProtectContent :: Maybe Bool sendMessageProtectContent = Maybe Bool forall a. Maybe a Nothing , sendMessageAllowSendingWithoutReply :: Maybe Bool sendMessageAllowSendingWithoutReply = Maybe Bool forall a. Maybe a Nothing } postAlert :: SendMessageRequest -> Monitor () postAlert :: SendMessageRequest -> Monitor () postAlert SendMessageRequest msg = (Settings -> String) -> Monitor String forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Settings -> String telegramTokenVar Monitor String -> (String -> Monitor ()) -> Monitor () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \String tgvar -> IO () -> Monitor () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> Monitor ()) -> IO () -> Monitor () forall a b. (a -> b) -> a -> b $ do Token token <- String -> IO Token getEnvToken String tgvar Either ClientError (Response Message) resp <- Token -> ClientM (Response Message) -> IO (Either ClientError (Response Message)) forall a. Token -> ClientM a -> IO (Either ClientError a) defaultRunBot Token token (SendMessageRequest -> ClientM (Response Message) sendMessage SendMessageRequest msg) Either ClientError (Response Message) -> IO () forall a. Show a => a -> IO () print Either ClientError (Response Message) resp broadcast :: (SomeChatId -> SendMessageRequest) -> Monitor () broadcast :: (SomeChatId -> SendMessageRequest) -> Monitor () broadcast SomeChatId -> SendMessageRequest f = do [Integer] chans <- (Settings -> [Integer]) -> Monitor [Integer] forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Settings -> [Integer] channels (Integer -> Monitor ()) -> [Integer] -> Monitor () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (SendMessageRequest -> Monitor () postAlert (SendMessageRequest -> Monitor ()) -> (Integer -> SendMessageRequest) -> Integer -> Monitor () forall b c a. (b -> c) -> (a -> b) -> a -> c . SomeChatId -> SendMessageRequest f(SomeChatId -> SendMessageRequest) -> (Integer -> SomeChatId) -> Integer -> SendMessageRequest forall b c a. (b -> c) -> (a -> b) -> a -> c . ChatId -> SomeChatId SomeChatId (ChatId -> SomeChatId) -> (Integer -> ChatId) -> Integer -> SomeChatId forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> ChatId ChatId) [Integer] chans deathNote :: FilePath -> SomeChatId -> SendMessageRequest deathNote :: String -> SomeChatId -> SendMessageRequest deathNote String dir SomeChatId chan = SomeChatId -> Text -> SendMessageRequest standardRequest SomeChatId chan Text msg where msg :: Text msg = Text "*Monitor at " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack String dir) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " has stopped by deleting or moving it's working directory*" alertThreadDeath :: (?mutex :: Mutexes) => Monitor () alertThreadDeath :: Monitor () alertThreadDeath = do String dir <- (Settings -> String) -> Monitor String forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Settings -> String databaseDirectory (SomeChatId -> SendMessageRequest) -> Monitor () broadcast ((SomeChatId -> SendMessageRequest) -> Monitor ()) -> (SomeChatId -> SendMessageRequest) -> Monitor () forall a b. (a -> b) -> a -> b $ String -> SomeChatId -> SendMessageRequest deathNote String dir String -> Monitor () forall (m :: * -> *). (?mutex::Mutexes, MonadIO m) => String -> m () logMessage (String "Death alert sent for monitor at " String -> String -> String forall a. Semigroup a => a -> a -> a <> String dir) connectionErrorMessage :: String -> FilePath -> SomeChatId -> SendMessageRequest connectionErrorMessage :: String -> String -> SomeChatId -> SendMessageRequest connectionErrorMessage String err String dir SomeChatId chan = SomeChatId -> Text -> SendMessageRequest standardRequest SomeChatId chan Text msg where msg :: Text msg = Text "*Cannot connect to database at " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack String dir) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".* \n\ \It may indicate cluster restart, check all applications.\n\ \_Error message_: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack String err) alertConnectionError :: (?mutex :: Mutexes) => String -> Monitor () alertConnectionError :: String -> Monitor () alertConnectionError String err = do String dir <- (Settings -> String) -> Monitor String forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks Settings -> String databaseDirectory (SomeChatId -> SendMessageRequest) -> Monitor () broadcast ((SomeChatId -> SendMessageRequest) -> Monitor ()) -> (SomeChatId -> SendMessageRequest) -> Monitor () forall a b. (a -> b) -> a -> b $ String -> String -> SomeChatId -> SendMessageRequest connectionErrorMessage String err String dir String -> Monitor () forall (m :: * -> *). (?mutex::Mutexes, MonadIO m) => String -> m () logMessage (String "Database connection problem alert sent for monitor at " String -> String -> String forall a. Semigroup a => a -> a -> a <> String dir) queryErrorMessage :: FilePath -> String -> ByteString -> SomeChatId -> SendMessageRequest queryErrorMessage :: String -> String -> ByteString -> SomeChatId -> SendMessageRequest queryErrorMessage String path String err ByteString sql SomeChatId chan = SomeChatId -> Text -> SendMessageRequest standardRequest SomeChatId chan Text msg where msg :: Text msg = Text "*Query error while executing check `" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack String path) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "`.* \n\ \*Error message: *\n```" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack String err) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "```\n\ \*SQL text*: ```\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (ByteString -> Text decodeUtf8 ByteString sql) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "```\n\ \It means incorrect assertion (parse errors are treated as 'not null') or error in query." alertQueryError :: (?mutex :: Mutexes) => FilePath -> String -> ByteString -> Monitor () alertQueryError :: String -> String -> ByteString -> Monitor () alertQueryError String path String err ByteString sql = do (SomeChatId -> SendMessageRequest) -> Monitor () broadcast ((SomeChatId -> SendMessageRequest) -> Monitor ()) -> (SomeChatId -> SendMessageRequest) -> Monitor () forall a b. (a -> b) -> a -> b $ String -> String -> ByteString -> SomeChatId -> SendMessageRequest queryErrorMessage String path String err ByteString sql String -> Monitor () forall (m :: * -> *). (?mutex::Mutexes, MonadIO m) => String -> m () logMessage (String "Query error alert sent for " String -> String -> String forall a. Semigroup a => a -> a -> a <> String path) assertionMessage :: FilePath -> Assertion -> ByteString -> String -> SomeChatId -> SendMessageRequest assertionMessage :: String -> Assertion -> ByteString -> String -> SomeChatId -> SendMessageRequest assertionMessage String path Assertion assertion ByteString sql String desc SomeChatId chan = SomeChatId -> Text -> SendMessageRequest standardRequest SomeChatId chan Text msg where msg :: Text msg = Text "*Assertion failed*:\nCheck `" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack String path) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "`. \n\n\ \*Assertion: *" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack (Assertion -> String forall a. Show a => a -> String show Assertion assertion)) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n\n\ \*SQL text*: ```\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (ByteString -> Text decodeUtf8 ByteString sql) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "```\n\ \_Check description_:\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text pack String desc) alertFailedAssertion :: (?mutex :: Mutexes) => FilePath -> PureJob -> Monitor () alertFailedAssertion :: String -> PureJob -> Monitor () alertFailedAssertion String path PureJob{String ByteString Assertion pureJobSQL :: PureJob -> ByteString pureJobAssertion :: PureJob -> Assertion pureJobDescription :: PureJob -> String pureJobSQL :: ByteString pureJobAssertion :: Assertion pureJobDescription :: String ..} = do (SomeChatId -> SendMessageRequest) -> Monitor () broadcast (String -> Assertion -> ByteString -> String -> SomeChatId -> SendMessageRequest assertionMessage String path Assertion pureJobAssertion ByteString pureJobSQL String pureJobDescription) String -> Monitor () forall (m :: * -> *). (?mutex::Mutexes, MonadIO m) => String -> m () logMessage (String "Failed assertion alert sent for " String -> String -> String forall a. Semigroup a => a -> a -> a <> String path)