{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE OverloadedRecordDot #-}

-- | Application startup module
module MatrixBot.App
     ( runApp
     ) where

import GHC.Generics (Generic)
import Data.Aeson (ToJSON (..), FromJSON (..), eitherDecodeFileStrict)
import Data.Aeson.Text (encodeToLazyText)
import Data.String (IsString)
import Data.Text (Text, pack)
import Data.Text.Lazy (toStrict)
import qualified Data.Text.IO as TextIO
import Control.Lens.Lens (lens)
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift (MonadUnliftIO)
import qualified Control.Exception.Safe as E
import qualified Control.Monad.Logger as ML
import qualified Control.Monad.Reader as MR
import System.Exit (ExitCode (..))
import System.IO
import MatrixBot.AesonUtils (myGenericToJSON, myGenericParseJSON)
import MatrixBot.Log
import MatrixBot.MatrixApi (EventResponse)
import qualified MatrixBot.Auth as Auth
import qualified MatrixBot.Bot as Bot
import qualified MatrixBot.Options as O
import qualified MatrixBot.SharedTypes as T
import MatrixBot.Bot.Jobs.Handlers.SendMessage (sendMessage, MessageEdit (..))
import qualified MatrixBot.Bot.Jobs.Queue as BotJobsQueue
import qualified Control.Lens as Lens
import qualified UnliftIO as UIO


type AppM m =
  ( MonadIO m
  , MonadUnliftIO m
  , MonadFail m
  , E.MonadMask m
  )


runApp ∷ AppM m ⇒ m ()
runApp :: forall (m :: * -> *). AppM m => m ()
runApp = m ()
forall {m :: * -> *}.
(MonadUnliftIO m, MonadFail m, MonadMask m) =>
m ()
go where
  go :: m ()
go = do
    logStateHandle ← m LogStateHandle
forall (m :: * -> *). MonadIO m => m LogStateHandle
createLogState
    withLogger logStateHandle . MR.runReaderT $
      E.catch (startApp logStateHandle) (exceptionHandler logStateHandle)

  exceptionHandler
    ∷ (UIO.MonadUnliftIO m, E.MonadThrow m, ML.MonadLogger m)
    ⇒ LogStateHandle
    → E.SomeException
    → m ()
  exceptionHandler :: forall (m :: * -> *).
(MonadUnliftIO m, MonadThrow m, MonadLogger m) =>
LogStateHandle -> SomeException -> m ()
exceptionHandler LogStateHandle
logStateHandle SomeException
e = do
    LogStateHandle -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
LogStateHandle -> m ()
forceLogInitialization LogStateHandle
logStateHandle
    case forall e. Exception e => SomeException -> Maybe e
E.fromException @ExitCode SomeException
e of
      Just ExitCode
ExitSuccess → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> (SomeException -> Text) -> SomeException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Application exits with: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> (SomeException -> String) -> SomeException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
E.displayException (SomeException -> m ()) -> SomeException -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException
e
        SomeException -> m ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
E.throwM SomeException
e
      Maybe ExitCode
_ → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logError (Text -> m ()) -> (SomeException -> Text) -> SomeException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Application failed with: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> (SomeException -> String) -> SomeException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
E.displayException (SomeException -> m ()) -> SomeException -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException
e
        SomeException -> m ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
E.throwM SomeException
e

  startApp ∷ (AppM m, ML.MonadLogger m) ⇒ LogStateHandle → m ()
  startApp :: forall (m :: * -> *).
(AppM m, MonadLogger m) =>
LogStateHandle -> m ()
startApp LogStateHandle
logStateHandle = do
    Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug Text
"Starting the application…"

    Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug Text
"Parsing the command-line arguments…"
    m AppCommand
forall (m :: * -> *). MonadIO m => m AppCommand
O.parseAppCommand m AppCommand -> (AppCommand -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      O.AppCommandAuth AuthOptions
opts → do
        LogStateHandle -> Maybe LogLevel -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
LogStateHandle -> Maybe LogLevel -> m ()
setLogLevel LogStateHandle
logStateHandle AuthOptions
opts.authOptionsLogLevel
        AuthOptions -> m ()
forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadFail m, MonadThrow m,
 MonadLogger m) =>
AuthOptions -> m ()
runAuth AuthOptions
opts
      O.AppCommandStart StartOptions
opts → do
        LogStateHandle -> Maybe LogLevel -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
LogStateHandle -> Maybe LogLevel -> m ()
setLogLevel LogStateHandle
logStateHandle StartOptions
opts.startOptionsLogLevel
        StartOptions -> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m,
 MonadLogger m) =>
