-- | 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 :: Guild -> Member -> Permissions
basePermissions Guild
g Member
m
  | Guild
g Guild
-> Optic' A_Lens NoIx Guild (Snowflake User) -> Snowflake User
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Guild (Snowflake User)
#ownerID Snowflake User -> Snowflake User -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== Member -> Snowflake User
forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID Member
m = Permissions
forall (α :: OpticKind). BoundedFlags α => α
allFlags
  | Bool
otherwise =
      let everyoneRole :: Maybe (IxValue (SnowflakeMap Role))
everyoneRole = Guild
g Guild
-> Optic' A_Lens NoIx Guild (Maybe (IxValue (SnowflakeMap Role)))
-> Maybe (IxValue (SnowflakeMap Role))
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx Guild Guild (SnowflakeMap Role) (SnowflakeMap Role)
#roles Optic
  A_Lens NoIx Guild Guild (SnowflakeMap Role) (SnowflakeMap Role)
-> Optic
     A_Lens
     NoIx
     (SnowflakeMap Role)
     (SnowflakeMap Role)
     (Maybe (IxValue (SnowflakeMap Role)))
     (Maybe (IxValue (SnowflakeMap Role)))
-> Optic' A_Lens NoIx Guild (Maybe (IxValue (SnowflakeMap Role)))
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (SnowflakeMap Role)
-> Optic
     A_Lens
     NoIx
     (SnowflakeMap Role)
     (SnowflakeMap Role)
     (Maybe (IxValue (SnowflakeMap Role)))
     (Maybe (IxValue (SnowflakeMap Role)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (Snowflake Guild -> Snowflake Role
forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Guild -> Snowflake Role)
-> Snowflake Guild -> Snowflake Role
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Guild Guild
g)
          permsEveryone :: Permissions
permsEveryone = Permissions
-> (IxValue (SnowflakeMap Role) -> Permissions)
-> Maybe (IxValue (SnowflakeMap Role))
-> Permissions
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Permissions
forall (α :: OpticKind). Flags α => α
noFlags (IxValue (SnowflakeMap Role)
-> Optic
     A_Lens
     NoIx
     (IxValue (SnowflakeMap Role))
     (IxValue (SnowflakeMap Role))
     Permissions
     Permissions
-> Permissions
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (IxValue (SnowflakeMap Role))
  (IxValue (SnowflakeMap Role))
  Permissions
  Permissions
#permissions) Maybe (IxValue (SnowflakeMap Role))
everyoneRole
          roleIDs :: [Index (SnowflakeMap Role)]
roleIDs = Vector (Index (SnowflakeMap Role)) -> [Index (SnowflakeMap Role)]
forall (a :: OpticKind). Unboxable a => Vector a -> [a]
V.toList (Vector (Index (SnowflakeMap Role)) -> [Index (SnowflakeMap Role)])
-> Vector (Index (SnowflakeMap Role))
-> [Index (SnowflakeMap Role)]
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Member
m Member
-> Optic' A_Lens NoIx Member (Vector (Index (SnowflakeMap Role)))
-> Vector (Index (SnowflakeMap Role))
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Member (Vector (Index (SnowflakeMap Role)))
#roles
          rolePerms :: [Permissions]
rolePerms = (Index (SnowflakeMap Role) -> Maybe Permissions)
-> [Index (SnowflakeMap Role)] -> [Permissions]
forall (a :: OpticKind) (b :: OpticKind).
(a -> Maybe b) -> [a] -> [b]
mapMaybe (\Index (SnowflakeMap Role)
rid -> Guild
g Guild
-> Optic' An_AffineTraversal NoIx Guild Permissions
-> Maybe Permissions
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic
  A_Lens NoIx Guild Guild (SnowflakeMap Role) (SnowflakeMap Role)
#roles Optic
  A_Lens NoIx Guild Guild (SnowflakeMap Role) (SnowflakeMap Role)
-> Optic
     (IxKind (SnowflakeMap Role))
     NoIx
     (SnowflakeMap Role)
     (SnowflakeMap Role)
     (IxValue (SnowflakeMap Role))
     (IxValue (SnowflakeMap Role))
-> Optic
     An_AffineTraversal
     NoIx
     Guild
     Guild
     (IxValue (SnowflakeMap Role))
     (IxValue (SnowflakeMap Role))
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (SnowflakeMap Role)
-> Optic
     (IxKind (SnowflakeMap Role))
     NoIx
     (SnowflakeMap Role)
     (SnowflakeMap Role)
     (IxValue (SnowflakeMap Role))
     (IxValue (SnowflakeMap Role))
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (SnowflakeMap Role)
rid Optic
  An_AffineTraversal
  NoIx
  Guild
  Guild
  (IxValue (SnowflakeMap Role))
  (IxValue (SnowflakeMap Role))
-> Optic
     A_Lens
     NoIx
     (IxValue (SnowflakeMap Role))
     (IxValue (SnowflakeMap Role))
     Permissions
     Permissions
-> Optic' An_AffineTraversal NoIx Guild Permissions
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue (SnowflakeMap Role))
  (IxValue (SnowflakeMap Role))
  Permissions
  Permissions
#permissions) [Index (SnowflakeMap Role)]
roleIDs
          perms :: Permissions
perms = (Permissions -> Permissions -> Permissions)
-> Permissions -> [Permissions] -> Permissions
forall (b :: OpticKind) (a :: OpticKind).
(b -> a -> b) -> b -> [a] -> b
forall (t :: OpticKind -> OpticKind) (b :: OpticKind)
       (a :: OpticKind).
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
andFlags Permissions
forall (α :: OpticKind). Flags α => α
noFlags (Permissions
permsEveryone Permissions -> [Permissions] -> [Permissions]
forall (a :: OpticKind). a -> [a] -> [a]
: [Permissions]
rolePerms)
       in if Permissions
perms Permissions -> Permissions -> Bool
forall (α :: OpticKind). Flags α => α -> α -> Bool
.<=. Permissions
administrator
            then Permissions
forall (α :: OpticKind). BoundedFlags α => α
allFlags
            else Permissions
perms

overwrites :: GuildChannel -> SM.SnowflakeMap Overwrite
overwrites :: GuildChannel -> SnowflakeMap Overwrite
overwrites (GuildTextChannel TextChannel
c) = TextChannel
c TextChannel
-> Optic' A_Lens NoIx TextChannel (SnowflakeMap Overwrite)
-> SnowflakeMap Overwrite
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TextChannel (SnowflakeMap Overwrite)
#permissionOverwrites
overwrites (GuildVoiceChannel VoiceChannel
c) = VoiceChannel
c VoiceChannel
-> Optic' A_Lens NoIx VoiceChannel (SnowflakeMap Overwrite)
-> SnowflakeMap Overwrite
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx VoiceChannel (SnowflakeMap Overwrite)
#permissionOverwrites
overwrites (GuildCategory Category
c) = Category
c Category
-> Optic' A_Lens NoIx Category (SnowflakeMap Overwrite)
-> SnowflakeMap Overwrite
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Category (SnowflakeMap Overwrite)
#permissionOverwrites
overwrites GuildChannel
_ = SnowflakeMap Overwrite
forall (a :: OpticKind). SnowflakeMap a
SM.empty

-- | Apply any 'Overwrite's for a 'GuildChannel' onto some 'Permissions'
applyOverwrites :: GuildChannel -> Member -> Permissions -> Permissions
applyOverwrites :: GuildChannel -> Member -> Permissions -> Permissions
applyOverwrites GuildChannel
c Member
m Permissions
p
  | Permissions
p Permissions -> Permissions -> Bool
forall (α :: OpticKind). Flags α => α -> α -> Bool
.<=. Permissions
administrator = Permissions
forall (α :: OpticKind). BoundedFlags α => α
allFlags
  | Bool
otherwise =
      let everyoneOverwrite :: Maybe Overwrite
everyoneOverwrite = GuildChannel -> SnowflakeMap Overwrite
overwrites GuildChannel
c SnowflakeMap Overwrite
-> Optic' A_Lens NoIx (SnowflakeMap Overwrite) (Maybe Overwrite)
-> Maybe Overwrite
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Index (SnowflakeMap Overwrite)
-> Lens'
     (SnowflakeMap Overwrite) (Maybe (IxValue (SnowflakeMap Overwrite)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (Snowflake Guild -> Snowflake Overwrite
forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake (Snowflake Guild -> Snowflake Overwrite)
-> Snowflake Guild -> Snowflake Overwrite
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Guild GuildChannel
c)
          everyoneAllow :: Permissions
everyoneAllow = Permissions
-> (Overwrite -> Permissions) -> Maybe Overwrite -> Permissions
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Permissions
forall (α :: OpticKind). Flags α => α
noFlags (Overwrite
-> Optic' A_Lens NoIx Overwrite Permissions -> Permissions
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Overwrite Permissions
#allow) Maybe Overwrite
everyoneOverwrite
          everyoneDeny :: Permissions
everyoneDeny = Permissions
-> (Overwrite -> Permissions) -> Maybe Overwrite -> Permissions
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Permissions
forall (α :: OpticKind). Flags α => α
noFlags (Overwrite
-> Optic' A_Lens NoIx Overwrite Permissions -> Permissions
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Overwrite Permissions
#deny) Maybe Overwrite
everyoneOverwrite
          p' :: Permissions
p' = Permissions
p Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
.-. Permissions
everyoneDeny Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
.+. Permissions
everyoneAllow
          roleOverwriteIDs :: [Snowflake Overwrite]
roleOverwriteIDs = (Snowflake Role -> Snowflake Overwrite)
-> [Snowflake Role] -> [Snowflake Overwrite]
forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake @_ @Overwrite) ([Snowflake Role] -> [Snowflake Overwrite])
-> (Vector (Snowflake Role) -> [Snowflake Role])
-> Vector (Snowflake Role)
-> [Snowflake Overwrite]
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Vector (Snowflake Role) -> [Snowflake Role]
forall (a :: OpticKind). Unboxable a => Vector a -> [a]
V.toList (Vector (Snowflake Role) -> [Snowflake Overwrite])
-> Vector (Snowflake Role) -> [Snowflake Overwrite]
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Member
m Member
-> Optic' A_Lens NoIx Member (Vector (Snowflake Role))
-> Vector (Snowflake Role)
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Member (Vector (Snowflake Role))
#roles
          roleOverwrites :: [Overwrite]
roleOverwrites = (Snowflake Overwrite -> Maybe Overwrite)
-> [Snowflake Overwrite] -> [Overwrite]
forall (a :: OpticKind) (b :: OpticKind).
(a -> Maybe b) -> [a] -> [b]
mapMaybe (\Snowflake Overwrite
oid -> GuildChannel -> SnowflakeMap Overwrite
overwrites GuildChannel
c SnowflakeMap Overwrite
-> Optic'
     An_AffineTraversal NoIx (SnowflakeMap Overwrite) Overwrite
-> Maybe Overwrite
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Index (SnowflakeMap Overwrite)
-> Optic'
     (IxKind (SnowflakeMap Overwrite))
     NoIx
     (SnowflakeMap Overwrite)
     (IxValue (SnowflakeMap Overwrite))
forall (m :: OpticKind).
Ixed m =>
Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (SnowflakeMap Overwrite)
Snowflake Overwrite
oid) [Snowflake Overwrite]
roleOverwriteIDs
          roleAllow :: Permissions
roleAllow = (Permissions -> Permissions -> Permissions)
-> Permissions -> [Permissions] -> Permissions
forall (b :: OpticKind) (a :: OpticKind).
(b -> a -> b) -> b -> [a] -> b
forall (t :: OpticKind -> OpticKind) (b :: OpticKind)
       (a :: OpticKind).
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
andFlags Permissions
forall (α :: OpticKind). Flags α => α
noFlags ([Overwrite]
roleOverwrites [Overwrite]
-> Optic' A_Traversal NoIx [Overwrite] Permissions -> [Permissions]
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal [Overwrite] [Overwrite] Overwrite Overwrite
forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed Traversal [Overwrite] [Overwrite] Overwrite Overwrite
-> Optic' A_Lens NoIx Overwrite Permissions
-> Optic' A_Traversal NoIx [Overwrite] Permissions
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens NoIx Overwrite Permissions
#allow)
          roleDeny :: Permissions
roleDeny = (Permissions -> Permissions -> Permissions)
-> Permissions -> [Permissions] -> Permissions
forall (b :: OpticKind) (a :: OpticKind).
(b -> a -> b) -> b -> [a] -> b
forall (t :: OpticKind -> OpticKind) (b :: OpticKind)
       (a :: OpticKind).
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
andFlags Permissions
forall (α :: OpticKind). Flags α => α
noFlags ([Overwrite]
roleOverwrites [Overwrite]
-> Optic' A_Traversal NoIx [Overwrite] Permissions -> [Permissions]
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal [Overwrite] [Overwrite] Overwrite Overwrite
forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed Traversal [Overwrite] [Overwrite] Overwrite Overwrite
-> Optic' A_Lens NoIx Overwrite Permissions
-> Optic' A_Traversal NoIx [Overwrite] Permissions
forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens NoIx Overwrite Permissions
#deny)
          p'' :: Permissions
p'' = Permissions
p' Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
.-. Permissions
roleDeny Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
.+. Permissions
roleAllow
          memberOverwrite :: Maybe Overwrite
memberOverwrite = GuildChannel -> SnowflakeMap Overwrite
overwrites GuildChannel
c SnowflakeMap Overwrite
-> Optic' A_Lens NoIx (SnowflakeMap Overwrite) (Maybe Overwrite)
-> Maybe Overwrite
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Index (SnowflakeMap Overwrite)
-> Lens'
     (SnowflakeMap Overwrite) (Maybe (IxValue (SnowflakeMap Overwrite)))
forall (m :: OpticKind).
At m =>
Index m -> Lens' m (Maybe (IxValue m))
at (forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake @_ @Overwrite (Snowflake Member -> Snowflake Overwrite)
-> Snowflake Member -> Snowflake Overwrite
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Member Member
m)
          memberAllow :: Permissions
memberAllow = Permissions
-> (Overwrite -> Permissions) -> Maybe Overwrite -> Permissions
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Permissions
forall (α :: OpticKind). Flags α => α
noFlags (Overwrite
-> Optic' A_Lens NoIx Overwrite Permissions -> Permissions
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Overwrite Permissions
#allow) Maybe Overwrite
memberOverwrite
          memberDeny :: Permissions
memberDeny = Permissions
-> (Overwrite -> Permissions) -> Maybe Overwrite -> Permissions
forall (b :: OpticKind) (a :: OpticKind).
b -> (a -> b) -> Maybe a -> b
maybe Permissions
forall (α :: OpticKind). Flags α => α
noFlags (Overwrite
-> Optic' A_Lens NoIx Overwrite Permissions -> Permissions
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Overwrite Permissions
#deny) Maybe Overwrite
memberOverwrite
          p''' :: Permissions
p''' = Permissions
p'' Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
.-. Permissions
memberDeny Permissions -> Permissions -> Permissions
forall (α :: OpticKind). Flags α => α -> α -> α
.+. Permissions
memberAllow
       in Permissions
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 :: (Guild, GuildChannel) -> Member -> Permissions
permissionsIn (Guild
g, GuildChannel
c) Member
m = GuildChannel -> Member -> Permissions -> Permissions
applyOverwrites GuildChannel
c Member
m (Permissions -> Permissions) -> Permissions -> Permissions
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild -> Member -> Permissions
basePermissions Guild
g Member
m

-- | A 'Member'\'s 'Permissions' in a guild are just their roles
instance PermissionsIn Guild where
  permissionsIn :: Guild -> Member -> Permissions
permissionsIn = Guild -> Member -> Permissions
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' :: forall (r :: EffectRow) (u :: OpticKind).
(BotC r, HasID User u) =>
GuildChannel -> u -> Sem r Permissions
permissionsIn' GuildChannel
c (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User -> Snowflake User
uid) = do
    Maybe Member
m <- (Snowflake Guild, Snowflake Member) -> Sem r (Maybe Member)
forall (r :: EffectRow).
BotC r =>
(Snowflake Guild, Snowflake Member) -> Sem r (Maybe Member)
forall (a :: OpticKind) (ids :: OpticKind) (r :: EffectRow).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Guild GuildChannel
c, forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake @_ @Member Snowflake User
uid)
    Maybe Guild
g <- Snowflake Guild -> Sem r (Maybe Guild)
forall (r :: EffectRow).
BotC r =>
Snowflake Guild -> Sem r (Maybe Guild)
forall (a :: OpticKind) (ids :: OpticKind) (r :: EffectRow).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Guild GuildChannel
c)
    case (Maybe Member
m, Maybe Guild
g) of
      (Just Member
m, Just Guild
g') -> Permissions -> Sem r Permissions
forall (a :: OpticKind). a -> Sem r a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Permissions -> Sem r Permissions)
-> Permissions -> Sem r Permissions
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ (Guild, GuildChannel) -> Member -> Permissions
forall (a :: OpticKind).
PermissionsIn a =>
a -> Member -> Permissions
permissionsIn (Guild
g', GuildChannel
c) Member
m
      (Maybe Member, Maybe Guild)
_cantFind -> Permissions -> Sem r Permissions
forall (a :: OpticKind). a -> Sem r a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Permissions
forall (α :: OpticKind). Flags α => α
noFlags

-- | A 'Member'\'s 'Permissions' in a guild are just their roles
instance PermissionsIn' Guild where
  permissionsIn' :: forall (r :: EffectRow) (u :: OpticKind).
(BotC r, HasID User u) =>
Guild -> u -> Sem r Permissions
permissionsIn' Guild
g (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User -> Snowflake User
uid) = do
    Maybe Member
m <- (Snowflake Guild, Snowflake Member) -> Sem r (Maybe Member)
forall (r :: EffectRow).
BotC r =>
(Snowflake Guild, Snowflake Member) -> Sem r (Maybe Member)
forall (a :: OpticKind) (ids :: OpticKind) (r :: EffectRow).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Guild Guild
g, forall (a :: OpticKind) (b :: OpticKind).
Snowflake a -> Snowflake b
coerceSnowflake @_ @Member Snowflake User
uid)
    case Maybe Member
m of
      Just Member
m' -> Permissions -> Sem r Permissions
forall (a :: OpticKind). a -> Sem r a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Permissions -> Sem r Permissions)
-> Permissions -> Sem r Permissions
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Guild -> Member -> Permissions
forall (a :: OpticKind).
PermissionsIn a =>
a -> Member -> Permissions
permissionsIn Guild
g Member
m'
      Maybe Member
Nothing -> Permissions -> Sem r Permissions
forall (a :: OpticKind). a -> Sem r a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Permissions
forall (α :: OpticKind). Flags α => α
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' :: forall (r :: EffectRow) (u :: OpticKind).
(BotC r, HasID User u) =>
Snowflake GuildChannel -> u -> Sem r Permissions
permissionsIn' Snowflake GuildChannel
cid u
u = do
    Maybe GuildChannel
c <- Snowflake GuildChannel -> Sem r (Maybe GuildChannel)
forall (r :: EffectRow).
BotC r =>
Snowflake GuildChannel -> Sem r (Maybe GuildChannel)
forall (a :: OpticKind) (ids :: OpticKind) (r :: EffectRow).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade Snowflake GuildChannel
cid
    case Maybe GuildChannel
c of
      Just GuildChannel
c' -> GuildChannel -> u -> Sem r Permissions
forall (r :: EffectRow) (u :: OpticKind).
(BotC r, HasID User u) =>
GuildChannel -> u -> Sem r Permissions
forall (a :: OpticKind) (r :: EffectRow) (u :: OpticKind).
(PermissionsIn' a, BotC r, HasID User u) =>
a -> u -> Sem r Permissions
permissionsIn' GuildChannel
c' u
u
      Maybe GuildChannel
Nothing -> Permissions -> Sem r Permissions
forall (a :: OpticKind). a -> Sem r a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Permissions
forall (α :: OpticKind). Flags α => α
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' :: forall (r :: EffectRow) (u :: OpticKind).
(BotC r, HasID User u) =>
Snowflake Guild -> u -> Sem r Permissions
permissionsIn' Snowflake Guild
gid u
u = do
    Maybe Guild
g <- Snowflake Guild -> Sem r (Maybe Guild)
forall (r :: EffectRow).
BotC r =>
Snowflake Guild -> Sem r (Maybe Guild)
forall (a :: OpticKind) (ids :: OpticKind) (r :: EffectRow).
(Upgradeable a ids, BotC r) =>
ids -> Sem r (Maybe a)
upgrade Snowflake Guild
gid
    case Maybe Guild
g of
      Just Guild
g' -> Guild -> u -> Sem r Permissions
forall (r :: EffectRow) (u :: OpticKind).
(BotC r, HasID User u) =>
Guild -> u -> Sem r Permissions
forall (a :: OpticKind) (r :: EffectRow) (u :: OpticKind).
(PermissionsIn' a, BotC r, HasID User u) =>
a -> u -> Sem r Permissions
permissionsIn' Guild
g' u
u
      Maybe Guild
Nothing -> Permissions -> Sem r Permissions
forall (a :: OpticKind). a -> Sem r a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure Permissions
forall (α :: OpticKind). Flags α => α
noFlags