{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

-- The above pragma is to ignore unused `genSingletons` definitions of promoted
-- constructors

module Wire.API.Team.Permission
  ( -- * Permissions
    Permissions (..),
    newPermissions,
    fullPermissions,
    noPermissions,
    serviceWhitelistPermissions,

    -- * Permissions
    Perm (..),
    SPerm (..),
    permsToInt,
    intToPerms,
    permToInt,
    intToPerm,
  )
where

import Cassandra qualified as Cql
import Control.Error.Util qualified as Err
import Control.Lens ((?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Bits (testBit, (.|.))
import Data.OpenApi qualified as S
import Data.Schema
import Data.Set qualified as Set
import Data.Singletons.Base.TH
import Imports
import Test.QuickCheck (oneof)
import Wire.API.Util.Aeson (CustomEncoded (..))
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- Permissions

data Permissions = Permissions
  { -- | User's permissions
    Permissions -> Set Perm
self :: Set Perm,
    -- | Permissions this user is allowed to grant others
    Permissions -> Set Perm
copy :: Set Perm
  }
  deriving stock (Permissions -> Permissions -> Bool
(Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool) -> Eq Permissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
/= :: Permissions -> Permissions -> Bool
Eq, Eq Permissions
Eq Permissions =>
(Permissions -> Permissions -> Ordering)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Permissions)
-> (Permissions -> Permissions -> Permissions)
-> Ord Permissions
Permissions -> Permissions -> Bool
Permissions -> Permissions -> Ordering
Permissions -> Permissions -> Permissions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Permissions -> Permissions -> Ordering
compare :: Permissions -> Permissions -> Ordering
$c< :: Permissions -> Permissions -> Bool
< :: Permissions -> Permissions -> Bool
$c<= :: Permissions -> Permissions -> Bool
<= :: Permissions -> Permissions -> Bool
$c> :: Permissions -> Permissions -> Bool
> :: Permissions -> Permissions -> Bool
$c>= :: Permissions -> Permissions -> Bool
>= :: Permissions -> Permissions -> Bool
$cmax :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
min :: Permissions -> Permissions -> Permissions
Ord, Int -> Permissions -> ShowS
[Permissions] -> ShowS
Permissions -> String
(Int -> Permissions -> ShowS)
-> (Permissions -> String)
-> ([Permissions] -> ShowS)
-> Show Permissions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Permissions -> ShowS
showsPrec :: Int -> Permissions -> ShowS
$cshow :: Permissions -> String
show :: Permissions -> String
$cshowList :: [Permissions] -> ShowS
showList :: [Permissions] -> ShowS
Show, (forall x. Permissions -> Rep Permissions x)
-> (forall x. Rep Permissions x -> Permissions)
-> Generic Permissions
forall x. Rep Permissions x -> Permissions
forall x. Permissions -> Rep Permissions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Permissions -> Rep Permissions x
from :: forall x. Permissions -> Rep Permissions x
$cto :: forall x. Rep Permissions x -> Permissions
to :: forall x. Rep Permissions x -> Permissions
Generic)
  deriving (Value -> Parser [Permissions]
Value -> Parser Permissions
(Value -> Parser Permissions)
-> (Value -> Parser [Permissions]) -> FromJSON Permissions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Permissions
parseJSON :: Value -> Parser Permissions
$cparseJSONList :: Value -> Parser [Permissions]
parseJSONList :: Value -> Parser [Permissions]
FromJSON, [Permissions] -> Value
[Permissions] -> Encoding
Permissions -> Value
Permissions -> Encoding
(Permissions -> Value)
-> (Permissions -> Encoding)
-> ([Permissions] -> Value)
-> ([Permissions] -> Encoding)
-> ToJSON Permissions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Permissions -> Value
toJSON :: Permissions -> Value
$ctoEncoding :: Permissions -> Encoding
toEncoding :: Permissions -> Encoding
$ctoJSONList :: [Permissions] -> Value
toJSONList :: [Permissions] -> Value
$ctoEncodingList :: [Permissions] -> Encoding
toEncodingList :: [Permissions] -> Encoding
ToJSON, Typeable Permissions
Typeable Permissions =>
(Proxy Permissions -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Permissions
Proxy Permissions -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Permissions -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Permissions -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Permissions)

permissionsSchema :: ValueSchema NamedSwaggerDoc Permissions
permissionsSchema :: ValueSchema NamedSwaggerDoc Permissions
permissionsSchema =
  Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc Permissions
-> ValueSchema NamedSwaggerDoc Permissions
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"Permissions" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
docs) (ObjectSchema SwaggerDoc Permissions
 -> ValueSchema NamedSwaggerDoc Permissions)
-> ObjectSchema SwaggerDoc Permissions
-> ValueSchema NamedSwaggerDoc Permissions
forall a b. (a -> b) -> a -> b
$
    Set Perm -> Set Perm -> Permissions
Permissions
      (Set Perm -> Set Perm -> Permissions)
-> SchemaP SwaggerDoc Object [Pair] Permissions (Set Perm)
-> SchemaP
     SwaggerDoc Object [Pair] Permissions (Set Perm -> Permissions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set Perm -> Word64
permsToInt (Set Perm -> Word64)
-> (Permissions -> Set Perm) -> Permissions -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Set Perm
self) (Permissions -> Word64)
-> SchemaP SwaggerDoc Object [Pair] Word64 (Set Perm)
-> SchemaP SwaggerDoc Object [Pair] Permissions (Set Perm)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Word64 (Set Perm)
-> SchemaP SwaggerDoc Object [Pair] Word64 (Set Perm)
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"self" NamedSwaggerDoc -> NamedSwaggerDoc
selfDoc (Word64 -> Set Perm
intToPerms (Word64 -> Set Perm)
-> SchemaP NamedSwaggerDoc Value Value Word64 Word64
-> SchemaP NamedSwaggerDoc Value Value Word64 (Set Perm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaP NamedSwaggerDoc Value Value Word64 Word64
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
      SchemaP
  SwaggerDoc Object [Pair] Permissions (Set Perm -> Permissions)
-> SchemaP SwaggerDoc Object [Pair] Permissions (Set Perm)
-> ObjectSchema SwaggerDoc Permissions
forall a b.
SchemaP SwaggerDoc Object [Pair] Permissions (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Permissions a
-> SchemaP SwaggerDoc Object [Pair] Permissions b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set Perm -> Word64
permsToInt (Set Perm -> Word64)
-> (Permissions -> Set Perm) -> Permissions -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Permissions -> Set Perm
copy) (Permissions -> Word64)
-> SchemaP SwaggerDoc Object [Pair] Word64 (Set Perm)
-> SchemaP SwaggerDoc Object [Pair] Permissions (Set Perm)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Word64 (Set Perm)
-> SchemaP SwaggerDoc Object [Pair] Word64 (Set Perm)
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"copy" NamedSwaggerDoc -> NamedSwaggerDoc
copyDoc (Word64 -> Set Perm
intToPerms (Word64 -> Set Perm)
-> SchemaP NamedSwaggerDoc Value Value Word64 Word64
-> SchemaP NamedSwaggerDoc Value Value Word64 (Set Perm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaP NamedSwaggerDoc Value Value Word64 Word64
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
  where
    selfDoc :: NamedSwaggerDoc -> NamedSwaggerDoc
selfDoc = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Permissions that the user has"
    copyDoc :: NamedSwaggerDoc -> NamedSwaggerDoc
copyDoc = (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Permissions that this user is able to grant others"
    docs :: Text
docs =
      Text
"This is just a complicated way of representing a team role.  self and copy \
      \always have to contain the same integer, and only the following integers \
      \are allowed: 1025 (partner), 1587 (member), 5951 (admin), 8191 (owner). \
      \Unit tests of the galley-types package in wire-server contain an authoritative \
      \list."

instance ToSchema Permissions where
  schema :: ValueSchema NamedSwaggerDoc Permissions
schema = ValueSchema NamedSwaggerDoc Permissions
-> (Permissions -> Parser Permissions)
-> ValueSchema NamedSwaggerDoc Permissions
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
withParser ValueSchema NamedSwaggerDoc Permissions
permissionsSchema ((Permissions -> Parser Permissions)
 -> ValueSchema NamedSwaggerDoc Permissions)
-> (Permissions -> Parser Permissions)
-> ValueSchema NamedSwaggerDoc Permissions
forall a b. (a -> b) -> a -> b
$ \(Permissions Set Perm
s Set Perm
d) ->
    case Set Perm -> Set Perm -> Maybe Permissions
newPermissions Set Perm
s Set Perm
d of
      Maybe Permissions
Nothing -> String -> Parser Permissions
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid permissions"
      Just Permissions
ps -> Permissions -> Parser Permissions
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Permissions
ps

instance Arbitrary Permissions where
  arbitrary :: Gen Permissions
arbitrary =
    Gen Permissions
-> (Permissions -> Gen Permissions)
-> Maybe Permissions
-> Gen Permissions
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Gen Permissions
forall a. HasCallStack => String -> a
error String
"instance Arbitrary Permissions") Permissions -> Gen Permissions
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Permissions -> Gen Permissions)
-> Gen (Maybe Permissions) -> Gen Permissions
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
      Set Perm
selfperms <- [Gen (Set Perm)] -> Gen (Set Perm)
forall a. [Gen a] -> Gen a
oneof ([Gen (Set Perm)] -> Gen (Set Perm))
-> [Gen (Set Perm)] -> Gen (Set Perm)
forall a b. (a -> b) -> a -> b
$ (Word64 -> Gen (Set Perm)) -> [Word64] -> [Gen (Set Perm)]
forall a b. (a -> b) -> [a] -> [b]
map (Set Perm -> Gen (Set Perm)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Perm -> Gen (Set Perm))
-> (Word64 -> Set Perm) -> Word64 -> Gen (Set Perm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Set Perm
intToPerms) [Word64
1025, Word64
1587, Word64
5951, Word64
8191]
      Set Perm
copyperms <- Set Perm -> Set Perm -> Set Perm
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set Perm
selfperms (Set Perm -> Set Perm) -> Gen (Set Perm) -> Gen (Set Perm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set Perm)
forall a. Arbitrary a => Gen a
arbitrary
      Maybe Permissions -> Gen (Maybe Permissions)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Permissions -> Gen (Maybe Permissions))
-> Maybe Permissions -> Gen (Maybe Permissions)
forall a b. (a -> b) -> a -> b
$ Set Perm -> Set Perm -> Maybe Permissions
newPermissions Set Perm
selfperms Set Perm
copyperms

newPermissions ::
  -- | User's permissions
  Set Perm ->
  -- | Permissions that the user will be able to
  --   grant to other users (must be a subset)
  Set Perm ->
  Maybe Permissions
newPermissions :: Set Perm -> Set Perm -> Maybe Permissions
newPermissions Set Perm
a Set Perm
b
  | Set Perm
b Set Perm -> Set Perm -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Perm
a = Permissions -> Maybe Permissions
forall a. a -> Maybe a
Just (Set Perm -> Set Perm -> Permissions
Permissions Set Perm
a Set Perm
b)
  | Bool
otherwise = Maybe Permissions
forall a. Maybe a
Nothing

fullPermissions :: Permissions
fullPermissions :: Permissions
fullPermissions = let p :: Set Perm
p = Word64 -> Set Perm
intToPerms Word64
forall a. Bounded a => a
maxBound in Set Perm -> Set Perm -> Permissions
Permissions Set Perm
p Set Perm
p

noPermissions :: Permissions
noPermissions :: Permissions
noPermissions = Set Perm -> Set Perm -> Permissions
Permissions Set Perm
forall a. Monoid a => a
mempty Set Perm
forall a. Monoid a => a
mempty

-- | Permissions that a user needs to be considered a "service whitelist
-- admin" (can add and remove services from the whitelist).
serviceWhitelistPermissions :: Set Perm
serviceWhitelistPermissions :: Set Perm
serviceWhitelistPermissions =
  [Perm] -> Set Perm
forall a. Ord a => [a] -> Set a
Set.fromList
    [ Perm
AddTeamMember,
      Perm
RemoveTeamMember,
      Perm
AddRemoveConvMember,
      Perm
SetTeamData
    ]

--------------------------------------------------------------------------------
-- Perm

-- | Team-level permission.  Analog to conversation-level 'Action'.
data Perm
  = CreateConversation
  | -- NOTE: This may get overruled by conv level checks in case those are more restrictive
    -- We currently cannot get rid of this team-level permission in favor of the conv-level action
    -- because it is used for e.g. for the team role 'RoleExternalPartner'
    DeleteConversation
  | AddTeamMember
  | RemoveTeamMember
  | -- NOTE: This may get overruled by conv level checks in case those are more restrictive
    -- We currently cannot get rid of this team-level permission in favor of the conv-level action
    -- because it is used for e.g. for the team role 'RoleExternalPartner'
    AddRemoveConvMember
  | -- NOTE: This may get overruled by conv level checks in case those are more restrictive
    -- We currently cannot get rid of this team-level permission in favor of the conv-level action
    -- because it is used for e.g. for the team role 'RoleExternalPartner'
    ModifyConvName
  | GetBilling
  | SetBilling
  | SetTeamData
  | GetMemberPermissions
  | SetMemberPermissions
  | GetTeamConversations
  | DeleteTeam
  -- FUTUREWORK: make the verbs in the roles more consistent
  -- (CRUD vs. Add,Remove vs; Get,Set vs. Create,Delete etc).
  -- If you ever think about adding a new permission flag,
  -- read Note [team roles] first.
  deriving stock (Perm -> Perm -> Bool
(Perm -> Perm -> Bool) -> (Perm -> Perm -> Bool) -> Eq Perm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Perm -> Perm -> Bool
== :: Perm -> Perm -> Bool
$c/= :: Perm -> Perm -> Bool
/= :: Perm -> Perm -> Bool
Eq, Eq Perm
Eq Perm =>
(Perm -> Perm -> Ordering)
-> (Perm -> Perm -> Bool)
-> (Perm -> Perm -> Bool)
-> (Perm -> Perm -> Bool)
-> (Perm -> Perm -> Bool)
-> (Perm -> Perm -> Perm)
-> (Perm -> Perm -> Perm)
-> Ord Perm
Perm -> Perm -> Bool
Perm -> Perm -> Ordering
Perm -> Perm -> Perm
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Perm -> Perm -> Ordering
compare :: Perm -> Perm -> Ordering
$c< :: Perm -> Perm -> Bool
< :: Perm -> Perm -> Bool
$c<= :: Perm -> Perm -> Bool
<= :: Perm -> Perm -> Bool
$c> :: Perm -> Perm -> Bool
> :: Perm -> Perm -> Bool
$c>= :: Perm -> Perm -> Bool
>= :: Perm -> Perm -> Bool
$cmax :: Perm -> Perm -> Perm
max :: Perm -> Perm -> Perm
$cmin :: Perm -> Perm -> Perm
min :: Perm -> Perm -> Perm
Ord, Int -> Perm -> ShowS
[Perm] -> ShowS
Perm -> String
(Int -> Perm -> ShowS)
-> (Perm -> String) -> ([Perm] -> ShowS) -> Show Perm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Perm -> ShowS
showsPrec :: Int -> Perm -> ShowS
$cshow :: Perm -> String
show :: Perm -> String
$cshowList :: [Perm] -> ShowS
showList :: [Perm] -> ShowS
Show, Int -> Perm
Perm -> Int
Perm -> [Perm]
Perm -> Perm
Perm -> Perm -> [Perm]
Perm -> Perm -> Perm -> [Perm]
(Perm -> Perm)
-> (Perm -> Perm)
-> (Int -> Perm)
-> (Perm -> Int)
-> (Perm -> [Perm])
-> (Perm -> Perm -> [Perm])
-> (Perm -> Perm -> [Perm])
-> (Perm -> Perm -> Perm -> [Perm])
-> Enum Perm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Perm -> Perm
succ :: Perm -> Perm
$cpred :: Perm -> Perm
pred :: Perm -> Perm
$ctoEnum :: Int -> Perm
toEnum :: Int -> Perm
$cfromEnum :: Perm -> Int
fromEnum :: Perm -> Int
$cenumFrom :: Perm -> [Perm]
enumFrom :: Perm -> [Perm]
$cenumFromThen :: Perm -> Perm -> [Perm]
enumFromThen :: Perm -> Perm -> [Perm]
$cenumFromTo :: Perm -> Perm -> [Perm]
enumFromTo :: Perm -> Perm -> [Perm]
$cenumFromThenTo :: Perm -> Perm -> Perm -> [Perm]
enumFromThenTo :: Perm -> Perm -> Perm -> [Perm]
Enum, Perm
Perm -> Perm -> Bounded Perm
forall a. a -> a -> Bounded a
$cminBound :: Perm
minBound :: Perm
$cmaxBound :: Perm
maxBound :: Perm
Bounded, (forall x. Perm -> Rep Perm x)
-> (forall x. Rep Perm x -> Perm) -> Generic Perm
forall x. Rep Perm x -> Perm
forall x. Perm -> Rep Perm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Perm -> Rep Perm x
from :: forall x. Perm -> Rep Perm x
$cto :: forall x. Rep Perm x -> Perm
to :: forall x. Rep Perm x -> Perm
Generic)
  deriving (Gen Perm
Gen Perm -> (Perm -> [Perm]) -> Arbitrary Perm
Perm -> [Perm]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Perm
arbitrary :: Gen Perm
$cshrink :: Perm -> [Perm]
shrink :: Perm -> [Perm]
Arbitrary) via (GenericUniform Perm)
  deriving (Value -> Parser [Perm]
Value -> Parser Perm
(Value -> Parser Perm) -> (Value -> Parser [Perm]) -> FromJSON Perm
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Perm
parseJSON :: Value -> Parser Perm
$cparseJSONList :: Value -> Parser [Perm]
parseJSONList :: Value -> Parser [Perm]
FromJSON, [Perm] -> Value
[Perm] -> Encoding
Perm -> Value
Perm -> Encoding
(Perm -> Value)
-> (Perm -> Encoding)
-> ([Perm] -> Value)
-> ([Perm] -> Encoding)
-> ToJSON Perm
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Perm -> Value
toJSON :: Perm -> Value
$ctoEncoding :: Perm -> Encoding
toEncoding :: Perm -> Encoding
$ctoJSONList :: [Perm] -> Value
toJSONList :: [Perm] -> Value
$ctoEncodingList :: [Perm] -> Encoding
toEncodingList :: [Perm] -> Encoding
ToJSON) via (CustomEncoded Perm)

instance S.ToSchema Perm

permsToInt :: Set Perm -> Word64
permsToInt :: Set Perm -> Word64
permsToInt = (Perm -> Word64 -> Word64) -> Word64 -> Set Perm -> Word64
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr' (\Perm
p Word64
n -> Word64
n Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Perm -> Word64
permToInt Perm
p) Word64
0

intToPerms :: Word64 -> Set Perm
intToPerms :: Word64 -> Set Perm
intToPerms Word64
n =
  let perms :: [Word64]
perms = [Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i | Int
i <- [Int
0 .. Int
62], Word64
n Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i]
   in [Perm] -> Set Perm
forall a. Ord a => [a] -> Set a
Set.fromList ((Word64 -> Maybe Perm) -> [Word64] -> [Perm]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Word64 -> Maybe Perm
intToPerm [Word64]
perms)

permToInt :: Perm -> Word64
permToInt :: Perm -> Word64
permToInt Perm
CreateConversation = Word64
0x0001
permToInt Perm
DeleteConversation = Word64
0x0002
permToInt Perm
AddTeamMember = Word64
0x0004
permToInt Perm
RemoveTeamMember = Word64
0x0008
permToInt Perm
AddRemoveConvMember = Word64
0x0010
permToInt Perm
ModifyConvName = Word64
0x0020
permToInt Perm
GetBilling = Word64
0x0040
permToInt Perm
SetBilling = Word64
0x0080
permToInt Perm
SetTeamData = Word64
0x0100
permToInt Perm
GetMemberPermissions = Word64
0x0200
permToInt Perm
GetTeamConversations = Word64
0x0400
permToInt Perm
DeleteTeam = Word64
0x0800
permToInt Perm
SetMemberPermissions = Word64
0x1000

intToPerm :: Word64 -> Maybe Perm
intToPerm :: Word64 -> Maybe Perm
intToPerm Word64
0x0001 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
CreateConversation
intToPerm Word64
0x0002 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
DeleteConversation
intToPerm Word64
0x0004 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
AddTeamMember
intToPerm Word64
0x0008 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
RemoveTeamMember
intToPerm Word64
0x0010 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
AddRemoveConvMember
intToPerm Word64
0x0020 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
ModifyConvName
intToPerm Word64
0x0040 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
GetBilling
intToPerm Word64
0x0080 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
SetBilling
intToPerm Word64
0x0100 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
SetTeamData
intToPerm Word64
0x0200 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
GetMemberPermissions
intToPerm Word64
0x0400 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
GetTeamConversations
intToPerm Word64
0x0800 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
DeleteTeam
intToPerm Word64
0x1000 = Perm -> Maybe Perm
forall a. a -> Maybe a
Just Perm
SetMemberPermissions
intToPerm Word64
_ = Maybe Perm
forall a. Maybe a
Nothing

instance Cql.Cql Permissions where
  ctype :: Tagged Permissions ColumnType
ctype = ColumnType -> Tagged Permissions ColumnType
forall a b. b -> Tagged a b
Cql.Tagged (ColumnType -> Tagged Permissions ColumnType)
-> ColumnType -> Tagged Permissions ColumnType
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, ColumnType)] -> ColumnType
Cql.UdtColumn Text
"permissions" [(Text
"self", ColumnType
Cql.BigIntColumn), (Text
"copy", ColumnType
Cql.BigIntColumn)]

  toCql :: Permissions -> Value
toCql Permissions
p =
    let f :: Set Perm -> Value
f = Int64 -> Value
Cql.CqlBigInt (Int64 -> Value) -> (Set Perm -> Int64) -> Set Perm -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> (Set Perm -> Word64) -> Set Perm -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Perm -> Word64
permsToInt
     in [(Text, Value)] -> Value
Cql.CqlUdt [(Text
"self", Set Perm -> Value
f Permissions
p.self), (Text
"copy", Set Perm -> Value
f Permissions
p.copy)]

  fromCql :: Value -> Either String Permissions
fromCql (Cql.CqlUdt [(Text, Value)]
p) = do
    let f :: Int64 -> Set Perm
f = Word64 -> Set Perm
intToPerms (Word64 -> Set Perm) -> (Int64 -> Word64) -> Int64 -> Set Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Set.Set Perm
    Int64
s <- String -> Maybe Value -> Either String Value
forall a b. a -> Maybe b -> Either a b
Err.note String
"missing 'self' permissions" (Text
"self" Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Text, Value)]
p) Either String Value
-> (Value -> Either String Int64) -> Either String Int64
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Either String Int64
forall a. Cql a => Value -> Either String a
Cql.fromCql
    Int64
d <- String -> Maybe Value -> Either String Value
forall a b. a -> Maybe b -> Either a b
Err.note String
"missing 'copy' permissions" (Text
"copy" Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Text, Value)]
p) Either String Value
-> (Value -> Either String Int64) -> Either String Int64
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Either String Int64
forall a. Cql a => Value -> Either String a
Cql.fromCql
    String -> Maybe Permissions -> Either String Permissions
forall a b. a -> Maybe b -> Either a b
Err.note String
"invalid permissions" (Set Perm -> Set Perm -> Maybe Permissions
newPermissions (Int64 -> Set Perm
f Int64
s) (Int64 -> Set Perm
f Int64
d))
  fromCql Value
_ = String -> Either String Permissions
forall a b. a -> Either a b
Left String
"permissions: udt expected"

$(genSingletons [''Perm])

$(promoteShowInstances [''Perm])