StartOptions -> m ()
runStart StartOptions
opts
      O.AppCommandSendMessage SendMessageOptions
opts → do
        LogStateHandle -> Maybe LogLevel -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
LogStateHandle -> Maybe LogLevel -> m ()
setLogLevel LogStateHandle
logStateHandle SendMessageOptions
opts.sendMessageOptionsLogLevel
        SendMessageOptions -> m ()
forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadFail m, MonadThrow m,
 MonadLogger m) =>
SendMessageOptions -> m ()
runSendMessage SendMessageOptions
opts
      O.AppCommandEditMessage EditMessageOptions
opts → do
        LogStateHandle -> Maybe LogLevel -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
LogStateHandle -> Maybe LogLevel -> m ()
setLogLevel LogStateHandle
logStateHandle EditMessageOptions
opts.editMessageOptionsLogLevel
        EditMessageOptions -> m ()
forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadFail m, MonadThrow m,
 MonadLogger m) =>
EditMessageOptions -> m ()
runEditMessage EditMessageOptions
opts


runAuth
  ∷ (MonadIO m, MonadUnliftIO m, MonadFail m, E.MonadThrow m, ML.MonadLogger m)
  ⇒ O.AuthOptions
  → m ()
runAuth :: forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadFail m, MonadThrow m,
 MonadLogger m) =>
AuthOptions -> m ()
runAuth AuthOptions
opts = do
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logInfo Text
"Running authentication…"
  let quotedMxid :: Text
quotedMxid = Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (AuthOptions -> Text) -> AuthOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mxid -> Text
T.printMxid (Mxid -> Text) -> (AuthOptions -> Mxid) -> AuthOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthOptions -> Mxid
O.authOptionsMxid (AuthOptions -> Text) -> AuthOptions -> Text
forall a b. (a -> b) -> a -> b
$ AuthOptions
opts
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"MXID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedMxid

  password ←
    case AuthOptions -> Either Password String
O.authOptionsPassword AuthOptions
opts of
      Left Password
x →
        Password
x Password -> m () -> m Password
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text
"Password for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedMxid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was provided as an option argument")
      Right String
file → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Reading password for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quotedMxid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted String
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"…"
        handle ← IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openFile String
file IOMode
ReadMode
        liftIO $ T.Password <$> TextIO.hGetLine handle

  credentials ← Auth.authenticate (O.authOptionsMxid opts) password
  logDebug "Received credentials"

  logDebug $ "Saving credentials to " <> (quoted . O.authOptionsOutputFile) opts <> "…"
  liftIO . TextIO.writeFile (O.authOptionsOutputFile opts) . toStrict . encodeToLazyText $ credentials

  logInfo "Success!"


runStart
  ∷ (MonadIO m, MonadFail m, E.MonadMask m, MonadUnliftIO m, ML.MonadLogger m)
  ⇒ O.StartOptions
  → m ()
runStart :: forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m,
 MonadLogger m) =>
StartOptions -> m ()
runStart StartOptions
opts = do
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logInfo Text
"Initializing the bot…"

  let
    retryLimit :: RetryLimit
retryLimit = StartOptions -> RetryLimit
O.startOptionsRetryLimit StartOptions
opts
    retryDelay :: RetryDelay
retryDelay = StartOptions -> RetryDelay
O.startOptionsRetryDelay StartOptions
opts
    eventTokenFile :: Maybe String
eventTokenFile = StartOptions -> Maybe String
O.startOptionsEventTokenFile StartOptions
opts
    eventsTimeout :: EventsTimeout
eventsTimeout = StartOptions -> EventsTimeout
O.startOptionsEventsTimeout StartOptions
opts

  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"Failed Matrix API call retry limit: "
    , String -> Text
