From f20d1c409cb65e9792fccf46c1c4e3f140957248 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Apr 2018 13:25:21 -0700 Subject: [PATCH 1/7] Typo --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 905d310b..c7cca237 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,7 @@ This release supports Mattermost server version 4.9. New features: - * Matterhorn now supports activity notifications by ivoking a + * Matterhorn now supports activity notifications by invoking a user-configured external command. The external command is configured with the `activityNotifyCommand` setting. Matterhorn also includes an example notification script for Linux-based systems in the From 6855e245c6ab517877aeee92b35f58af62ebd9f1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Apr 2018 13:31:55 -0700 Subject: [PATCH 2/7] Update use of API library UserText data This change is a no-op change that just introduces calls to unsafeUserText to unwrap UserText values that are now provided by the API library. These values are provided as an alternative to Text to statically indicate an unsanitized input value. --- src/Draw/JoinChannel.hs | 6 +++--- src/Events.hs | 2 +- src/State.hs | 16 ++++++++-------- src/State/Setup.hs | 2 +- src/TeamSelect.hs | 2 +- src/Types.hs | 2 +- src/Types/Channels.hs | 15 ++++++++------- src/Types/Posts.hs | 6 +++--- src/Types/Users.hs | 14 +++++++------- 9 files changed, 33 insertions(+), 32 deletions(-) diff --git a/src/Draw/JoinChannel.hs b/src/Draw/JoinChannel.hs index d1e5e919..f02f50cf 100644 --- a/src/Draw/JoinChannel.hs +++ b/src/Draw/JoinChannel.hs @@ -17,7 +17,7 @@ import Text.Wrap ( defaultWrapSettings, preserveIndentation ) import Network.Mattermost.Lenses ( channelDisplayNameL , channelNameL , channelPurposeL ) -import Network.Mattermost.Types ( Channel ) +import Network.Mattermost.Types ( Channel, unsafeUserText ) import Draw.Main import Themes @@ -49,7 +49,7 @@ joinChannelBox st = renderJoinListItem :: Bool -> Channel -> Widget Name renderJoinListItem _ chan = - let baseStr = chan^.channelNameL <> " (" <> chan^.channelDisplayNameL <> ")" - s = " " <> (T.strip $ chan^.channelPurposeL) + let baseStr = (unsafeUserText $ chan^.channelNameL) <> " (" <> (unsafeUserText $ chan^.channelDisplayNameL) <> ")" + s = " " <> (T.strip $ unsafeUserText $ chan^.channelPurposeL) in (vLimit 1 $ padRight Max $ txt baseStr) <=> (vLimit 1 $ txtWrapWith (defaultWrapSettings { preserveIndentation = True }) s) diff --git a/src/Events.hs b/src/Events.hs index fb21851b..30d0e265 100644 --- a/src/Events.hs +++ b/src/Events.hs @@ -200,7 +200,7 @@ handleWSEvent we = do -- shortcuts, but it's probably a good idea to handle these -- messages anyway. WMEphemeralMessage - | Just p <- wepPost $ weData we -> postInfoMessage $ p^.postMessageL + | Just p <- wepPost $ weData we -> postInfoMessage (unsafeUserText $ p^.postMessageL) | otherwise -> return () WMPreferenceChanged diff --git a/src/State.hs b/src/State.hs index 62a681eb..8d5d934d 100644 --- a/src/State.hs +++ b/src/State.hs @@ -477,8 +477,8 @@ beginEditMessage = do -- removed formatting needs to be reinstated just prior to -- issuing the API call to update the post. let toEdit = if msg^.mType == CP Emote - then removeEmoteFormatting $ postMessage p - else postMessage p + then removeEmoteFormatting $ unsafeUserText $ postMessage p + else unsafeUserText $ postMessage p csEditState.cedEditor %= applyEdit (clearZipper >> (insertMany toEdit)) _ -> return () @@ -1148,8 +1148,8 @@ attemptCreateDMChannel name = do me <- gets myUser displayNick <- use (to useNickname) uList <- use (to sortedUserList) - let myName = if displayNick && not (T.null $ userNickname me) - then userNickname me + let myName = if displayNick && not (T.null $ unsafeUserText $ userNickname me) + then unsafeUserText $ userNickname me else me^.userUsernameL when (name /= myName) $ do let uName = if displayNick @@ -1231,7 +1231,7 @@ handleNewChannel_ permitPostpone switch nc member = do -- async work to do before we can register this channel (in -- which case abort because we got rescheduled). mName <- case chType of - Direct -> case userIdForDMChannel (myUserId st) $ channelName nc of + Direct -> case userIdForDMChannel (myUserId st) (unsafeUserText $ channelName nc) of -- If this is a direct channel but we can't extract a -- user ID from the name, then it failed to parse. We -- need to assign a channel name in our channel map, @@ -1243,7 +1243,7 @@ handleNewChannel_ permitPostpone switch nc member = do -- least we can go ahead and register the channel and -- handle events for it. That isn't very useful but it's -- probably better than ignoring this entirely. - Nothing -> return $ Just $ channelName nc + Nothing -> return $ Just $ unsafeUserText $ channelName nc Just otherUserId -> case usernameForUserId otherUserId st of -- If we found a user ID in the channel name @@ -1262,7 +1262,7 @@ handleNewChannel_ permitPostpone switch nc member = do -- name (this has the same problems as above). Nothing -> do case permitPostpone of - False -> return $ Just $ channelName nc + False -> return $ Just $ unsafeUserText $ channelName nc True -> do handleNewUsers $ Seq.singleton otherUserId doAsyncWith Normal $ @@ -1338,7 +1338,7 @@ runNotifyCommand post mentioned = do Nothing -> return () Just cmd -> doAsyncWith Preempt $ do - let messageString = T.unpack $ postMessage post + let messageString = T.unpack $ unsafeUserText $ postMessage post notified = if mentioned then "1" else "2" sender = T.unpack $ maybePostUsername st post runLoggedCommand False outputChan (T.unpack cmd) diff --git a/src/State/Setup.hs b/src/State/Setup.hs index 5881d44f..bee3ac9a 100644 --- a/src/State/Setup.hs +++ b/src/State/Setup.hs @@ -117,7 +117,7 @@ setupState logFile initialConfig = do interactiveTeamSelection $ toList teams Just tName -> do let matchingTeam = listToMaybe $ filter matches $ toList teams - matches t = teamName t == tName + matches t = (unsafeUserText $ teamName t) == tName case matchingTeam of Nothing -> interactiveTeamSelection (toList teams) Just t -> return t diff --git a/src/TeamSelect.hs b/src/TeamSelect.hs index 8fa93cf4..6c7e85a8 100644 --- a/src/TeamSelect.hs +++ b/src/TeamSelect.hs @@ -61,7 +61,7 @@ teamSelect st = renderTeamItem :: Bool -> Team -> Widget () renderTeamItem _ t = - padRight Max $ txt $ teamName t + padRight Max $ txt $ unsafeUserText $ teamName t onEvent :: State -> BrickEvent () e -> EventM () (Next State) onEvent _ (VtyEvent (EvKey KEsc [])) = liftIO exitSuccess diff --git a/src/Types.hs b/src/Types.hs index 4ea058a8..7962a444 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -364,7 +364,7 @@ mkNames myUser users chans = [ (userUsername u, getId u) | u <- HM.elems users ] } where lookupChan n = [ c^.channelIdL - | c <- toList chans, c^.channelNameL == n + | c <- toList chans, (unsafeUserText $ c^.channelNameL) == n ] -- ** 'MMNames' Lenses diff --git a/src/Types/Channels.hs b/src/Types/Channels.hs index 5d0bcc84..eef2aa48 100644 --- a/src/Types/Channels.hs +++ b/src/Types/Channels.hs @@ -63,6 +63,7 @@ import Network.Mattermost.Types ( Channel(..), UserId, ChannelId , WithDefault(..) , ServerTime , emptyChannelNotifyProps + , unsafeUserText ) import Types.Messages ( Messages, noMessages, addMessage @@ -86,8 +87,8 @@ data ClientChannel = ClientChannel -- Get a channel's name, depending on its type preferredChannelName :: Channel -> Text preferredChannelName ch - | channelType ch == Group = channelDisplayName ch - | otherwise = channelName ch + | channelType ch == Group = unsafeUserText $ channelDisplayName ch + | otherwise = unsafeUserText $ channelName ch data NewMessageIndicator = Hide @@ -104,8 +105,8 @@ initialChannelInfo chan = , _cdMentionCount = 0 , _cdUpdated = updated , _cdName = preferredChannelName chan - , _cdHeader = chan^.channelHeaderL - , _cdPurpose = chan^.channelPurposeL + , _cdHeader = unsafeUserText $ chan^.channelHeaderL + , _cdPurpose = unsafeUserText $ chan^.channelPurposeL , _cdType = chan^.channelTypeL , _cdNotifyProps = emptyChannelNotifyProps , _cdTypingUsers = noTypingUsers @@ -121,8 +122,8 @@ channelInfoFromChannelWithData chan chanMember ci = v -> v , _cdUpdated = updated , _cdName = preferredChannelName chan - , _cdHeader = (chan^.channelHeaderL) - , _cdPurpose = (chan^.channelPurposeL) + , _cdHeader = (unsafeUserText $ chan^.channelHeaderL) + , _cdPurpose = (unsafeUserText $ chan^.channelPurposeL) , _cdType = (chan^.channelTypeL) , _cdMentionCount = chanMember^.to channelMemberMentionCount , _cdNotifyProps = chanMember^.to channelMemberNotifyProps @@ -311,7 +312,7 @@ updateNewMessageIndicator m = -- whether a channel is in fact that channel, even if the user has -- changed its display name. isTownSquare :: Channel -> Bool -isTownSquare c = c^.channelNameL == "town-square" +isTownSquare c = (unsafeUserText $ c^.channelNameL) == "town-square" channelDeleted :: Channel -> Bool channelDeleted c = c^.channelDeleteAtL > c^.channelCreateAtL diff --git a/src/Types/Posts.hs b/src/Types/Posts.hs index d504c75d..7f01d902 100644 --- a/src/Types/Posts.hs +++ b/src/Types/Posts.hs @@ -161,8 +161,8 @@ postIsTopicChange p = postType p == PostTypeHeaderChange postIsEmote :: Post -> Bool postIsEmote p = and [ p^.postPropsL.postPropsOverrideIconUrlL == Just (""::Text) - , ("*" `T.isPrefixOf` postMessage p) - , ("*" `T.isSuffixOf` postMessage p) + , ("*" `T.isPrefixOf` (unsafeUserText $ postMessage p)) + , ("*" `T.isSuffixOf` (unsafeUserText $ postMessage p)) ] -- | Find out whether a 'Post' is a user joining a channel @@ -186,7 +186,7 @@ unEmote _ t = t -- 'ParentId' if it has a known one. toClientPost :: Post -> Maybe PostId -> ClientPost toClientPost p parentId = ClientPost - { _cpText = (getBlocks $ unEmote (postClientPostType p) $ postMessage p) + { _cpText = (getBlocks $ unEmote (postClientPostType p) $ unsafeUserText $ postMessage p) <> getAttachmentText p , _cpUser = postUserId p , _cpUserOverride = p^.postPropsL.postPropsOverrideUsernameL diff --git a/src/Types/Users.hs b/src/Types/Users.hs index 5887d58e..8aa2acfd 100644 --- a/src/Types/Users.hs +++ b/src/Types/Users.hs @@ -43,7 +43,7 @@ import qualified Data.Text as T import Lens.Micro.Platform ( (%~), makeLenses, ix ) import Network.Mattermost.Types ( Id(Id), UserId(..), User(..) - , idString ) + , idString, unsafeUserText ) -- * 'UserInfo' Values @@ -72,12 +72,12 @@ userInfoFromUser up inTeam = UserInfo , _uiId = userId up , _uiStatus = Offline , _uiInTeam = inTeam - , _uiNickName = if T.null (userNickname up) - then Nothing - else Just $ userNickname up - , _uiFirstName = userFirstName up - , _uiLastName = userLastName up - , _uiEmail = userEmail up + , _uiNickName = + let nick = unsafeUserText $ userNickname up + in if T.null nick then Nothing else Just nick + , _uiFirstName = unsafeUserText $ userFirstName up + , _uiLastName = unsafeUserText $ userLastName up + , _uiEmail = unsafeUserText $ userEmail up , _uiDeleted = userDeleted up } From 18fa6185e9d404394469ece336902b922c36d55e Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Apr 2018 14:00:30 -0700 Subject: [PATCH 3/7] Add sanitizeUserText and use before storing or displaying UserText values --- matterhorn.cabal | 2 ++ src/Draw/JoinChannel.hs | 7 ++++--- src/Events.hs | 3 ++- src/State.hs | 17 +++++++++-------- src/State/Setup.hs | 3 ++- src/TeamSelect.hs | 3 ++- src/Types.hs | 3 ++- src/Types/Channels.hs | 16 ++++++++-------- src/Types/Common.hs | 17 +++++++++++++++++ src/Types/Posts.hs | 8 +++++--- src/Types/Users.hs | 12 +++++++----- 11 files changed, 60 insertions(+), 31 deletions(-) create mode 100644 src/Types/Common.hs diff --git a/matterhorn.cabal b/matterhorn.cabal index 3a40088c..d4a1c997 100644 --- a/matterhorn.cabal +++ b/matterhorn.cabal @@ -78,6 +78,7 @@ executable matterhorn Prelude.MH Types Types.Channels + Types.Common Types.DirectionalSeq Types.KeyEvents Types.Messages @@ -143,6 +144,7 @@ test-suite test_messages , TimeUtils , Types.Messages , Types.Posts + , Types.Common , Types.DirectionalSeq , Prelude.MH default-language: Haskell2010 diff --git a/src/Draw/JoinChannel.hs b/src/Draw/JoinChannel.hs index f02f50cf..1f2b4dc6 100644 --- a/src/Draw/JoinChannel.hs +++ b/src/Draw/JoinChannel.hs @@ -17,11 +17,12 @@ import Text.Wrap ( defaultWrapSettings, preserveIndentation ) import Network.Mattermost.Lenses ( channelDisplayNameL , channelNameL , channelPurposeL ) -import Network.Mattermost.Types ( Channel, unsafeUserText ) +import Network.Mattermost.Types ( Channel ) import Draw.Main import Themes import Types +import Types.Common drawJoinChannel :: ChatState -> [Widget Name] @@ -49,7 +50,7 @@ joinChannelBox st = renderJoinListItem :: Bool -> Channel -> Widget Name renderJoinListItem _ chan = - let baseStr = (unsafeUserText $ chan^.channelNameL) <> " (" <> (unsafeUserText $ chan^.channelDisplayNameL) <> ")" - s = " " <> (T.strip $ unsafeUserText $ chan^.channelPurposeL) + let baseStr = (sanitizeUserText $ chan^.channelNameL) <> " (" <> (sanitizeUserText $ chan^.channelDisplayNameL) <> ")" + s = " " <> (T.strip $ sanitizeUserText $ chan^.channelPurposeL) in (vLimit 1 $ padRight Max $ txt baseStr) <=> (vLimit 1 $ txtWrapWith (defaultWrapSettings { preserveIndentation = True }) s) diff --git a/src/Events.hs b/src/Events.hs index 30d0e265..a65dd2af 100644 --- a/src/Events.hs +++ b/src/Events.hs @@ -22,6 +22,7 @@ import HelpTopics import State import State.Common import Types +import Types.Common import Types.KeyEvents import Events.ChannelScroll @@ -200,7 +201,7 @@ handleWSEvent we = do -- shortcuts, but it's probably a good idea to handle these -- messages anyway. WMEphemeralMessage - | Just p <- wepPost $ weData we -> postInfoMessage (unsafeUserText $ p^.postMessageL) + | Just p <- wepPost $ weData we -> postInfoMessage (sanitizeUserText $ p^.postMessageL) | otherwise -> return () WMPreferenceChanged diff --git a/src/State.hs b/src/State.hs index 8d5d934d..5f9c1ac3 100644 --- a/src/State.hs +++ b/src/State.hs @@ -155,6 +155,7 @@ import Markdown ( blockGetURLs, findVerbatimChunk ) import Themes import TimeUtils ( justBefore, justAfter ) import Types +import Types.Common import Zipper ( Zipper ) import qualified Zipper as Z @@ -477,8 +478,8 @@ beginEditMessage = do -- removed formatting needs to be reinstated just prior to -- issuing the API call to update the post. let toEdit = if msg^.mType == CP Emote - then removeEmoteFormatting $ unsafeUserText $ postMessage p - else unsafeUserText $ postMessage p + then removeEmoteFormatting $ sanitizeUserText $ postMessage p + else sanitizeUserText $ postMessage p csEditState.cedEditor %= applyEdit (clearZipper >> (insertMany toEdit)) _ -> return () @@ -1148,8 +1149,8 @@ attemptCreateDMChannel name = do me <- gets myUser displayNick <- use (to useNickname) uList <- use (to sortedUserList) - let myName = if displayNick && not (T.null $ unsafeUserText $ userNickname me) - then unsafeUserText $ userNickname me + let myName = if displayNick && not (T.null $ sanitizeUserText $ userNickname me) + then sanitizeUserText $ userNickname me else me^.userUsernameL when (name /= myName) $ do let uName = if displayNick @@ -1231,7 +1232,7 @@ handleNewChannel_ permitPostpone switch nc member = do -- async work to do before we can register this channel (in -- which case abort because we got rescheduled). mName <- case chType of - Direct -> case userIdForDMChannel (myUserId st) (unsafeUserText $ channelName nc) of + Direct -> case userIdForDMChannel (myUserId st) (sanitizeUserText $ channelName nc) of -- If this is a direct channel but we can't extract a -- user ID from the name, then it failed to parse. We -- need to assign a channel name in our channel map, @@ -1243,7 +1244,7 @@ handleNewChannel_ permitPostpone switch nc member = do -- least we can go ahead and register the channel and -- handle events for it. That isn't very useful but it's -- probably better than ignoring this entirely. - Nothing -> return $ Just $ unsafeUserText $ channelName nc + Nothing -> return $ Just $ sanitizeUserText $ channelName nc Just otherUserId -> case usernameForUserId otherUserId st of -- If we found a user ID in the channel name @@ -1262,7 +1263,7 @@ handleNewChannel_ permitPostpone switch nc member = do -- name (this has the same problems as above). Nothing -> do case permitPostpone of - False -> return $ Just $ unsafeUserText $ channelName nc + False -> return $ Just $ sanitizeUserText $ channelName nc True -> do handleNewUsers $ Seq.singleton otherUserId doAsyncWith Normal $ @@ -1338,7 +1339,7 @@ runNotifyCommand post mentioned = do Nothing -> return () Just cmd -> doAsyncWith Preempt $ do - let messageString = T.unpack $ unsafeUserText $ postMessage post + let messageString = T.unpack $ sanitizeUserText $ postMessage post notified = if mentioned then "1" else "2" sender = T.unpack $ maybePostUsername st post runLoggedCommand False outputChan (T.unpack cmd) diff --git a/src/State/Setup.hs b/src/State/Setup.hs index bee3ac9a..807522e1 100644 --- a/src/State/Setup.hs +++ b/src/State/Setup.hs @@ -35,6 +35,7 @@ import TeamSelect import Themes import TimeUtils ( lookupLocalTimeZone ) import Types +import Types.Common import qualified Zipper as Z @@ -117,7 +118,7 @@ setupState logFile initialConfig = do interactiveTeamSelection $ toList teams Just tName -> do let matchingTeam = listToMaybe $ filter matches $ toList teams - matches t = (unsafeUserText $ teamName t) == tName + matches t = (sanitizeUserText $ teamName t) == tName case matchingTeam of Nothing -> interactiveTeamSelection (toList teams) Just t -> return t diff --git a/src/TeamSelect.hs b/src/TeamSelect.hs index 6c7e85a8..c9f3bedb 100644 --- a/src/TeamSelect.hs +++ b/src/TeamSelect.hs @@ -17,6 +17,7 @@ import System.Exit ( exitSuccess ) import Network.Mattermost.Types import Markdown +import Types.Common type State = List () Team @@ -61,7 +62,7 @@ teamSelect st = renderTeamItem :: Bool -> Team -> Widget () renderTeamItem _ t = - padRight Max $ txt $ unsafeUserText $ teamName t + padRight Max $ txt $ sanitizeUserText $ teamName t onEvent :: State -> BrickEvent () e -> EventM () (Next State) onEvent _ (VtyEvent (EvKey KEsc [])) = liftIO exitSuccess diff --git a/src/Types.hs b/src/Types.hs index 7962a444..27a9021f 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -239,6 +239,7 @@ import Network.Mattermost.WebSocket ( WebsocketEvent ) import Completion ( Completer ) import InputHistory import Types.Channels +import Types.Common import Types.DirectionalSeq ( emptyDirSeq ) import Types.KeyEvents import Types.Messages @@ -364,7 +365,7 @@ mkNames myUser users chans = [ (userUsername u, getId u) | u <- HM.elems users ] } where lookupChan n = [ c^.channelIdL - | c <- toList chans, (unsafeUserText $ c^.channelNameL) == n + | c <- toList chans, (sanitizeUserText $ c^.channelNameL) == n ] -- ** 'MMNames' Lenses diff --git a/src/Types/Channels.hs b/src/Types/Channels.hs index eef2aa48..7923705a 100644 --- a/src/Types/Channels.hs +++ b/src/Types/Channels.hs @@ -63,7 +63,6 @@ import Network.Mattermost.Types ( Channel(..), UserId, ChannelId , WithDefault(..) , ServerTime , emptyChannelNotifyProps - , unsafeUserText ) import Types.Messages ( Messages, noMessages, addMessage @@ -71,6 +70,7 @@ import Types.Messages ( Messages, noMessages, addMessage import Types.Posts ( ClientMessageType(UnknownGap) , newClientMessage, postIsLeave, postIsJoin ) import Types.Users ( TypingUsers, noTypingUsers, addTypingUser ) +import Types.Common -- * Channel representations @@ -87,8 +87,8 @@ data ClientChannel = ClientChannel -- Get a channel's name, depending on its type preferredChannelName :: Channel -> Text preferredChannelName ch - | channelType ch == Group = unsafeUserText $ channelDisplayName ch - | otherwise = unsafeUserText $ channelName ch + | channelType ch == Group = sanitizeUserText $ channelDisplayName ch + | otherwise = sanitizeUserText $ channelName ch data NewMessageIndicator = Hide @@ -105,8 +105,8 @@ initialChannelInfo chan = , _cdMentionCount = 0 , _cdUpdated = updated , _cdName = preferredChannelName chan - , _cdHeader = unsafeUserText $ chan^.channelHeaderL - , _cdPurpose = unsafeUserText $ chan^.channelPurposeL + , _cdHeader = sanitizeUserText $ chan^.channelHeaderL + , _cdPurpose = sanitizeUserText $ chan^.channelPurposeL , _cdType = chan^.channelTypeL , _cdNotifyProps = emptyChannelNotifyProps , _cdTypingUsers = noTypingUsers @@ -122,8 +122,8 @@ channelInfoFromChannelWithData chan chanMember ci = v -> v , _cdUpdated = updated , _cdName = preferredChannelName chan - , _cdHeader = (unsafeUserText $ chan^.channelHeaderL) - , _cdPurpose = (unsafeUserText $ chan^.channelPurposeL) + , _cdHeader = (sanitizeUserText $ chan^.channelHeaderL) + , _cdPurpose = (sanitizeUserText $ chan^.channelPurposeL) , _cdType = (chan^.channelTypeL) , _cdMentionCount = chanMember^.to channelMemberMentionCount , _cdNotifyProps = chanMember^.to channelMemberNotifyProps @@ -312,7 +312,7 @@ updateNewMessageIndicator m = -- whether a channel is in fact that channel, even if the user has -- changed its display name. isTownSquare :: Channel -> Bool -isTownSquare c = (unsafeUserText $ c^.channelNameL) == "town-square" +isTownSquare c = (sanitizeUserText $ c^.channelNameL) == "town-square" channelDeleted :: Channel -> Bool channelDeleted c = c^.channelDeleteAtL > c^.channelCreateAtL diff --git a/src/Types/Common.hs b/src/Types/Common.hs new file mode 100644 index 00000000..fd5e6190 --- /dev/null +++ b/src/Types/Common.hs @@ -0,0 +1,17 @@ +module Types.Common + ( sanitizeUserText + ) +where + +import Prelude () +import Prelude.MH + +import qualified Data.Text as T + +import Network.Mattermost.Types ( UserText, unsafeUserText ) + +sanitizeUserText :: UserText -> T.Text +sanitizeUserText ut = + T.replace "\ESC" "" $ + T.replace "\t" " " $ + unsafeUserText ut diff --git a/src/Types/Posts.hs b/src/Types/Posts.hs index 7f01d902..29bf993d 100644 --- a/src/Types/Posts.hs +++ b/src/Types/Posts.hs @@ -58,6 +58,8 @@ import Lens.Micro.Platform ( makeLenses ) import Network.Mattermost.Lenses import Network.Mattermost.Types +import Types.Common + -- * Client Messages @@ -161,8 +163,8 @@ postIsTopicChange p = postType p == PostTypeHeaderChange postIsEmote :: Post -> Bool postIsEmote p = and [ p^.postPropsL.postPropsOverrideIconUrlL == Just (""::Text) - , ("*" `T.isPrefixOf` (unsafeUserText $ postMessage p)) - , ("*" `T.isSuffixOf` (unsafeUserText $ postMessage p)) + , ("*" `T.isPrefixOf` (sanitizeUserText $ postMessage p)) + , ("*" `T.isSuffixOf` (sanitizeUserText $ postMessage p)) ] -- | Find out whether a 'Post' is a user joining a channel @@ -186,7 +188,7 @@ unEmote _ t = t -- 'ParentId' if it has a known one. toClientPost :: Post -> Maybe PostId -> ClientPost toClientPost p parentId = ClientPost - { _cpText = (getBlocks $ unEmote (postClientPostType p) $ unsafeUserText $ postMessage p) + { _cpText = (getBlocks $ unEmote (postClientPostType p) $ sanitizeUserText $ postMessage p) <> getAttachmentText p , _cpUser = postUserId p , _cpUserOverride = p^.postPropsL.postPropsOverrideUsernameL diff --git a/src/Types/Users.hs b/src/Types/Users.hs index 8aa2acfd..7e83dbfd 100644 --- a/src/Types/Users.hs +++ b/src/Types/Users.hs @@ -43,7 +43,9 @@ import qualified Data.Text as T import Lens.Micro.Platform ( (%~), makeLenses, ix ) import Network.Mattermost.Types ( Id(Id), UserId(..), User(..) - , idString, unsafeUserText ) + , idString ) + +import Types.Common -- * 'UserInfo' Values @@ -73,11 +75,11 @@ userInfoFromUser up inTeam = UserInfo , _uiStatus = Offline , _uiInTeam = inTeam , _uiNickName = - let nick = unsafeUserText $ userNickname up + let nick = sanitizeUserText $ userNickname up in if T.null nick then Nothing else Just nick - , _uiFirstName = unsafeUserText $ userFirstName up - , _uiLastName = unsafeUserText $ userLastName up - , _uiEmail = unsafeUserText $ userEmail up + , _uiFirstName = sanitizeUserText $ userFirstName up + , _uiLastName = sanitizeUserText $ userLastName up + , _uiEmail = sanitizeUserText $ userEmail up , _uiDeleted = userDeleted up } From 5e3ba6e0b78c78eff36ea2f1c9e33f8e7306322a Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Apr 2018 14:10:11 -0700 Subject: [PATCH 4/7] cabal: add XML syntax and related files to package manifest --- matterhorn.cabal | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/matterhorn.cabal b/matterhorn.cabal index 3a40088c..fab6c681 100644 --- a/matterhorn.cabal +++ b/matterhorn.cabal @@ -14,6 +14,10 @@ build-type: Simple cabal-version: >= 1.18 tested-with: GHC == 7.10.3, GHC == 8.0.1 +data-files: syntax/*.xml + syntax/language.dtd + syntax/LICENSE + extra-doc-files: CHANGELOG.md README.md PRACTICES.md From 134e0d542abca1e8edc1d4d4e4b0a1c2c6b07852 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Apr 2018 14:39:31 -0700 Subject: [PATCH 5/7] Types.Common: add sanitation functions for individual characters and text input --- src/Types/Common.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/Types/Common.hs b/src/Types/Common.hs index fd5e6190..7f9ac1c5 100644 --- a/src/Types/Common.hs +++ b/src/Types/Common.hs @@ -1,5 +1,7 @@ module Types.Common ( sanitizeUserText + , sanitizeUserText' + , sanitizeChar ) where @@ -11,7 +13,14 @@ import qualified Data.Text as T import Network.Mattermost.Types ( UserText, unsafeUserText ) sanitizeUserText :: UserText -> T.Text -sanitizeUserText ut = +sanitizeUserText = sanitizeUserText' . unsafeUserText + +sanitizeUserText' :: T.Text -> T.Text +sanitizeUserText' t = T.replace "\ESC" "" $ - T.replace "\t" " " $ - unsafeUserText ut + T.replace "\t" " " t + +sanitizeChar :: Char -> T.Text +sanitizeChar '\ESC' = "" +sanitizeChar '\t' = " " +sanitizeChar c = T.singleton c From 1edd6292b9f2e6d3231ebbea212f5ced6c3e1a4b Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Apr 2018 14:39:43 -0700 Subject: [PATCH 6/7] State.Editing: sanitize text input on the way into the editor --- src/State/Editing.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/State/Editing.hs b/src/State/Editing.hs index 572b3393..591fe2aa 100644 --- a/src/State/Editing.hs +++ b/src/State/Editing.hs @@ -33,6 +33,7 @@ import Config import Events.Keybindings import State.Common import Types +import Types.Common ( sanitizeChar, sanitizeUserText' ) startMultilineEditing :: MH () @@ -70,7 +71,7 @@ invokeExternalEditor = do Left _ -> do postErrorMessageIO "Failed to decode file contents as UTF-8" st Right t -> do - let tmpLines = T.lines t + let tmpLines = T.lines $ sanitizeUserText' t return $ st & csEditState.cedEditor.editContentsL .~ (Z.textZipper tmpLines Nothing) & csEditState.cedMultiline .~ (length tmpLines > 1) Sys.ExitFailure _ -> return st @@ -81,7 +82,7 @@ toggleMessagePreview = csShowMessagePreview %= not handlePaste :: BS.ByteString -> MH () handlePaste bytes = do let pasteStr = T.pack (UTF8.toString bytes) - csEditState.cedEditor %= applyEdit (Z.insertMany pasteStr) + csEditState.cedEditor %= applyEdit (Z.insertMany (sanitizeUserText' pasteStr)) contents <- use (csEditState.cedEditor.to getEditContents) case length contents > 1 of True -> startMultilineEditing @@ -201,7 +202,8 @@ handleEditingInput e = do csEditState.cedEditor %= applyEdit (Z.deleteChar >>> Z.deletePrevChar) | otherwise -> backspace - EvKey (KChar ch) [] | editingPermitted st && smartBacktick && ch `elem` smartChars -> + EvKey (KChar ch) [] + | editingPermitted st && smartBacktick && ch `elem` smartChars -> -- Smart char insertion: let doInsertChar = do csEditState.cedEditor %= applyEdit (Z.insertChar ch) @@ -214,7 +216,9 @@ handleEditingInput e = do (cursorIsAtEnd $ applyEdit Z.moveRight $ st^.csEditState.cedEditor) -> csEditState.cedEditor %= applyEdit Z.moveRight | otherwise -> doInsertChar - + | editingPermitted st -> do + csEditState.cedEditor %= applyEdit (Z.insertMany (sanitizeChar ch)) + sendUserTypingAction _ | editingPermitted st -> do mhHandleEventLensed (csEditState.cedEditor) handleEditorEvent e sendUserTypingAction From 59e89e8273a5737216e72d59a154fee80081abf2 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Apr 2018 15:13:11 -0700 Subject: [PATCH 7/7] Bump version, update changelog --- CHANGELOG.md | 10 ++++++++++ matterhorn.cabal | 8 ++++---- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c7cca237..27aefb0a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,14 @@ +40900.0.1 +========= + +Bug fixes: + * Terminal escapes are now sanitized from local user input and + user-provided values from the server (#390). + * The Cabal package now includes XML syntax and DTD files in the + manifest. + * Releases now ship the syntax DTD. + 40900.0.0 ========= diff --git a/matterhorn.cabal b/matterhorn.cabal index 9cf57682..e989e948 100644 --- a/matterhorn.cabal +++ b/matterhorn.cabal @@ -1,5 +1,5 @@ name: matterhorn -version: 40900.0.0 +version: 40900.0.1 synopsis: Terminal client for the Mattermost chat system description: This is a terminal client for the Mattermost chat system. Please see the README for a list of @@ -99,7 +99,7 @@ executable matterhorn NoImplicitPrelude ghc-options: -Wall -threaded -with-rtsopts=-I0 build-depends: base >=4.8 && <5 - , mattermost-api == 40900.0.0 + , mattermost-api == 40900.1.0 , base-compat >= 0.9 && < 0.10 , unordered-containers >= 0.2 && < 0.3 , containers >= 0.5.7 && < 0.6 @@ -169,8 +169,8 @@ test-suite test_messages , filepath >= 1.4 && < 1.5 , hashable >= 1.2 && < 1.3 , Hclip >= 3.0 && < 3.1 - , mattermost-api == 40900.0.0 - , mattermost-api-qc == 40900.0.0 + , mattermost-api == 40900.1.0 + , mattermost-api-qc == 40900.1.0 , microlens-platform >= 0.3 && < 0.4 , mtl >= 2.2 && < 2.3 , process >= 1.4 && < 1.7