{-# LANGUAGE StrictData #-}

-- 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/>.

module Wire.API.Team.Role
  ( Role (..),
    defaultRole,
  )
where

import Cassandra qualified as Cql
import Control.Error (note)
import Control.Lens ((?~))
import Data.Aeson
import Data.Attoparsec.ByteString.Char8 (string)
import Data.ByteString.Conversion (FromByteString (..), ToByteString (..))
import Data.OpenApi qualified as S
import Data.Schema
import Data.Text qualified as T
import Imports
import Servant.API (FromHttpApiData, parseQueryParam)
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

-- Note [team roles]
-- ~~~~~~~~~~~~
--
-- Client apps have a notion of *team roles*. They are defined as sets of
-- permissions:
--
--     member =
--         {AddRemoveConvMember, Create/DeleteConversation,
--         GetMemberPermissions, GetTeamConversations}
--
--     admin = member +
--         {Add/RemoveTeamMember, SetMemberPermissions, SetTeamData}
--
--     owner = admin +
--         {DeleteTeam, Get/SetBilling}
--
-- Whenever a user has one of those specific sets of permissions, they are
-- considered a member/admin/owner and the client treats them accordingly
-- (e.g. for an admin it might show a certain button, while for an ordinary
-- user it won't).
--
-- On the backend, however, we don't have such a notion. Instead we have
-- granular (in fact, probably *too* granular) permission masks. Look at
-- 'Perm' and 'Permissions'.
--
-- Admins as a concept don't exist at all, and team owners are defined as
-- "full bitmask". When we do checks like "the backend must not let the last
-- team owner leave the team", this is what we test for. We also never test
-- for "team admin", and instead look at specific permissions.
--
-- Creating a new permission flag is thus very tricky, because if we decide
-- that all team admins must have this new permission, we will have to
-- identify all existing team admins. And if it turns out that some users
-- don't fit into one of those three team roles, we're screwed.
--
-- SOLUTION: we introduce 'HiddenPerm' and 'HiddenPermissions', map
-- (non-hidden) -- permission masks to roles and roles to permissions (both
-- hidden and non-hidden), and provide a type class 'IsPerm' that handles
-- both hidden and non-hidden permissions uniformly.  We still cannot update
-- 'Perms' and 'Permissions', but we can introduce new HiddenPermissions and
-- associate them with roles.

-- | Team-level role.  Analog to conversation-level 'ConversationRole'.
data Role = RoleOwner | RoleAdmin | RoleMember | RoleExternalPartner
  deriving stock (Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show, Int -> Role
Role -> Int
Role -> [Role]
Role -> Role
Role -> Role -> [Role]
Role -> Role -> Role -> [Role]
(Role -> Role)
-> (Role -> Role)
-> (Int -> Role)
-> (Role -> Int)
-> (Role -> [Role])
-> (Role -> Role -> [Role])
-> (Role -> Role -> [Role])
-> (Role -> Role -> Role -> [Role])
-> Enum Role
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 :: Role -> Role
succ :: Role -> Role
$cpred :: Role -> Role
pred :: Role -> Role
$ctoEnum :: Int -> Role
toEnum :: Int -> Role
$cfromEnum :: Role -> Int
fromEnum :: Role -> Int
$cenumFrom :: Role -> [Role]
enumFrom :: Role -> [Role]
$cenumFromThen :: Role -> Role -> [Role]
enumFromThen :: Role -> Role -> [Role]
$cenumFromTo :: Role -> Role -> [Role]
enumFromTo :: Role -> Role -> [Role]
$cenumFromThenTo :: Role -> Role -> Role -> [Role]
enumFromThenTo :: Role -> Role -> Role -> [Role]
Enum, Role
Role -> Role -> Bounded Role
forall a. a -> a -> Bounded a
$cminBound :: Role
minBound :: Role
$cmaxBound :: Role
maxBound :: Role
Bounded, (forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Role -> Rep Role x
from :: forall x. Role -> Rep Role x
$cto :: forall x. Rep Role x -> Role
to :: forall x. Rep Role x -> Role
Generic)
  deriving (Gen Role
Gen Role -> (Role -> [Role]) -> Arbitrary Role
Role -> [Role]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Role
arbitrary :: Gen Role
$cshrink :: Role -> [Role]
shrink :: Role -> [Role]
Arbitrary) via (GenericUniform Role)
  deriving ([Role] -> Value
[Role] -> Encoding
Role -> Value
Role -> Encoding
(Role -> Value)
-> (Role -> Encoding)
-> ([Role] -> Value)
-> ([Role] -> Encoding)
-> ToJSON Role
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Role -> Value
toJSON :: Role -> Value
$ctoEncoding :: Role -> Encoding
toEncoding :: Role -> Encoding
$ctoJSONList :: [Role] -> Value
toJSONList :: [Role] -> Value
$ctoEncodingList :: [Role] -> Encoding
toEncodingList :: [Role] -> Encoding
ToJSON, Value -> Parser [Role]
Value -> Parser Role
(Value -> Parser Role) -> (Value -> Parser [Role]) -> FromJSON Role
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Role
parseJSON :: Value -> Parser Role
$cparseJSONList :: Value -> Parser [Role]
parseJSONList :: Value -> Parser [Role]
FromJSON, Typeable Role
Typeable Role =>
(Proxy Role -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Role
Proxy Role -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Role -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Role -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Role

instance ToSchema Role where
  schema :: ValueSchema NamedSwaggerDoc Role
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"Role" (SchemaP [Value] Text (Alt Maybe Text) Role Role
 -> ValueSchema NamedSwaggerDoc Role)
-> SchemaP [Value] Text (Alt Maybe Text) Role Role
-> ValueSchema NamedSwaggerDoc Role
forall a b. (a -> b) -> a -> b
$
      ((Role -> SchemaP [Value] Text (Alt Maybe Text) Role Role)
 -> [Role] -> SchemaP [Value] Text (Alt Maybe Text) Role Role)
-> [Role]
-> (Role -> SchemaP [Value] Text (Alt Maybe Text) Role Role)
-> SchemaP [Value] Text (Alt Maybe Text) Role Role
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Role -> SchemaP [Value] Text (Alt Maybe Text) Role Role)
-> [Role] -> SchemaP [Value] Text (Alt Maybe Text) Role Role
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Role
forall a. Bounded a => a
minBound .. Role
forall a. Bounded a => a
maxBound] ((Role -> SchemaP [Value] Text (Alt Maybe Text) Role Role)
 -> SchemaP [Value] Text (Alt Maybe Text) Role Role)
-> (Role -> SchemaP [Value] Text (Alt Maybe Text) Role Role)
-> SchemaP [Value] Text (Alt Maybe Text) Role Role
forall a b. (a -> b) -> a -> b
$ \Role
r ->
        Text -> Role -> SchemaP [Value] Text (Alt Maybe Text) Role Role
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element (Role -> Text
forall a. IsString a => Role -> a
roleName Role
r) Role
r

instance S.ToParamSchema Role where
  toParamSchema :: Proxy Role -> Schema
toParamSchema Proxy Role
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Schema -> Identity Schema
forall s a. HasEnum s a => Lens' s a
Lens' Schema (Maybe [Value])
S.enum_ ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Schema -> Identity Schema)
-> [Value] -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Role -> Value) -> [Role] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Role -> Value
forall a. IsString a => Role -> a
roleName [Role
forall a. Bounded a => a
minBound .. Role
forall a. Bounded a => a
maxBound]

instance FromHttpApiData Role where
  parseQueryParam :: Text -> Either Text Role
parseQueryParam Text
name = Text -> Maybe Role -> Either Text Role
forall a b. a -> Maybe b -> Either a b
note (Text
"Unknown role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) (Maybe Role -> Either Text Role) -> Maybe Role -> Either Text Role
forall a b. (a -> b) -> a -> b
$
    Alt Maybe Role -> Maybe Role
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt Maybe Role -> Maybe Role) -> Alt Maybe Role -> Maybe Role
forall a b. (a -> b) -> a -> b
$
      ((Role -> Alt Maybe Role) -> [Role] -> Alt Maybe Role)
-> [Role] -> (Role -> Alt Maybe Role) -> Alt Maybe Role
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Role -> Alt Maybe Role) -> [Role] -> Alt Maybe Role
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Role
forall a. Bounded a => a
minBound .. Role
forall a. Bounded a => a
maxBound] ((Role -> Alt Maybe Role) -> Alt Maybe Role)
-> (Role -> Alt Maybe Role) -> Alt Maybe Role
forall a b. (a -> b) -> a -> b
$ \Role
s ->
        Bool -> Alt Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Text