pack (String -> Text) -> (RetryLimit -> String) -> RetryLimit -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> String
forall a. Show a => a -> String
show (Natural -> String)
-> (RetryLimit -> Natural) -> RetryLimit -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetryLimit -> Natural
T.unRetryLimit (RetryLimit -> Text) -> RetryLimit -> Text
forall a b. (a -> b) -> a -> b
$ RetryLimit
retryLimit
    , Text
" (amount of retries before bot fails completely)"
    ]

  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"Failed Matrix API call retry interval: "
    , RetryDelay -> Text
forall s. IsString s => RetryDelay -> s
T.printRetryDelaySeconds RetryDelay
retryDelay
    ]

  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"Matrix events listening timeout: "
    , String -> Text
pack (String -> Text)
-> (EventsTimeout -> String) -> EventsTimeout -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String)
-> (EventsTimeout -> Integer) -> EventsTimeout -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> Integer
T.unSeconds (Seconds -> Integer)
-> (EventsTimeout -> Seconds) -> EventsTimeout -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventsTimeout -> Seconds
T.unEventsTimeout (EventsTimeout -> Text) -> EventsTimeout -> Text
forall a b. (a -> b) -> a -> b
$ EventsTimeout
eventsTimeout
    , Text
" second(s)"
    ]

  case Maybe String
eventTokenFile of
    Maybe String
Nothing →
      Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"There’s no event token file provided, "
        , Text
"will start listening from next following events"
        ]
    Just String
x →
      Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Event token file where to read from and save to last event token that is used "
        , Text
"as a starting point to get next events from: ", String -> Text
pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
x
        ]

  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"Reading and parsing credentials "
    , String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (String -> Text)
-> (StartOptions -> String) -> StartOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StartOptions -> String
O.startOptionsCredentialsFile (StartOptions -> Text) -> StartOptions -> Text
forall a b. (a -> b) -> a -> b
$ StartOptions
opts
    , Text
" file…"
    ]

  credentials ←
    (String -> m Credentials)
-> (Credentials -> m Credentials)
-> Either String Credentials
-> m Credentials
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Credentials
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Credentials -> m Credentials
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Credentials -> m Credentials)
-> m (Either String Credentials) -> m Credentials
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either String Credentials) -> m (Either String Credentials)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Either String Credentials)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict (String -> IO (Either String Credentials))
-> (StartOptions -> String)
-> StartOptions
-> IO (Either String Credentials)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StartOptions -> String
O.startOptionsCredentialsFile (StartOptions -> IO (Either String Credentials))
-> StartOptions -> IO (Either String Credentials)
forall a b. (a -> b) -> a -> b
$ StartOptions
opts)

  let
    quotedMxid
      = Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (Mxid -> Text) -> Mxid -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mxid -> Text
T.printMxid
      (Mxid -> Text) -> Mxid -> Text
forall a b. (a -> b) -> a -> b
$ Username -> HomeServer -> Mxid
T.Mxid (Credentials -> Username
Auth.credentialsUsername Credentials
credentials) (Credentials -> HomeServer
Auth.credentialsHomeServer Credentials
credentials)

  logDebug $ "MXID: " <> quotedMxid

  logDebug $ mconcat
    [ "Reading and parsing bot configuration from "
    , quoted . O.startOptionsBotConfigFile $ opts
    , " file…"
    ]

  botConfig ←
    either fail pure =<< liftIO (eitherDecodeFileStrict . O.startOptionsBotConfigFile $ opts)

  botJobsQueue ← BotJobsQueue.mkBotJobsQueue

  logInfo "Listening to events…"
  Bot.startTheBot eventTokenFile eventsTimeout botConfig
    `MR.runReaderT` BotEnv credentials retryLimit retryDelay botJobsQueue


runSendMessage
  ∷ (MonadIO m, MonadUnliftIO m, MonadFail m, E.MonadThrow m, ML.MonadLogger m)
  ⇒ O.SendMessageOptions
  → m ()
runSendMessage :: forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadFail m, MonadThrow m,
 MonadLogger m) =>
SendMessageOptions -> m ()
runSendMessage SendMessageOptions
opts = do
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logInfo Text
"Running send message command…"

  let roomId :: RoomId
