{-# 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)