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

module MatrixBot.Bot.Jobs.Handlers.SendMessage
  ( sendMessage
  , MessageEdit (..)
  ) where

import qualified Control.Exception.Safe as E
import Control.Monad.IO.Class (MonadIO)
import qualified Control.Monad.Logger as ML
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text, pack)
import MatrixBot.Bot.Jobs.Log (logEventResponse)
import qualified MatrixBot.Log as L
import qualified MatrixBot.MatrixApi as Api
import qualified MatrixBot.MatrixApi.Client as Api
import qualified MatrixBot.MatrixApi.Types.MEventTypes as Api
import qualified MatrixBot.SharedTypes as T
import Servant.API (AuthProtect)
import Servant.Client.Core (AuthenticatedRequest)


-- | Send a text message to a Matrix room
sendMessage
  ∷ (MonadIO m, MonadFail m, E.MonadThrow m, ML.MonadLogger m)
  ⇒ Api.MatrixApiClient
  → AuthenticatedRequest (AuthProtect "access-token")
  → T.TransactionId
  → T.RoomId
  → Maybe T.EventId
  -- ^ Reply to event
  → Maybe Text
  -- ^ Optional HTML-formatted body to be paired with plain text body
  → Text
  → Maybe MessageEdit
  → m Api.EventResponse
sendMessage :: forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadThrow m, MonadLogger m) =>
MatrixApiClient
-> AuthenticatedRequest (AuthProtect "access-token")
-> TransactionId
-> RoomId
-> Maybe EventId
-> Maybe Text
-> Text
-> Maybe MessageEdit
-> m EventResponse
sendMessage MatrixApiClient
req AuthenticatedRequest (AuthProtect "access-token")
auth TransactionId
transactionId RoomId
roomId Maybe EventId
inReplyTo Maybe Text
htmlBody Text
msg Maybe MessageEdit
msgEdit = do
  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
"Sending message "
    , Text -> (EventId -> Text) -> Maybe EventId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty ((Text
"in reply to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (EventId -> Text) -> EventId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") (Text -> Text) -> (EventId -> Text) -> EventId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) Maybe EventId
inReplyTo
    , (String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) Text
msg
    , Text
" to room "
    , (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
"…"
    ]

  EventResponse
response ←
    let proxy :: Proxy (SendEventApi (MEventTypeOneOf '[ 'MRoomMessageType]))
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Api.SendEventApi (Api.MEventTypeOneOf '[ 'Api.MRoomMessageType ])) in
    MatrixApiClient
-> forall api (m :: * -> *) a.
   (MonadIO m, MonadFail m, Show a, MonadThrow m, MonadLogger m,
    HasClient (Free ClientF) api, HasClient ClientM api) =>
   Proxy api
   -> (forall (clientM :: * -> *).
       HasClient clientM api =>
       Client clientM api -> clientM a)
   -> m a