roomId = SendMessageOptions -> RoomId
O.sendMessageOptionsRoomId SendMessageOptions
opts

  credentials ∷ Auth.Credentials ← do
    Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Reading and parsing credentials "
      , String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (String -> Text)
-> (SendMessageOptions -> String) -> SendMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendMessageOptions -> String
O.sendMessageOptionsCredentialsFile (SendMessageOptions -> Text) -> SendMessageOptions -> Text
forall a b. (a -> b) -> a -> b
$ SendMessageOptions
opts
      , Text
" file…"
      ]

    (String -> m Credentials)
-> (Credentials -> m Credentials)
-> Either String Credentials
-> m Credentials
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Credentials
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Credentials -> m Credentials
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Credentials -> m Credentials)
-> m (Either String Credentials) -> m Credentials
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either String Credentials) -> m (Either String Credentials)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Either String Credentials)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict (String -> IO (Either String Credentials))
-> (SendMessageOptions -> String)
-> SendMessageOptions
-> IO (Either String Credentials)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendMessageOptions -> String
O.sendMessageOptionsCredentialsFile (SendMessageOptions -> IO (Either String Credentials))
-> SendMessageOptions -> IO (Either String Credentials)
forall a b. (a -> b) -> a -> b
$ SendMessageOptions
opts)

  message ←
    case O.sendMessageOptionsMessage opts of
      Left Text
x →
        (Text
x Text -> m () -> m Text
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m Text) -> (Text -> m ()) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Message to send to ", String -> Text
pack (String -> Text) -> (RoomId -> String) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (RoomId -> Text) -> RoomId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId (RoomId -> Text) -> RoomId -> Text
forall a b. (a -> b) -> a -> b
$ RoomId
roomId
          , Text
" room was provided as an option argument"
          ]
      Right String
file → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Reading message to send to ", String -> Text
pack (String -> Text) -> (RoomId -> String) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (RoomId -> Text) -> RoomId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId (RoomId -> Text) -> RoomId -> Text
forall a b. (a -> b) -> a -> b
$ RoomId
roomId
          , Text
" room from ", String -> Text
pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
file, Text
" file…"
          ]
        IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
TextIO.readFile String
file

  htmlMessage ←
    case O.sendMessageOptionsHtmlMessage opts of
      Maybe (Either Text String)
Nothing → Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      Just (Left Text
x) →
        (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x Maybe Text -> m () -> m (Maybe Text)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m (Maybe Text))
-> (Text -> m ()) -> Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m (Maybe Text)) -> Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"HTML-formatted message to send to "
          , (String -> Text
pack (String -> Text) -> (RoomId -> String) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (RoomId -> Text) -> RoomId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" room was provided as an option argument"
          ]
      Just (Right String
file) → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Reading HTML-formatted message to send to "
          , (String -> Text
pack (String -> Text) -> (RoomId -> String) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (RoomId -> Text) -> RoomId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" room from "
          , (String -> Text
pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show) String
file
          , Text
" file…"
          ]
        (Text -> Maybe Text) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (m Text -> m (Maybe Text))
-> (IO Text -> m Text) -> IO Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m (Maybe Text)) -> IO Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> IO Text
TextIO.readFile String
file

  replyTo ←
    case O.sendMessageOptionsReplyTo opts of
      Maybe EventId
Nothing → Maybe EventId -> m (Maybe EventId)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EventId
forall a. Maybe a
Nothing
      Just EventId
x → (EventId -> Maybe EventId
forall a. a -> Maybe a
Just EventId
x Maybe EventId -> m () -> m (Maybe EventId)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m (Maybe EventId)) -> m () -> m (Maybe EventId)
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"Replying to ", (String -> Text
pack (String -> Text) -> (EventId -> String) -> EventId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show) EventId
x]

  flip MR.runReaderT credentials $
    Bot.withReqAndAuth (T.EventsTimeout . T.Seconds $ 30) $ \MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth → do
      transactionId ←
        case SendMessageOptions -> Maybe TransactionId
O.sendMessageOptionsTransactionId SendMessageOptions
opts of
          Maybe TransactionId
Nothing → do
            txid ← ReaderT Credentials m TransactionId
