-- | Permission utilities module Calamity.Utils.Permissions ( basePermissions , applyOverwrites , PermissionsIn(..) , PermissionsIn'(..) ) where import Calamity.Client.Types 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 Control.Lens import Data.Flags import qualified Data.Vector.Unboxing as V import qualified Polysemy as P import Data.Foldable (Foldable(foldl')) -- | 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 rolePerms = g ^.. #roles . foldMap ix (V.toList $ m ^. #roles) . #permissions perms = foldl' andFlags noFlags (permsEveryone:rolePerms) in if perms .<=. administrator then allFlags else perms -- | 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 = c ^. #permissionOverwrites . at (coerceSnowflake $ getID @Guild c) everyoneAllow = maybe noFlags (^. #allow) everyoneOverwrite everyoneDeny = maybe noFlags (^. #deny) everyoneOverwrite p' = p .-. everyoneDeny .+. everyoneAllow roleOverwrites = c ^.. #permissionOverwrites . foldMap ix (map (coerceSnowflake @_ @Overwrite) . V.toList $ m ^. #roles) roleAllow = foldl' andFlags noFlags (roleOverwrites ^.. traverse . #allow) roleDeny = foldl' andFlags noFlags (roleOverwrites ^.. traverse . #deny) p'' = p' .-. roleDeny .+. roleAllow memberOverwrite = c ^. #permissionOverwrites . 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 g m = basePermissions g m -- | 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