-- | Permission utilities module Calamity.Utils.Permissions ( basePermissions, applyOverwrites, PermissionsIn (..), PermissionsIn' (..), ) where import Calamity.Client.Types import Calamity.Internal.SnowflakeMap qualified as SM import Calamity.Types.Model.Channel.Guild import Calamity.Types.Model.Guild.Guild import Calamity.Types.Model.Guild.Member import Calamity.Types.Model.Guild.Overwrite import Calamity.Types.Model.Guild.Permissions import Calamity.Types.Model.User import Calamity.Types.Snowflake import Calamity.Types.Upgradeable import Data.Flags import Data.Foldable (Foldable (foldl')) import Data.Maybe (mapMaybe) import Data.Vector.Unboxing qualified as V import Optics import Polysemy qualified as P -- | Calculate a 'Member'\'s 'Permissions' in a 'Guild' basePermissions :: Guild -> Member -> Permissions basePermissions g m | g ^. #ownerID == getID m = allFlags | otherwise = let everyoneRole = g ^. #roles % at (coerceSnowflake $ getID @Guild g) permsEveryone = maybe noFlags (^. #permissions) everyoneRole roleIDs = V.toList $ m ^. #roles rolePerms = mapMaybe (\rid -> g ^? #roles % ix rid % #permissions) roleIDs perms = foldl' andFlags noFlags (permsEveryone : rolePerms) in if perms .<=. administrator then allFlags else perms overwrites :: GuildChannel -> SM.SnowflakeMap Overwrite overwrites (GuildTextChannel c) = c ^. #permissionOverwrites overwrites (GuildVoiceChannel c) = c ^. #permissionOverwrites overwrites (GuildCategory c) = c ^. #permissionOverwrites overwrites _ = SM.empty -- | Apply any 'Overwrite's for a 'GuildChannel' onto some 'Permissions' applyOverwrites :: GuildChannel -> Member -> Permissions -> Permissions applyOverwrites c m p | p .<=. administrator = allFlags | otherwise = let everyoneOverwrite = overwrites c ^. at (coerceSnowflake $ getID @Guild c) everyoneAllow = maybe noFlags (^. #allow) everyoneOverwrite everyoneDeny = maybe noFlags (^. #deny) everyoneOverwrite p' = p .-. everyoneDeny .+. everyoneAllow roleOverwriteIDs = map (coerceSnowflake @_ @Overwrite) . V.toList $ m ^. #roles roleOverwrites = mapMaybe (\oid -> overwrites c ^? ix oid) roleOverwriteIDs roleAllow = foldl' andFlags noFlags (roleOverwrites ^.. traversed % #allow) roleDeny = foldl' andFlags noFlags (roleOverwrites ^.. traversed % #deny) p'' = p' .-. roleDeny .+. roleAllow memberOverwrite = overwrites c ^. at (coerceSnowflake @_ @Overwrite $ getID @Member m) memberAllow = maybe noFlags (^. #allow) memberOverwrite memberDeny = maybe noFlags (^. #deny) memberOverwrite p''' = p'' .-. memberDeny .+. memberAllow in p''' -- | Things that 'Member's have 'Permissions' in class PermissionsIn a where -- | Calculate a 'Member'\'s 'Permissions' in something -- -- If permissions could not be calculated because something couldn't be found -- in the cache, this will return an empty set of permissions. Use -- 'permissionsIn'' if you want to handle cases where something might not exist -- in cache. permissionsIn :: a -> Member -> Permissions -- | A 'Member'\'s 'Permissions' in a channel are their roles and overwrites instance PermissionsIn (Guild, GuildChannel) where permissionsIn (g, c) m = applyOverwrites c m $ basePermissions g m -- | A 'Member'\'s 'Permissions' in a guild are just their roles instance PermissionsIn Guild where permissionsIn = basePermissions -- | A variant of 'PermissionsIn' that will use the cache/http. class PermissionsIn' a where -- | Calculate the permissions of something that has a 'User' id permissionsIn' :: (BotC r, HasID User u) => a -> u -> P.Sem r Permissions {- | A 'User''s 'Permissions' in a channel are their roles and overwrites This will fetch the guild from the cache or http as needed -} instance PermissionsIn' GuildChannel where permissionsIn' c (getID @User -> uid) = do m <- upgrade (getID @Guild c, coerceSnowflake @_ @Member uid) g <- upgrade (getID @Guild c) case (m, g) of (Just m, Just g') -> pure $ permissionsIn (g', c) m _cantFind -> pure noFlags -- | A 'Member'\'s 'Permissions' in a guild are just their roles instance PermissionsIn' Guild where permissionsIn' g (getID @User -> uid) = do m <- upgrade (getID @Guild g, coerceSnowflake @_ @Member uid) case m of Just m' -> pure $ permissionsIn g m' Nothing -> pure noFlags {- | A 'Member'\'s 'Permissions' in a channel are their roles and overwrites This will fetch the guild and channel from the cache or http as needed -} instance PermissionsIn' (Snowflake GuildChannel) where permissionsIn' cid u = do c <- upgrade cid case c of Just c' -> permissionsIn' c' u Nothing -> pure noFlags {- | A 'Member'\'s 'Permissions' in a guild are just their roles This will fetch the guild from the cache or http as needed -} instance PermissionsIn' (Snowflake Guild) where permissionsIn' gid u = do g <- upgrade gid case g of Just g' -> permissionsIn' g' u Nothing -> pure noFlags