forall (m :: * -> *). MonadIO m => m TransactionId
T.genTransactionId
            (txid <$) . logDebug $ mconcat
              [ "No transaction ID was provided in the command-line options, generated new one: "
              , pack . show . T.unTransactionId $ txid
              ]
          Just TransactionId
txid → do
            (TransactionId
txid TransactionId
-> ReaderT Credentials m () -> ReaderT Credentials m TransactionId
forall a b. a -> ReaderT Credentials m b -> ReaderT Credentials m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (ReaderT Credentials m () -> ReaderT Credentials m TransactionId)
-> (Text -> ReaderT Credentials m ())
-> Text
-> ReaderT Credentials m TransactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReaderT Credentials m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> ReaderT Credentials m TransactionId)
-> Text -> ReaderT Credentials m TransactionId
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"Using transaction ID provided in the command-line options: "
              , String -> Text
pack (String -> Text)
-> (TransactionId -> String) -> TransactionId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall a. Show a => a -> String
show (UUID -> String)
-> (TransactionId -> UUID) -> TransactionId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionId -> UUID
T.unTransactionId (TransactionId -> Text) -> TransactionId -> Text
forall a b. (a -> b) -> a -> b
$ TransactionId
txid
              ]

      response ← sendMessage req auth transactionId roomId replyTo htmlMessage message Nothing

      logDebug "Printing response and transaction ID to stdout…"

      liftIO . TextIO.putStrLn . toStrict . encodeToLazyText $ SendMessageResponse
        { sendMessageResponseTransactionId = transactionId
        , sendMessageResponseResponse = response
        }

      logInfo "Success!"


runEditMessage
  ∷ (MonadIO m, MonadUnliftIO m, MonadFail m, E.MonadThrow m, ML.MonadLogger m)
  ⇒ O.EditMessageOptions
  → m ()
runEditMessage :: forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadFail m, MonadThrow m,
 MonadLogger m) =>
EditMessageOptions -> m ()
runEditMessage EditMessageOptions
opts = do
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logInfo Text
"Running edit message command…"

  let roomId :: RoomId
roomId = EditMessageOptions -> RoomId
O.editMessageOptionsRoomId EditMessageOptions
opts

  credentials ∷ Auth.Credentials ← do
    Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Reading and parsing credentials "
      , (String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> String
O.editMessageOptionsCredentialsFile) EditMessageOptions
opts
      , Text
" file…"
      ]

    (String -> m Credentials)
-> (Credentials -> m Credentials)
-> Either String Credentials
-> m Credentials
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Credentials
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Credentials -> m Credentials
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Credentials -> m Credentials)
-> m (Either String Credentials) -> m Credentials
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either String Credentials) -> m (Either String Credentials)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Either String Credentials)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict (String -> IO (Either String Credentials))
-> (EditMessageOptions -> String)
-> EditMessageOptions
-> IO (Either String Credentials)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> String
O.editMessageOptionsCredentialsFile (EditMessageOptions -> IO (Either String Credentials))
-> EditMessageOptions -> IO (Either String Credentials)
forall a b. (a -> b) -> a -> b
$ EditMessageOptions
opts)

  message ←
    case O.editMessageOptionsMessage opts of
      Left Text
x →
        (Text
x Text -> m () -> m Text
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m Text) -> (Text -> m ()) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"New message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" was provided as an option argument"
          ]
      Right String
file → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Reading new message message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" from ", String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted String
file, Text
" file…"
          ]
        IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
TextIO.readFile String
file

  htmlMessage ←
    case O.editMessageOptionsHtmlMessage opts of
      Maybe (Either Text String)
Nothing → Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      Just (Left Text
x) →
        (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x Maybe Text -> m () -> m (Maybe Text)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m (Maybe Text))
-> (Text -> m ()) -> Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m (Maybe Text)) -> Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"New HTML-formatted message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" was provided as an option argument"
          ]
      Just (Right String
file) → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Reading new HTML-formatted message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" from ", String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted String
file, Text
" file…"
          ]
        (Text -> Maybe Text) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (m Text -> m (Maybe Text))
