{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

module MatrixBot.Bot
  ( startTheBot
  , withReqAndAuth
  ) where

import Data.Functor
import Data.Text (pack)
import Control.Monad ()
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.IO.Unlift (MonadUnliftIO)
import qualified Control.Exception.Safe as E
import qualified Control.Lens as L
import qualified Control.Monad.Logger as ML
import qualified Control.Monad.Reader as MR
import qualified UnliftIO.Async as Async
import qualified UnliftIO.Concurrent as Async
import Servant.API (AuthProtect)
import Servant.Client.Core (AuthenticatedRequest)
import qualified MatrixBot.Log as L
import qualified MatrixBot.Auth as Auth
import qualified MatrixBot.MatrixApi.Client as Api
import qualified MatrixBot.SharedTypes as T
import qualified MatrixBot.Bot.BotConfig as BotConfig
import MatrixBot.Bot.BotM (BotM)
import MatrixBot.Bot.SmokeTest (startupSmokeTest)
import MatrixBot.Bot.Jobs.Handlers.MainHandler (jobsHandler)
import MatrixBot.Bot.EventsListener (eventsListener)
import MatrixBot.Bot.Jobs.Queue (HasBotJobsReader, HasBotJobsWriter)


startTheBot ∷ (BotM r m, HasBotJobsReader r, HasBotJobsWriter r) ⇒ Maybe FilePath → T.EventsTimeout → BotConfig.BotConfig → m ()
startTheBot :: forall r (m :: * -> *).
(BotM r m, HasBotJobsReader r, HasBotJobsWriter r) =>
Maybe FilePath -> EventsTimeout -> BotConfig -> m ()
startTheBot Maybe FilePath
eventTokenFile EventsTimeout
eventsTimeout BotConfig
botConfig = do
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug Text
"Starting the bot…"
  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Bot configuration: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
pack (FilePath -> Text) -> (BotConfig -> FilePath) -> BotConfig -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotConfig -> FilePath
forall a. Show a => a -> FilePath
show) BotConfig
botConfig

  EventsTimeout
-> (MatrixApiClient
    -> AuthenticatedRequest (AuthProtect "access-token") -> m ())
-> m ()
forall (m :: * -> *) r a.
(MonadIO m, MonadUnliftIO m, MonadThrow m, MonadLogger m,
 MonadReader r m, HasCredentials r) =>
EventsTimeout
-> (MatrixApiClient
    -> AuthenticatedRequest (AuthProtect "access-token") -> m a)
-> m a
withReqAndAuth EventsTimeout
eventsTimeout ((MatrixApiClient
  -> AuthenticatedRequest (AuthProtect "access-token") -> m ())
 -> m ())
-> (MatrixApiClient
    -> AuthenticatedRequest (AuthProtect "access-token") -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth → do
    MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token") -> m ()
forall r (m :: * -> *).
BotM r m =>
MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token") -> m ()
startupSmokeTest MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth

    Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug Text
"Running bot threads (jobs queue handler and room events listener)…"

    let
      jobsHandler' :: m ()
jobsHandler' = MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token") -> m ()
forall r (m :: * -> *).
(BotM r m, HasBotJobsReader r) =>
MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token") -> m ()
jobsHandler MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth
      eventsListener' :: m ()
eventsListener' = Maybe FilePath
-> EventsTimeout
-> BotConfig
-> MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token")
-> m ()
forall r (m :: * -> *).
(BotM r m, HasBotJobsWriter r) =>
Maybe FilePath
-> EventsTimeout
-> BotConfig
-> MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token")
-> m ()
eventsListener Maybe FilePath
eventTokenFile EventsTimeout
eventsTimeout BotConfig
botConfig MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth

    -- Start 2 threads in parallel.
    -- One would read new Matrix room events and react to them if necessary
    -- (as defined in the Bot config, following all the filters) by adding
    -- new Bot Jobs. Meanwhile Bot Jobs handler will perform actions by hanlding
    -- the jobs from the queue.
    m Any -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Any -> m ())
-> (Concurrently m Any -> m Any) -> Concurrently m Any -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concurrently m Any -> m Any
forall (m :: * -> *) a. Concurrently m a -> m a
Async.runConcurrently
      (Concurrently m Any -> m ()) -> Concurrently m Any -> m ()
