module Matterhorn.Events
  ( onEvent
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import qualified Data.Text as T
import           GHC.Exception ( fromException )
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( (.=), _2, singular, _Just )
import qualified System.IO.Error as IO

import qualified Network.Mattermost.Types as MM
import qualified Network.Mattermost.Endpoints as MM
import           Network.Mattermost.Exceptions ( mattermostErrorMessage )

import           Matterhorn.Connection
import           Matterhorn.Constants ( userSigil, normalChannelSigil )
import           Matterhorn.HelpTopics
import           Matterhorn.State.ChannelList
import           Matterhorn.State.Channels
import           Matterhorn.State.Common
import           Matterhorn.State.Messages
import           Matterhorn.Types

import           Matterhorn.Events.ChannelSelect
import           Matterhorn.Events.ChannelTopicWindow
import           Matterhorn.Events.DeleteChannelConfirm
import           Matterhorn.Events.Global
import           Matterhorn.Events.LeaveChannelConfirm
import           Matterhorn.Events.Main
import           Matterhorn.Events.MessageSelect
import           Matterhorn.Events.ThemeListWindow
import           Matterhorn.Events.PostListWindow
import           Matterhorn.Events.ShowHelp
import           Matterhorn.Events.UserListWindow
import           Matterhorn.Events.ChannelListWindow
import           Matterhorn.Events.ReactionEmojiListWindow
import           Matterhorn.Events.TabbedWindow
import           Matterhorn.Events.Mouse
import           Matterhorn.Events.EditNotifyPrefs
import           Matterhorn.Events.Websocket

onEvent :: BrickEvent Name MHEvent -> EventM Name ChatState ()
onEvent :: BrickEvent Name MHEvent -> EventM Name ChatState ()
onEvent BrickEvent Name MHEvent
ev = MH () -> EventM Name ChatState ()
runMHEvent forall a b. (a -> b) -> a -> b
$ do
    BrickEvent Name MHEvent -> MH ()
onBrickEvent BrickEvent Name MHEvent
ev
    MH ()
doPendingUserFetches
    MH ()
doPendingUserStatusFetches

onBrickEvent :: BrickEvent Name MHEvent -> MH ()
onBrickEvent :: BrickEvent Name MHEvent -> MH ()
onBrickEvent (AppEvent MHEvent
e) =
    MHEvent -> MH ()
onAppEvent MHEvent
e
onBrickEvent (VtyEvent (Vty.EvKey (Vty.KChar Char
'l') [Modifier
Vty.MCtrl])) = do
    Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    Vty
vty <- forall a. EventM Name ChatState a -> MH a
mh forall n s. EventM n s Vty
getVtyHandle
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Vty -> IO ()
Vty.refresh Vty
vty
onBrickEvent (VtyEvent Event
e) = do
    Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    Event -> MH ()
onVtyEvent Event
e
onBrickEvent e :: BrickEvent Name MHEvent
e@(MouseDown Name
n Button
_ [Modifier]
_ Location
_) = do
    Maybe (BrickEvent Name MHEvent)
lastClick <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent
    let shouldHandle :: Bool
shouldHandle = case Maybe (BrickEvent Name MHEvent)
lastClick of
            Maybe (BrickEvent Name MHEvent)
Nothing -> Bool
True
            Just (MouseDown Name
prevN Button
_ [Modifier]
_ Location
_) -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Name
prevN forall a. SemEq a => a -> a -> Bool
`semeq` Name
n
            Maybe (BrickEvent Name MHEvent)
_ -> Bool
False
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldHandle forall a b. (a -> b) -> a -> b
$ do
        Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just BrickEvent Name MHEvent
e
        (TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
            Mode
mode <- TeamId -> MH Mode
getTeamMode TeamId
tId
            TeamId -> Mode -> BrickEvent Name MHEvent -> MH ()
mouseHandlerByMode TeamId
tId Mode
mode BrickEvent Name MHEvent
e
onBrickEvent (MouseUp {}) = do
    Lens' ChatState (Maybe (BrickEvent Name MHEvent))
csLastMouseDownEvent forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    MH ()
mhContinueWithoutRedraw

onAppEvent :: MHEvent -> MH ()
onAppEvent :: MHEvent -> MH ()
onAppEvent MHEvent
RefreshWebsocketEvent =
    MH ()
connectWebsockets
onAppEvent MHEvent
WebsocketDisconnect = do
    Lens' ChatState ConnectionStatus
csConnectionStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ConnectionStatus
Disconnected
    MH ()
disconnectChannels
onAppEvent MHEvent
WebsocketConnect = do
    Lens' ChatState ConnectionStatus
csConnectionStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ConnectionStatus
Connected
    MH ()
refreshChannelsAndUsers
    MH ()
refreshClientConfig
    (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
fetchVisibleIfNeeded
onAppEvent (RateLimitExceeded Int
winSz) =
    MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        let s :: String
s = if Int
winSz forall a. Eq a => a -> a -> Bool
== Int
1 then String
"" else String
"s"
        in String
"The server's API request rate limit was exceeded; Matterhorn will " forall a. Semigroup a => a -> a -> a
<>
           String
"retry the failed request in " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
winSz forall a. Semigroup a => a -> a -> a
<> String
" second" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<>
           String
". Please contact your Mattermost administrator " forall a. Semigroup a => a -> a -> a
<>
           String
"about API rate limiting issues."
onAppEvent MHEvent
RateLimitSettingsMissing =
    MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError forall a b. (a -> b) -> a -> b
$
        Text
"A request was rate-limited but could not be retried due to rate " forall a. Semigroup a => a -> a -> a
<>
        Text
"limit settings missing"
onAppEvent MHEvent
RequestDropped =
    MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError forall a b. (a -> b) -> a -> b
$
        Text
"An API request was retried and dropped due to a rate limit. Matterhorn " forall a. Semigroup a => a -> a -> a
<>
        Text
"may now be inconsistent with the server. Please contact your " forall a. Semigroup a => a -> a -> a
<>
        Text
"Mattermost administrator about API rate limiting issues."
onAppEvent MHEvent
BGIdle =
    Lens' ChatState (Maybe (Maybe Int))
csWorkerIsBusy forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
onAppEvent (BGBusy Maybe Int
n) =
    Lens' ChatState (Maybe (Maybe Int))
csWorkerIsBusy forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Maybe Int
n
onAppEvent (WSEvent WebsocketEvent
we) =
    WebsocketEvent -> MH ()
handleWebsocketEvent WebsocketEvent
we
onAppEvent (WSActionResponse WebsocketActionResponse
r) =
    WebsocketActionResponse -> MH ()
handleWebsocketActionResponse WebsocketActionResponse
r
onAppEvent (RespEvent MH ()
f) = MH ()
f
onAppEvent (WebsocketParseError String
e) = do
    let msg :: Text
msg = Text
"A websocket message could not be parsed:\n  " forall a. Semigroup a => a -> a -> a
<>
              String -> Text
T.pack String
e forall a. Semigroup a => a -> a -> a
<>
              Text
"\nPlease report this error at https://github.com/matterhorn-chat/matterhorn/issues"
    MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
msg
onAppEvent (IEvent InternalEvent
e) = do
    InternalEvent -> MH ()
handleIEvent InternalEvent
e

handleIEvent :: InternalEvent -> MH ()
handleIEvent :: InternalEvent -> MH ()
handleIEvent (DisplayError MHError
e) =
    Text -> MH ()
postErrorMessage' forall a b. (a -> b) -> a -> b
$ MHError -> Text
formatMHError MHError
e
handleIEvent (LoggingStarted String
path) =
    Text -> MH ()
postInfoMessage forall a b. (a -> b) -> a -> b
$ Text
"Logging to " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path
handleIEvent (LogDestination Maybe String
dest) =
    case Maybe String
dest of
        Maybe String
Nothing ->
            Text -> MH ()
postInfoMessage Text
"Logging is currently disabled. Enable it with /log-start."
        Just String
path ->
            Text -> MH ()
postInfoMessage forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Logging to " forall a. Semigroup a => a -> a -> a
<> String
path
handleIEvent (LogSnapshotSucceeded String
path) =
    Text -> MH ()
postInfoMessage forall a b. (a -> b) -> a -> b
$ Text
"Log snapshot written to " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path
handleIEvent (LoggingStopped String
path) =
    Text -> MH ()
postInfoMessage forall a b. (a -> b) -> a -> b
$ Text
"Stopped logging to " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path
handleIEvent (LogStartFailed String
path String
err) =
    Text -> MH ()
postErrorMessage' forall a b. (a -> b) -> a -> b
$ Text
"Could not start logging to " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path forall a. Semigroup a => a -> a -> a
<>
                        Text
", error: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
handleIEvent (LogSnapshotFailed String
path String
err) =
    Text -> MH ()
postErrorMessage' forall a b. (a -> b) -> a -> b
$ Text
"Could not write log snapshot to " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path forall a. Semigroup a => a -> a -> a
<>
                        Text
", error: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err

formatMHError :: MHError -> T.Text
formatMHError :: MHError -> Text
formatMHError (GenericError Text
msg) =
    Text
msg
formatMHError (NoSuchChannel Text
chan) =
    String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"No such channel: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
chan
formatMHError (NoSuchUser Text
user) =
    String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"No such user: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
user
formatMHError (AmbiguousName Text
name) =
    (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"The input " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
name forall a. Semigroup a => a -> a -> a
<> String
" matches both channels ") forall a. Semigroup a => a -> a -> a
<>
    Text
"and users. Try using '" forall a. Semigroup a => a -> a -> a
<> Text
userSigil forall a. Semigroup a => a -> a -> a
<> Text
"' or '" forall a. Semigroup a => a -> a -> a
<>
    Text
normalChannelSigil forall a. Semigroup a => a -> a -> a
<> Text
"' to disambiguate."
formatMHError (ServerError MattermostError
e) =
    MattermostError -> Text
mattermostErrorMessage MattermostError
e
formatMHError (ClipboardError Text
msg) =
    Text
msg
formatMHError (ConfigOptionMissing Text
opt) =
    String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Config option " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
opt forall a. Semigroup a => a -> a -> a
<> String
" missing"
formatMHError (ProgramExecutionFailed Text
progName Text
logPath) =
    String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"An error occurred when running " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
progName forall a. Semigroup a => a -> a -> a
<>
             String
"; see " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
logPath forall a. Semigroup a => a -> a -> a
<> String
" for details."
formatMHError (NoSuchScript Text
name) =
    Text
"No script named " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
" was found"
formatMHError (NoSuchHelpTopic Text
topic) =
    let knownTopics :: [Text]
knownTopics = (Text
"  - " forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HelpTopic -> Text
helpTopicName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HelpTopic]
helpTopics
    in Text
"Unknown help topic: `" forall a. Semigroup a => a -> a -> a
<> Text
topic forall a. Semigroup a => a -> a -> a
<> Text
"`. " forall a. Semigroup a => a -> a -> a
<>
       ([Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ Text
"Available topics are:" forall a. a -> [a] -> [a]
: [Text]
knownTopics)
formatMHError (AttachmentException SomeException
e) =
    case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
      Just (IOError
ioe :: IO.IOError) ->
          if IOError -> Bool
IO.isDoesNotExistError IOError
ioe
          then Text
"Error attaching, file does not exist!"
          else if IOError -> Bool
IO.isPermissionError IOError
ioe
               then Text
"Error attaching, lacking permissions to read file!"
               else Text
"Unable to attach the requested file.  Check that it exists and has proper permissions."
      Maybe IOError
Nothing -> Text
"Unknown error attaching file!\n" forall a. Semigroup a => a -> a -> a
<>
          Text
"Please report this error at https://github.com/matterhorn-chat/matterhorn/issues"
          -- this case shouldn't be reached
formatMHError (BadAttachmentPath Text
msg) =
    Text
msg
formatMHError (AsyncErrEvent SomeException
e) =
    Text
"An unexpected error has occurred! The exception encountered was:\n  " forall a. Semigroup a => a -> a -> a
<>
    String -> Text
T.pack (forall a. Show a => a -> String
show SomeException
e) forall a. Semigroup a => a -> a -> a
<>
    Text
"\nPlease report this error at https://github.com/matterhorn-chat/matterhorn/issues"

onVtyEvent :: Vty.Event -> MH ()
onVtyEvent :: Event -> MH ()
onVtyEvent =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [Event -> MH Bool] -> Event -> MH Bool
handleEventWith [ Event -> MH Bool
handleResizeEvent
                    , (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
globalKeybindings
                    , Event -> MH Bool
handleTeamModeEvent
                    ]

handleResizeEvent :: Vty.Event -> MH Bool
handleResizeEvent :: Event -> MH Bool
handleResizeEvent (Vty.EvResize Int
_ Int
_) = do
    -- On resize, invalidate the entire rendering cache since many
    -- things depend on the window size.
    --
    -- Note: we fall through after this because it is sometimes
    -- important for modes to have their own additional logic to run
    -- when a resize occurs, so we don't want to stop processing here.
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
    (TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
        forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
makeVisible forall a b. (a -> b) -> a -> b
$ TeamId -> Name
SelectedChannelListEntry TeamId
tId

    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
handleResizeEvent Event
_ =
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

handleTeamModeEvent :: Vty.Event -> MH Bool
handleTeamModeEvent :: Event -> MH Bool
handleTeamModeEvent Event
e = do
    (TeamId -> MH ()) -> MH ()
withCurrentTeam forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
        Mode
mode <- TeamId -> MH Mode
getTeamMode TeamId
tId
        TeamId -> Mode -> Event -> MH ()
teamEventHandlerByMode TeamId
tId Mode
mode Event
e
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

teamEventHandlerByMode :: MM.TeamId -> Mode -> Vty.Event -> MH ()
teamEventHandlerByMode :: TeamId -> Mode -> Event -> MH ()
teamEventHandlerByMode TeamId
tId Mode
mode Event
e =
    case Mode
mode of
        Mode
Main                       -> TeamId -> Event -> MH ()
onEventMain TeamId
tId Event
e
        ShowHelp HelpTopic
_                 -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ TeamId -> Event -> MH Bool
onEventShowHelp TeamId
tId Event
e
        Mode
ChannelSelect              -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ TeamId -> Event -> MH ()
onEventChannelSelect TeamId
tId Event
e
        Mode
LeaveChannelConfirm        -> TeamId -> Event -> MH ()
onEventLeaveChannelConfirm TeamId
tId Event
e
        MessageSelectDeleteConfirm MessageInterfaceTarget
target ->
            case MessageInterfaceTarget
target of
                MITeamThread TeamId
tmId ->
                    forall i.
TeamId
-> Lens' ChatState (MessageInterface Name i) -> Event -> MH ()
onEventMessageSelectDeleteConfirm TeamId
tId (HasCallStack => TeamId -> Lens' ChatState ThreadInterface
unsafeThreadInterface(TeamId
tmId)) Event
e
                MIChannel ChannelId
cId ->
                    forall i.
TeamId
-> Lens' ChatState (MessageInterface Name i) -> Event -> MH ()
onEventMessageSelectDeleteConfirm TeamId
tId (ChannelId -> Lens' ChatState ChannelMessageInterface
csChannelMessageInterface(ChannelId
cId)) Event
e
        Mode
DeleteChannelConfirm       -> TeamId -> Event -> MH ()
onEventDeleteChannelConfirm TeamId
tId Event
e
        Mode
ThemeListWindow            -> TeamId -> Event -> MH ()
onEventThemeListWindow TeamId
tId Event
e
        PostListWindow PostListContents
_           -> TeamId -> Event -> MH ()
onEventPostListWindow TeamId
tId Event
e
        Mode
UserListWindow             -> TeamId -> Event -> MH ()
onEventUserListWindow TeamId
tId Event
e
        Mode
ChannelListWindow          -> TeamId -> Event -> MH ()
onEventChannelListWindow TeamId
tId Event
e
        Mode
ReactionEmojiListWindow    -> TeamId -> Event -> MH ()
onEventReactionEmojiListWindow TeamId
tId Event
e
        Mode
ViewMessage                -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ (forall a.
(Show a, Eq a) =>
Lens' ChatState (TabbedWindow ChatState MH Name a)
-> TeamId -> Event -> MH Bool
handleTabbedWindowEvent
                                              (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens'
  TeamState
  (Maybe
     (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessageforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2)
                                              TeamId
tId Event
e)
        Mode
EditNotifyPrefs            -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ TeamId -> Event -> MH Bool
onEventEditNotifyPrefs TeamId
tId Event
e
        Mode
ChannelTopicWindow         -> TeamId -> Event -> MH ()
onEventChannelTopicWindow TeamId
tId Event
e

-- | Refresh client-accessible server configuration information. This
-- is usually triggered when a reconnect event for the WebSocket to the
-- server occurs.
refreshClientConfig :: MH ()
refreshClientConfig :: MH ()
refreshClientConfig = do
    Session
session <- MH Session
getSession
    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
        ClientConfig
cfg <- Maybe Text -> Session -> IO ClientConfig
MM.mmGetClientConfiguration (forall a. a -> Maybe a
Just Text
"old") Session
session
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
            Lens' ChatState (Maybe ClientConfig)
csClientConfig forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just ClientConfig
cfg
            Maybe TeamId -> MH ()
updateSidebar forall a. Maybe a
Nothing