-> (IO Text -> m Text) -> IO Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m (Maybe Text)) -> IO Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> IO Text
TextIO.readFile String
file

  compatMessage ←
    case O.editMessageOptionsMessageCompat opts of
      Maybe (Either Text String)
Nothing → Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
compatTextDefaultTemplate Text
message)
      Just (Left Text
x) →
        (Text
x Text -> m () -> m Text
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m Text) -> (Text -> m ()) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"New old API-compatible message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" was provided as an option argument"
          ]
      Just (Right String
file) → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Reading new old API-compatible message message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" from ", String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted String
file, Text
" file…"
          ]
        IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
TextIO.readFile String
file

  compatHtmlMessage ←
    case (O.editMessageOptionsHtmlMessageCompat opts, htmlMessage) of
      (Maybe (Either Text String)
Nothing, Maybe Text
Nothing) → Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      (Maybe (Either Text String)
Nothing, Just Text
newHtmlBody) → (Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text))
-> (Text -> Maybe Text) -> Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
compatHtmlDefaultTemplate) Text
newHtmlBody
      (Just (Left Text
x), Maybe Text
_) →
        (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x Maybe Text -> m () -> m (Maybe Text)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m (Maybe Text))
-> (Text -> m ()) -> Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m (Maybe Text)) -> Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"New old API-compatible HTML-formatted message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" was provided as an option argument"
          ]
      (Just (Right String
file), Maybe Text
_) → do
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Reading new old API-compatible HTML-formatted message body for the message "
          , (String -> Text
pack (String -> Text)
-> (EditMessageOptions -> String) -> EditMessageOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show (EventId -> String)
-> (EditMessageOptions -> EventId) -> EditMessageOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageOptions -> EventId
O.editMessageOptionsMessageId) EditMessageOptions
opts
          , Text
" in the room "
          , (Text -> Text
forall s. (IsString s, Show s) => s -> Text
quoted (Text -> Text) -> (RoomId -> Text) -> RoomId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoomId -> Text
T.printRoomId) RoomId
roomId
          , Text
" from ", String -> Text
forall s. (IsString s, Show s) => s -> Text
quoted String
file, Text
" file…"
          ]
        (Text -> Maybe Text) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (m Text -> m (Maybe Text))
-> (IO Text -> m Text) -> IO Text -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m (Maybe Text)) -> IO Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> IO Text
TextIO.readFile String
file

  replyTo ←
    case O.editMessageOptionsReplyTo opts of
      Maybe EventId
Nothing → Maybe EventId -> m (Maybe EventId)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EventId
forall a. Maybe a
Nothing
      Just EventId
x → (EventId -> Maybe EventId
forall a. a -> Maybe a
Just EventId
x Maybe EventId -> m () -> m (Maybe EventId)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m () -> m (Maybe EventId)) -> m () -> m (Maybe EventId)
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"Replying to ", (String -> Text
pack (String -> Text) -> (EventId -> String) -> EventId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId -> String
forall a. Show a => a -> String
show) EventId
x]

  flip MR.runReaderT credentials $
    Bot.withReqAndAuth (T.EventsTimeout . T.Seconds $ 30) $ \MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth → do
      transactionId ←
        case EditMessageOptions -> Maybe TransactionId
O.editMessageOptionsTransactionId EditMessageOptions
opts of
          Maybe TransactionId
Nothing → do
            txid ← ReaderT Credentials m TransactionId
forall (m :: * -> *). MonadIO m => m TransactionId
T.genTransactionId
            (txid <$) . logDebug $ mconcat
              [ "No transaction ID was provided in the command-line options, generated new one: "
              , (pack . show . T.unTransactionId) txid
              ]
          Just TransactionId