forall a b. (a -> b) -> a -> b
$ m Any -> Concurrently m Any
forall (m :: * -> *) a. m a -> Concurrently m a
Async.Concurrently (m () -> m Any
forall {a}. m () -> m a
threadWrap m ()
jobsHandler')
      Concurrently m Any -> Concurrently m Any -> Concurrently m Any
forall a b.
Concurrently m a -> Concurrently m b -> Concurrently m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m Any -> Concurrently m Any
forall (m :: * -> *) a. m a -> Concurrently m a
Async.Concurrently (m () -> m Any
forall {a}. m () -> m a
threadWrap m ()
eventsListener')

  where
    logThreadFailure :: m a -> m a
logThreadFailure =
      (m a -> (SomeException -> m ()) -> m a)
-> (SomeException -> m ()) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (SomeException -> m ()) -> m a
forall (m :: * -> *) e a b.
(HasCallStack, MonadMask m, Exception e) =>
m a -> (e -> m b) -> m a
E.withException ((SomeException -> m ()) -> m a -> m a)
-> (SomeException -> m ()) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \(SomeException
e ∷ E.SomeException) →
        Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"The thread has failed with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
pack (FilePath -> Text)
-> (SomeException -> FilePath) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> FilePath
forall e. Exception e => e -> FilePath
E.displayException) SomeException
e

    threadWrap :: m () -> m a
threadWrap m ()
m = m a -> m a
forall {a}. m a -> m a
logThreadFailure (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ m ()
m m () -> (() -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \() → do
      ThreadId
tid ← IO ThreadId -> m ThreadId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
forall (m :: * -> *). MonadIO m => m ThreadId
Async.myThreadId
      FilePath -> m a
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$ FilePath
"Thread " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ThreadId -> FilePath
forall a. Show a => a -> FilePath
show ThreadId
tid FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" has unexpectedly finished"


-- | Run a monad supplied via arguments with Matrix API HTTP request maker and authentication
withReqAndAuth
  ∷
  ( MonadIO m
  , MonadUnliftIO m
  , E.MonadThrow m
  , ML.MonadLogger m
  , MR.MonadReader r m
  , Auth.HasCredentials r
  )
  ⇒ T.EventsTimeout
  → (Api.MatrixApiClient → AuthenticatedRequest (AuthProtect "access-token") → m a)
  → m a
withReqAndAuth :: forall (m :: * -> *) r a.
(MonadIO m, MonadUnliftIO m, MonadThrow m, MonadLogger m,
 MonadReader r m, HasCredentials r) =>
EventsTimeout
-> (MatrixApiClient
    -> AuthenticatedRequest (AuthProtect "access-token") -> m a)
-> m a
withReqAndAuth EventsTimeout
eventsTimeout MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token") -> m a
m = do
  Credentials
credentials ← (r -> Credentials) -> m Credentials
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
MR.asks ((r -> Credentials) -> m Credentials)
-> (r -> Credentials) -> m Credentials
forall a b. (a -> b) -> a -> b
$ Getting Credentials r Credentials -> r -> Credentials
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
L.view Getting Credentials r Credentials
forall r. HasCredentials r => Lens' r Credentials
Lens' r Credentials
Auth.credentials

  Text -> m ()
forall (m :: * -> *). (MonadLogger m, HasCallStack) => Text -> m ()
L.logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
"Creating request handler for "
    , FilePath -> Text
pack (FilePath -> Text)
-> (Credentials -> FilePath) -> Credentials -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. Show a => a -> FilePath
show (Text -> FilePath)
-> (Credentials -> Text) -> Credentials -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeServer -> Text
T.unHomeServer (HomeServer -> Text)
-> (Credentials -> HomeServer) -> Credentials -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credentials -> HomeServer
Auth.credentialsHomeServer (Credentials -> Text) -> Credentials -> Text
forall a b. (a -> b) -> a -> b
$ Credentials
credentials
    , Text
"…"
    ]

  MatrixApiClient
req ←
    let
      opts :: RequestOptions
opts = RequestOptions
Api.defaultRequestOptions
        { Api.requestOptionsTimeout
            = Just
            . T.Seconds
            . round @Rational @Integer
            . (* 1.5) -- Some headroom for network delays in order to avoid timeout exceptions
            . fromInteger @Rational
            . T.unSeconds
            . T.unEventsTimeout
            $ eventsTimeout
        }
    in
      RequestOptions -> HomeServer -> m MatrixApiClient
forall (m :: * -> *).
(MonadIO m, MonadThrow m, MonadLogger m) =>
RequestOptions -> HomeServer -> m MatrixApiClient
Api.mkMatrixApiClient RequestOptions
opts (HomeServer -> m MatrixApiClient)
-> (Credentials -> HomeServer) -> Credentials -> m MatrixApiClient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credentials -> HomeServer
Auth.credentialsHomeServer (Credentials -> m MatrixApiClient)
-> Credentials -> m MatrixApiClient
forall a b. (a -> b) -> a -> b
$ Credentials
credentials

  AuthenticatedRequest (AuthProtect "access-token")
auth ← m (AuthenticatedRequest (AuthProtect "access-token"))
forall r (m :: * -> *).
(MonadReader r m, HasCredentials r) =>
m (AuthenticatedRequest (AuthProtect "access-token"))
Auth.getAuthenticatedMatrixRequest
  MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token") -> m a
m MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth