1{-# LANGUAGE TemplateHaskell #-} 2{-# LANGUAGE DeriveFunctor #-} 3 4module Matterhorn.Types.Users 5 ( UserInfo(..) 6 , UserStatus(..) 7 , Users -- constructor remains internal 8 -- * Lenses created for accessing UserInfo fields 9 , uiName, uiId, uiStatus, uiInTeam, uiNickName, uiFirstName, uiLastName, uiEmail 10 , uiDeleted 11 -- * Various operations on UserInfo 12 -- * Creating UserInfo objects 13 , userInfoFromUser 14 -- * Miscellaneous 15 , getUsernameSet 16 , trimUserSigil 17 , statusFromText 18 , findUserById 19 , findUserByUsername 20 , findUserByNickname 21 , noUsers, addUser, allUsers 22 , modifyUserById 23 , userDeleted 24 , TypingUsers 25 , noTypingUsers 26 , addTypingUser 27 , allTypingUsers 28 , expireTypingUsers 29 , getAllUserIds 30 ) 31where 32 33import Prelude () 34import Matterhorn.Prelude 35 36import qualified Data.HashMap.Strict as HM 37import qualified Data.Set as S 38import Data.Semigroup ( Max(..) ) 39import qualified Data.Text as T 40import Lens.Micro.Platform ( (%~), makeLenses, ix ) 41 42import Network.Mattermost.Types ( UserId(..), User(..) ) 43 44import Matterhorn.Types.Common 45import Matterhorn.Constants ( userSigil ) 46 47-- * 'UserInfo' Values 48 49-- | A 'UserInfo' value represents everything we need to know at 50-- runtime about a user 51data UserInfo = UserInfo 52 { _uiName :: Text 53 , _uiId :: UserId 54 , _uiStatus :: UserStatus 55 , _uiInTeam :: Bool 56 , _uiNickName :: Maybe Text 57 , _uiFirstName :: Text 58 , _uiLastName :: Text 59 , _uiEmail :: Text 60 , _uiDeleted :: Bool 61 } deriving (Eq, Show) 62 63-- | Is this user deleted? 64userDeleted :: User -> Bool 65userDeleted u = 66 case userCreateAt u of 67 Nothing -> False 68 Just c -> userDeleteAt u > c 69 70-- | Create a 'UserInfo' value from a Mattermost 'User' value 71userInfoFromUser :: User -> Bool -> UserInfo 72userInfoFromUser up inTeam = UserInfo 73 { _uiName = userUsername up 74 , _uiId = userId up 75 , _uiStatus = Offline 76 , _uiInTeam = inTeam 77 , _uiNickName = 78 let nick = sanitizeUserText $ userNickname up 79 in if T.null nick then Nothing else Just nick 80 , _uiFirstName = sanitizeUserText $ userFirstName up 81 , _uiLastName = sanitizeUserText $ userLastName up 82 , _uiEmail = sanitizeUserText $ userEmail up 83 , _uiDeleted = userDeleted up 84 } 85 86-- | The 'UserStatus' value represents possible current status for 87-- a user 88data UserStatus 89 = Online 90 | Away 91 | Offline 92 | DoNotDisturb 93 | Other Text 94 deriving (Eq, Show) 95 96statusFromText :: Text -> UserStatus 97statusFromText t = case t of 98 "online" -> Online 99 "offline" -> Offline 100 "away" -> Away 101 "dnd" -> DoNotDisturb 102 _ -> Other t 103 104-- ** 'UserInfo' lenses 105 106makeLenses ''UserInfo 107 108-- ** Manage the collection of all Users 109 110-- | Define a binary kinded type to allow derivation of functor. 111data AllMyUsers a = 112 AllUsers { _ofUsers :: HashMap UserId a 113 , _usernameSet :: S.Set Text 114 } 115 deriving Functor 116 117makeLenses ''AllMyUsers 118 119-- | Define the exported typename which universally binds the 120-- collection to the UserInfo type. 121type Users = AllMyUsers UserInfo 122 123getUsernameSet :: Users -> S.Set Text 124getUsernameSet = _usernameSet 125 126-- | Initial collection of Users with no members 127noUsers :: Users 128noUsers = AllUsers HM.empty mempty 129 130getAllUserIds :: Users -> [UserId] 131getAllUserIds = HM.keys . _ofUsers 132 133-- | Add a member to the existing collection of Users 134addUser :: UserInfo -> Users -> Users 135addUser userinfo u = 136 u & ofUsers %~ HM.insert (userinfo^.uiId) userinfo 137 & usernameSet %~ S.insert (userinfo^.uiName) 138 139-- | Get a list of all known users 140allUsers :: Users -> [UserInfo] 141allUsers = HM.elems . _ofUsers 142 143-- | Define the exported typename to represent the collection of users 144-- | who are currently typing. The values kept against the user id keys are the 145-- | latest timestamps of typing events from the server. 146type TypingUsers = AllMyUsers (Max UTCTime) 147 148-- | Initial collection of TypingUsers with no members 149noTypingUsers :: TypingUsers 150noTypingUsers = AllUsers HM.empty mempty 151 152-- | Add a member to the existing collection of TypingUsers 153addTypingUser :: UserId -> UTCTime -> TypingUsers -> TypingUsers 154addTypingUser uId ts = ofUsers %~ HM.insertWith (<>) uId (Max ts) 155 156-- | Get a list of all typing users 157allTypingUsers :: TypingUsers -> [UserId] 158allTypingUsers = HM.keys . _ofUsers 159 160-- | Remove all the expired users from the collection of TypingUsers. 161-- | Expiry is decided by the given timestamp. 162expireTypingUsers :: UTCTime -> TypingUsers -> TypingUsers 163expireTypingUsers expiryTimestamp = 164 ofUsers %~ HM.filter (\(Max ts') -> ts' >= expiryTimestamp) 165 166-- | Get the User information given the UserId 167findUserById :: UserId -> Users -> Maybe UserInfo 168findUserById uId = HM.lookup uId . _ofUsers 169 170-- | Get the User information given the user's name. This is an exact 171-- match on the username field. It will automatically trim a user sigil 172-- from the input. 173findUserByUsername :: Text -> Users -> Maybe (UserId, UserInfo) 174findUserByUsername name allusers = 175 case filter ((== trimUserSigil name) . _uiName . snd) $ HM.toList $ _ofUsers allusers of 176 (usr : []) -> Just usr 177 _ -> Nothing 178 179-- | Get the User information given the user's name. This is an exact 180-- match on the nickname field, not necessarily the presented name. It 181-- will automatically trim a user sigil from the input. 182findUserByNickname:: Text -> Users -> Maybe (UserId, UserInfo) 183findUserByNickname nick us = 184 case filter ((== (Just $ trimUserSigil nick)) . _uiNickName . snd) $ HM.toList $ _ofUsers us of 185 (pair : []) -> Just pair 186 _ -> Nothing 187 188trimUserSigil :: Text -> Text 189trimUserSigil n 190 | userSigil `T.isPrefixOf` n = T.tail n 191 | otherwise = n 192 193-- | Extract a specific user from the collection and perform an 194-- endomorphism operation on it, then put it back into the collection. 195modifyUserById :: UserId -> (UserInfo -> UserInfo) -> Users -> Users 196modifyUserById uId f = ofUsers.ix(uId) %~ f 197