txid → do
            (TransactionId
txid TransactionId
-> ReaderT Credentials m () -> ReaderT Credentials m TransactionId
forall a b. a -> ReaderT Credentials m b -> ReaderT Credentials m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (ReaderT Credentials m () -> ReaderT Credentials m TransactionId)
-> (Text -> ReaderT Credentials m ())
-> Text
-> ReaderT Credentials m TransactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReaderT Credentials m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
logDebug (Text -> ReaderT Credentials m TransactionId)
-> Text -> ReaderT Credentials m TransactionId
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"Using transaction ID provided in the command-line options: "
              , (String -> Text
pack (String -> Text)
-> (TransactionId -> String) -> TransactionId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall a. Show a => a -> String
show (UUID -> String)
-> (TransactionId -> UUID) -> TransactionId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionId -> UUID
T.unTransactionId) TransactionId
txid
              ]

      response ←
        sendMessage req auth transactionId roomId replyTo compatHtmlMessage compatMessage $
          Just MessageEdit
            { messageEditMessageId = O.editMessageOptionsMessageId opts
            , messageEditNewText = message
            , messageEditNewHtml = htmlMessage
            }

      logDebug "Printing response and transaction ID to stdout…"

      liftIO . TextIO.putStrLn . toStrict . encodeToLazyText $ SendMessageResponse
        { sendMessageResponseTransactionId = transactionId
        , sendMessageResponseResponse = response
        }

      logInfo "Success!"
  where
    compatTextDefaultTemplate :: a -> a
compatTextDefaultTemplate = (a
"EDIT: " a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)
    compatHtmlDefaultTemplate :: a -> a
compatHtmlDefaultTemplate = (a
"<b>EDIT:</b> " a -> a -> a
forall a. Semigroup a => a -> a -> a
<>)


-- * Types

data BotEnv = BotEnv
  { BotEnv -> Credentials
botEnvCredentials ∷ Auth.Credentials
  , BotEnv -> RetryLimit
botEnvRetryLimit ∷ T.RetryLimit
  , BotEnv -> RetryDelay
botEnvRetryDelay ∷ T.RetryDelay
  , BotEnv -> BotJobsQueue
botEnvJobsQueue ∷ BotJobsQueue.BotJobsQueue
  }

instance Auth.HasCredentials BotEnv where
  credentials :: Lens' BotEnv Credentials