T.pack (Role -> String
forall a. Show a => a -> String
show Role
s) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) Alt Maybe () -> Role -> Alt Maybe Role
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Role
s

roleName :: (IsString a) => Role -> a
roleName :: forall a. IsString a => Role -> a
roleName Role
RoleOwner = a
"owner"
roleName Role
RoleAdmin = a
"admin"
roleName Role
RoleMember = a
"member"
roleName Role
RoleExternalPartner = a
"partner"

instance ToByteString Role where
  builder :: Role -> Builder
builder = Role -> Builder
forall a. IsString a => Role -> a
roleName

instance FromByteString Role where
  parser :: Parser Role
parser =
    [Parser Role] -> Parser Role
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Parser Role] -> Parser Role) -> [Parser Role] -> Parser Role
forall a b. (a -> b) -> a -> b
$
      [Role
forall a. Bounded a => a
minBound .. Role
forall a. Bounded a => a
maxBound] [Role] -> (Role -> Parser Role) -> [Parser Role]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Role
ctor ->
        Role
ctor Role -> Parser ByteString ByteString -> Parser Role
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
string (Role -> ByteString
forall a. IsString a => Role -> a
roleName Role
ctor)

defaultRole :: Role
defaultRole :: Role
defaultRole = Role
RoleMember

instance Cql.Cql Role where
  ctype :: Tagged Role ColumnType
ctype = ColumnType -> Tagged Role ColumnType
forall a b. b -> Tagged a b
Cql.Tagged ColumnType
Cql.IntColumn

  toCql :: Role -> Value
toCql Role
RoleOwner = Int32 -> Value
Cql.CqlInt Int32
1
  toCql Role
RoleAdmin = Int32 -> Value
Cql.CqlInt Int32
2
  toCql Role
RoleMember = Int32 -> Value
Cql.CqlInt Int32
3
  toCql Role
RoleExternalPartner = Int32 -> Value
Cql.CqlInt Int32
4

  fromCql :: Value -> Either String Role
fromCql (Cql.CqlInt Int32
i) = case Int32
i of
    Int32
1 -> Role -> Either String Role
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
RoleOwner
    Int32
2 -> Role -> Either String Role
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
RoleAdmin
    Int32
3 -> Role -> Either String Role
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
RoleMember
    Int32
4 -> Role -> Either String Role
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
RoleExternalPartner
    Int32
n -> String -> Either String Role
forall a b. a -> Either a b
Left (String -> Either String Role) -> String -> Either String Role
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Role value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
n
  fromCql Value
_ = String -> Either String Role
forall a b. a -> Either a b
Left String
"Role value: int expected"