Api.runMatrixApiClient' MatrixApiClient
req Proxy
  (ClientV3
     (Authenticated
        ("rooms"
         :> (Capture "roomId" RoomId
             :> ("send"
                 :> (Capture "eventType" (MEventTypeOneOf '[ 'MRoomMessageType])
                     :> (Capture "txnId" TransactionId
                         :> (ReqBody '[JSON] MRoomMessageContent
                             :> Put '[JSON] EventResponse))))))))
proxy ((forall {clientM :: * -> *}.
  HasClient
    clientM
    (ClientV3
       (Authenticated
          ("rooms"
           :> (Capture "roomId" RoomId
               :> ("send"
                   :> (Capture "eventType" (MEventTypeOneOf '[ 'MRoomMessageType])
                       :> (Capture "txnId" TransactionId
                           :> (ReqBody '[JSON] MRoomMessageContent
                               :> Put '[JSON] EventResponse)))))))) =>
  Client
    clientM
    (ClientV3
       (Authenticated
          ("rooms"
           :> (Capture "roomId" RoomId
               :> ("send"
                   :> (Capture "eventType" (MEventTypeOneOf '[ 'MRoomMessageType])
                       :> (Capture "txnId" TransactionId
                           :> (ReqBody '[JSON] MRoomMessageContent
                               :> Put '[JSON] EventResponse))))))))
  -> clientM EventResponse)
 -> m EventResponse)
-> (forall {clientM :: * -> *}.
    HasClient
      clientM
      (ClientV3
         (Authenticated
            ("rooms"
             :> (Capture "roomId" RoomId
                 :> ("send"
                     :> (Capture "eventType" (MEventTypeOneOf '[ 'MRoomMessageType])
                         :> (Capture "txnId" TransactionId
                             :> (ReqBody '[JSON] MRoomMessageContent
                                 :> Put '[JSON] EventResponse)))))))) =>
    Client
      clientM
      (ClientV3
         (Authenticated
            ("rooms"
             :> (Capture "roomId" RoomId
                 :> ("send"
                     :> (Capture "eventType" (MEventTypeOneOf '[ 'MRoomMessageType])
                         :> (Capture "txnId" TransactionId
                             :> (ReqBody '[JSON] MRoomMessageContent
                                 :> Put '[JSON] EventResponse))))))))
    -> clientM EventResponse)
-> m EventResponse
forall a b. (a -> b) -> a -> b
$ \Client
  clientM
  (ClientV3
     (Authenticated
        ("rooms"
         :> (Capture "roomId" RoomId
             :> ("send"
                 :> (Capture "eventType" (MEventTypeOneOf '[ 'MRoomMessageType])
                     :> (Capture "txnId" TransactionId
                         :> (ReqBody '[JSON] MRoomMessageContent
                             :> Put '[JSON] EventResponse))))))))
f → Client
  clientM
  (ClientV3
     (Authenticated
        ("rooms"
         :> (Capture "roomId" RoomId
             :> ("send"
                 :> (Capture "eventType" (MEventTypeOneOf '[ 'MRoomMessageType])
                     :> (Capture "txnId" TransactionId
                         :> (ReqBody '[JSON] MRoomMessageContent
                             :> Put '[JSON] EventResponse))))))))
AuthenticatedRequest (AuthProtect "access-token")
-> RoomId
-> MEventTypeOneOf '[ 'MRoomMessageType]
-> TransactionId
-> MRoomMessageContent
-> clientM EventResponse
f
      AuthenticatedRequest (AuthProtect "access-token")
auth
      RoomId
roomId
      MEventTypeOneOf '[ 'MRoomMessageType]
forall (types :: [MEventType]).
(OneOf 'MRoomMessageType types ~ 'True) =>
MEventTypeOneOf types
Api.MRoomMessageTypeOneOf
      TransactionId
transactionId
      MRoomMessageContent
messageContent

  EventResponse
response EventResponse -> m () -> m EventResponse
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventResponse -> m ()
forall (m :: * -> *). MonadLogger m => EventResponse -> m ()
logEventResponse EventResponse
response

  where
    messageContent :: MRoomMessageContent
messageContent =
      MTextType
-> Text
-> Maybe Text
-> Maybe InReplyTo
-> Maybe MessageEdit
-> MRoomMessageContent
Api.MRoomMessageContent
        MTextType
Api.MTextType
        Text
msg
        Maybe Text
htmlBody
        ((EventId -> InReplyTo) -> Maybe EventId -> Maybe InReplyTo
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventId -> InReplyTo
Api.InReplyTo Maybe EventId
inReplyTo)
        ((MessageEdit -> MessageEdit)
-> Maybe MessageEdit -> Maybe MessageEdit
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MessageEdit -> MessageEdit
toEditApi Maybe MessageEdit
msgEdit)

    toEditApi :: MessageEdit -> MessageEdit
toEditApi (MessageEdit
x ∷ MessageEdit) =
      MTextType -> Text -> Maybe Text -> EventId -> MessageEdit
Api.MessageEdit
        MTextType
Api.MTextType
        MessageEdit
x.messageEditNewText
        MessageEdit
x.messageEditNewHtml
        MessageEdit
x.messageEditMessageId


data MessageEdit = MessageEdit
  { MessageEdit -> EventId
messageEditMessageId ∷ T.EventId
  , MessageEdit -> Text
messageEditNewText ∷ Text
  , MessageEdit -> Maybe Text
messageEditNewHtml ∷ Maybe Text
  }
  deriving stock (Int -> MessageEdit -> ShowS
[MessageEdit] -> ShowS
MessageEdit -> String
(Int -> MessageEdit -> ShowS)
-> (MessageEdit -> String)
-> ([MessageEdit] -> ShowS)
-> Show MessageEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageEdit -> ShowS
showsPrec :: Int -> MessageEdit -> ShowS
$cshow :: MessageEdit -> String
show :: MessageEdit -> String
$cshowList :: [MessageEdit] -> ShowS
showList :: [MessageEdit] -> ShowS
Show, MessageEdit -> MessageEdit -> Bool
(MessageEdit -> MessageEdit -> Bool)
-> (MessageEdit -> MessageEdit -> Bool) -> Eq MessageEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageEdit -> MessageEdit -> Bool
== :: MessageEdit -> MessageEdit -> Bool
$c/= :: MessageEdit -> MessageEdit -> Bool
/= :: MessageEdit -> MessageEdit -> Bool
Eq)