credentials = (BotEnv -> Credentials)
-> (BotEnv -> Credentials -> BotEnv) -> Lens' BotEnv Credentials
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BotEnv -> Credentials
botEnvCredentials ((BotEnv -> Credentials -> BotEnv) -> Lens' BotEnv Credentials)
-> (BotEnv -> Credentials -> BotEnv) -> Lens' BotEnv Credentials
forall a b. (a -> b) -> a -> b
$ \BotEnv
x Credentials
v → BotEnv
x { botEnvCredentials = v }

instance T.HasRetryParams BotEnv where
  retryLimit :: Lens' BotEnv RetryLimit
retryLimit = (BotEnv -> RetryLimit)
-> (BotEnv -> RetryLimit -> BotEnv) -> Lens' BotEnv RetryLimit
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BotEnv -> RetryLimit
botEnvRetryLimit ((BotEnv -> RetryLimit -> BotEnv) -> Lens' BotEnv RetryLimit)
-> (BotEnv -> RetryLimit -> BotEnv) -> Lens' BotEnv RetryLimit
forall a b. (a -> b) -> a -> b
$ \BotEnv
x RetryLimit
v → BotEnv
x { botEnvRetryLimit = v }
  retryDelay :: Lens' BotEnv RetryDelay
retryDelay = (BotEnv -> RetryDelay)
-> (BotEnv -> RetryDelay -> BotEnv) -> Lens' BotEnv RetryDelay
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BotEnv -> RetryDelay
botEnvRetryDelay ((BotEnv -> RetryDelay -> BotEnv) -> Lens' BotEnv RetryDelay)
-> (BotEnv -> RetryDelay -> BotEnv) -> Lens' BotEnv RetryDelay
forall a b. (a -> b) -> a -> b
$ \BotEnv
x RetryDelay
v → BotEnv
x { botEnvRetryDelay = v }

instance BotJobsQueue.HasBotJobsReader BotEnv where
  botJobsReader :: Getter BotEnv (STM BotJob)
botJobsReader = (BotEnv -> BotJobsQueue)
-> (BotJobsQueue -> f BotJobsQueue) -> BotEnv -> f BotEnv
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to BotEnv -> BotJobsQueue
botEnvJobsQueue ((BotJobsQueue -> f BotJobsQueue) -> BotEnv -> f BotEnv)
-> ((STM BotJob -> f (STM BotJob))
    -> BotJobsQueue -> f BotJobsQueue)
-> (STM BotJob -> f (STM BotJob))
-> BotEnv
-> f BotEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (STM BotJob -> f (STM BotJob)) -> BotJobsQueue -> f BotJobsQueue
forall r. HasBotJobsReader r => Getter r (STM BotJob)
Getter BotJobsQueue (STM BotJob)
BotJobsQueue.botJobsReader

instance BotJobsQueue.HasBotJobsWriter BotEnv where
  botJobsWriter :: Getter BotEnv (BotJob -> STM ())
botJobsWriter = (BotEnv -> BotJobsQueue)
-> (BotJobsQueue -> f BotJobsQueue) -> BotEnv -> f BotEnv
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to BotEnv -> BotJobsQueue
botEnvJobsQueue ((BotJobsQueue -> f BotJobsQueue) -> BotEnv -> f BotEnv)
-> (((BotJob -> STM ()) -> f (BotJob -> STM ()))
    -> BotJobsQueue -> f BotJobsQueue)
-> ((BotJob -> STM ()) -> f (BotJob -> STM ()))
-> BotEnv
-> f BotEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((BotJob -> STM ()) -> f (BotJob -> STM ()))
-> BotJobsQueue -> f BotJobsQueue
forall r. HasBotJobsWriter r => Getter r (BotJob -> STM ())
Getter BotJobsQueue (BotJob -> STM ())
BotJobsQueue.botJobsWriter


data SendMessageResponse = SendMessageResponse
  { SendMessageResponse -> TransactionId
sendMessageResponseTransactionId ∷ T.TransactionId
  , SendMessageResponse -> EventResponse
sendMessageResponseResponse ∷ EventResponse
  }
  deriving stock ((forall x. SendMessageResponse -> Rep SendMessageResponse x)
-> (forall x. Rep SendMessageResponse x -> SendMessageResponse)
-> Generic SendMessageResponse
forall x. Rep SendMessageResponse x -> SendMessageResponse
forall x. SendMessageResponse -> Rep SendMessageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendMessageResponse -> Rep SendMessageResponse x
from :: forall x. SendMessageResponse -> Rep SendMessageResponse x
$cto :: forall x. Rep SendMessageResponse x -> SendMessageResponse
to :: forall x. Rep SendMessageResponse x -> SendMessageResponse
Generic, SendMessageResponse -> SendMessageResponse -> Bool
(SendMessageResponse -> SendMessageResponse -> Bool)
-> (SendMessageResponse -> SendMessageResponse -> Bool)
-> Eq SendMessageResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SendMessageResponse -> SendMessageResponse -> Bool
== :: SendMessageResponse -> SendMessageResponse -> Bool
$c/= :: SendMessageResponse -> SendMessageResponse -> Bool
/= :: SendMessageResponse -> SendMessageResponse -> Bool
Eq, Int -> SendMessageResponse -> String -> String
[SendMessageResponse] -> String -> String
SendMessageResponse -> String
(Int -> SendMessageResponse -> String -> String)
-> (SendMessageResponse -> String)
-> ([SendMessageResponse] -> String -> String)
-> Show SendMessageResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SendMessageResponse -> String -> String
showsPrec :: Int -> SendMessageResponse -> String -> String
$cshow :: SendMessageResponse -> String
show :: SendMessageResponse -> String
$cshowList :: [SendMessageResponse] -> String -> String
showList :: [SendMessageResponse] -> String -> String
Show)

instance ToJSON SendMessageResponse where toJSON :: SendMessageResponse -> Value
toJSON = SendMessageResponse -> Value
forall a.
(Generic a, Typeable a, GToJSON' Value Zero (Rep a)) =>
a -> Value
myGenericToJSON
instance FromJSON SendMessageResponse where parseJSON :: Value -> Parser SendMessageResponse
parseJSON = Value -> Parser SendMessageResponse
forall a.
(Generic a, Typeable a, GFromJSON Zero (Rep a)) =>
Value -> Parser a
myGenericParseJSON


-- * Helpers

-- | Wrap a string into quotes
quoted ∷ (IsString s, Show s) ⇒ s → Text
quoted :: forall s. (IsString s, Show s) => s -> Text
quoted = String -> Text
pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show