{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# 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/>.

-- | This module contains the analog of some of the team-level roles & permissions types in
-- "Wire.API.Team".
module Wire.API.Conversation.Role
  ( -- * Role
    ConversationRole,
    wireConvRoles,
    convRoleWireAdmin,
    convRoleWireMember,
    ConversationRolesList (..),

    -- * RoleName
    RoleName,
    fromRoleName,
    parseRoleName,
    roleNameWireAdmin,
    roleNameWireMember,

    -- * Action
    Action (..),
    SAction (..),
    Actions (..),
    ActionName,
    AddConversationMemberSym0,
    RemoveConversationMemberSym0,
    ModifyConversationNameSym0,
    ModifyConversationMessageTimerSym0,
    ModifyConversationReceiptModeSym0,
    ModifyConversationAccessSym0,
    ModifyOtherConversationMemberSym0,
    LeaveConversationSym0,
    DeleteConversationSym0,

    -- * helpers
    isValidRoleName,
    roleActions,
    toConvRole,
  )
where

import Cassandra.CQL hiding (Set)
import Control.Applicative (optional)
import Control.Lens (at, (?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.Aeson.TH qualified as A
import Data.Attoparsec.Text
import Data.ByteString.Conversion
import Data.Hashable
import Data.OpenApi qualified as S
import Data.Range (fromRange, genRangeText)
import Data.Schema
import Data.Set qualified as Set
import Data.Singletons.TH
import Deriving.Swagger qualified as S
import GHC.TypeLits
import Imports
import Test.QuickCheck qualified as QC
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- Action

newtype Actions = Actions
  { Actions -> Set Action
allowedActions :: Set Action
  }
  deriving stock (Actions -> Actions -> Bool
(Actions -> Actions -> Bool)
-> (Actions -> Actions -> Bool) -> Eq Actions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Actions -> Actions -> Bool
== :: Actions -> Actions -> Bool
$c/= :: Actions -> Actions -> Bool
/= :: Actions -> Actions -> Bool
Eq, Int -> Actions -> ShowS
[Actions] -> ShowS
Actions -> String
(Int -> Actions -> ShowS)
-> (Actions -> String) -> ([Actions] -> ShowS) -> Show Actions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Actions -> ShowS
showsPrec :: Int -> Actions -> ShowS
$cshow :: Actions -> String
show :: Actions -> String
$cshowList :: [Actions] -> ShowS
showList :: [Actions] -> ShowS
Show, (forall x. Actions -> Rep Actions x)
-> (forall x. Rep Actions x -> Actions) -> Generic Actions
forall x. Rep Actions x -> Actions
forall x. Actions -> Rep Actions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Actions -> Rep Actions x
from :: forall x. Actions -> Rep Actions x
$cto :: forall x. Rep Actions x -> Actions
to :: forall x. Rep Actions x -> Actions
Generic)
  deriving newtype (Gen Actions
Gen Actions -> (Actions -> [Actions]) -> Arbitrary Actions
Actions -> [Actions]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Actions
arbitrary :: Gen Actions
$cshrink :: Actions -> [Actions]
shrink :: Actions -> [Actions]
Arbitrary)

allActions :: Actions
allActions :: Actions
allActions = Set Action -> Actions
Actions (Set Action -> Actions) -> Set Action -> Actions
forall a b. (a -> b) -> a -> b
$ [Action] -> Set Action
forall a. Ord a => [a] -> Set a
Set.fromList [Action
forall a. Bounded a => a
minBound .. Action
forall a. Bounded a => a
maxBound]

-- | These conversation-level permissions.  Analogous to the team-level permissions called
-- 'Perm' (or 'Permissions').
data Action
  = AddConversationMember
  | RemoveConversationMember
  | ModifyConversationName
  | ModifyConversationMessageTimer
  | ModifyConversationReceiptMode
  | ModifyConversationAccess
  | ModifyOtherConversationMember
  | LeaveConversation
  | DeleteConversation
  deriving stock (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
/= :: Action -> Action -> Bool
Eq, Eq Action
Eq Action =>
(Action -> Action -> Ordering)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Action)
-> (Action -> Action -> Action)
-> Ord Action
Action -> Action -> Bool
Action -> Action -> Ordering
Action -> Action -> Action
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 :: Action -> Action -> Ordering
compare :: Action -> Action -> Ordering
$c< :: Action -> Action -> Bool
< :: Action -> Action -> Bool
$c<= :: Action -> Action -> Bool
<= :: Action -> Action -> Bool
$c> :: Action -> Action -> Bool
> :: Action -> Action -> Bool
$c>= :: Action -> Action -> Bool
>= :: Action -> Action -> Bool
$cmax :: Action -> Action -> Action
max :: Action -> Action -> Action
$cmin :: Action -> Action -> Action
min :: Action -> Action -> Action
Ord, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Action -> ShowS
showsPrec :: Int -> Action -> ShowS
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> ShowS
showList :: [Action] -> ShowS
Show, Int -> Action
Action -> Int
Action -> [Action]
Action -> Action
Action -> Action -> [Action]
Action -> Action -> Action -> [Action]
(Action -> Action)
-> (Action -> Action)
-> (Int -> Action)
-> (Action -> Int)
-> (Action -> [Action])
-> (Action -> Action -> [Action])
-> (Action -> Action -> [Action])
-> (Action -> Action -> Action -> [Action])
-> Enum Action
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 :: Action -> Action
succ :: Action -> Action
$cpred :: Action -> Action
pred :: Action -> Action
$ctoEnum :: Int -> Action
toEnum :: Int -> Action
$cfromEnum :: Action -> Int
fromEnum :: Action -> Int
$cenumFrom :: Action -> [Action]
enumFrom :: Action -> [Action]
$cenumFromThen :: Action -> Action -> [Action]
enumFromThen :: Action -> Action -> [Action]
$cenumFromTo :: Action -> Action -> [Action]
enumFromTo :: Action -> Action -> [Action]
$cenumFromThenTo :: Action -> Action -> Action -> [Action]
enumFromThenTo :: Action -> Action -> Action -> [Action]
Enum, Action
Action -> Action -> Bounded Action
forall a. a -> a -> Bounded a
$cminBound :: Action
minBound :: Action
$cmaxBound :: Action
maxBound :: Action
Bounded, (forall x. Action -> Rep Action x)
-> (forall x. Rep Action x -> Action) -> Generic Action
forall x. Rep Action x -> Action
forall x. Action -> Rep Action x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Action -> Rep Action x
from :: forall x. Action -> Rep Action x
$cto :: forall x. Rep Action x -> Action
to :: forall x. Rep Action x -> Action
Generic)
  deriving (Gen Action
Gen Action -> (Action -> [Action]) -> Arbitrary Action
Action -> [Action]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Action
arbitrary :: Gen Action
$cshrink :: Action -> [Action]
shrink :: Action -> [Action]
Arbitrary) via (GenericUniform Action)
  deriving (Typeable Action
Typeable Action =>
(Proxy Action -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Action
Proxy Action -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Action -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Action -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (S.CustomSwagger '[S.ConstructorTagModifier S.CamelToSnake] Action)

type family ActionName (a :: Action) :: Symbol where
  ActionName 'AddConversationMember = "add_conversation_member"
  ActionName 'RemoveConversationMember = "remove_conversation_member"
  ActionName 'ModifyConversationName = "modify_conversation_name"
  ActionName 'ModifyConversationMessageTimer = "modify_conversation_message_timer"
  ActionName 'ModifyConversationReceiptMode = "modify_conversation_receipt_mode"
  ActionName 'ModifyConversationAccess = "modify_conversation_access"
  ActionName 'ModifyOtherConversationMember = "modify_other_conversation_member"
  ActionName 'LeaveConversation = "leave_conversation"
  ActionName 'DeleteConversation = "delete_conversation"

A.deriveJSON A.defaultOptions {A.constructorTagModifier = A.camelTo2 '_'} ''Action

$(genSingletons [''Action])

--------------------------------------------------------------------------------
-- Role

-- | A conversation role is associated to a user in the scope of a conversation and implies
-- with a set of 'Action's.  Conversation-level analog to what 'Role' is on the team-level.
--
-- Do not expose the constructors directly,
-- use smart constructors instead to ensure that all validation is performed.
data ConversationRole
  = ConvRoleWireAdmin
  | ConvRoleWireMember
  | ConvRoleCustom RoleName Actions
  deriving stock (ConversationRole -> ConversationRole -> Bool
(ConversationRole -> ConversationRole -> Bool)
-> (ConversationRole -> ConversationRole -> Bool)
-> Eq ConversationRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationRole -> ConversationRole -> Bool
== :: ConversationRole -> ConversationRole -> Bool
$c/= :: ConversationRole -> ConversationRole -> Bool
/= :: ConversationRole -> ConversationRole -> Bool
Eq, Int -> ConversationRole -> ShowS
[ConversationRole] -> ShowS
ConversationRole -> String
(Int -> ConversationRole -> ShowS)
-> (ConversationRole -> String)
-> ([ConversationRole] -> ShowS)
-> Show ConversationRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationRole -> ShowS
showsPrec :: Int -> ConversationRole -> ShowS
$cshow :: ConversationRole -> String
show :: ConversationRole -> String
$cshowList :: [ConversationRole] -> ShowS
showList :: [ConversationRole] -> ShowS
Show, (forall x. ConversationRole -> Rep ConversationRole x)
-> (forall x. Rep ConversationRole x -> ConversationRole)
-> Generic ConversationRole
forall x. Rep ConversationRole x -> ConversationRole
forall x. ConversationRole -> Rep ConversationRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationRole -> Rep ConversationRole x
from :: forall x. ConversationRole -> Rep ConversationRole x
$cto :: forall x. Rep ConversationRole x -> ConversationRole
to :: forall x. Rep ConversationRole x -> ConversationRole
Generic)
  deriving (Gen ConversationRole
Gen ConversationRole
-> (ConversationRole -> [ConversationRole])
-> Arbitrary ConversationRole
ConversationRole -> [ConversationRole]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationRole
arbitrary :: Gen ConversationRole
$cshrink :: ConversationRole -> [ConversationRole]
shrink :: ConversationRole -> [ConversationRole]
Arbitrary) via (GenericUniform ConversationRole)

instance S.ToSchema ConversationRole where
  declareNamedSchema :: Proxy ConversationRole -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ConversationRole
_ = do
    Referenced Schema
conversationRoleSchema <-
      Proxy RoleName -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
S.declareSchemaRef (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @RoleName)
    Schema
actionsSchema <- Proxy [Action] -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
S.declareSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[Action])
    let Schema
convRoleSchema :: S.Schema =
          Schema
forall a. Monoid a => a
mempty
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
S.properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
     -> Identity (Maybe (Referenced Schema)))
    -> InsOrdHashMap Text (Referenced Schema)
    -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
    -> Identity (Maybe (Referenced Schema)))
-> Schema
-> Identity Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap Text (Referenced Schema))
-> Lens'
     (InsOrdHashMap Text (Referenced Schema))
     (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap Text (Referenced Schema))
"conversation_role" ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
  -> Identity (Maybe (Referenced Schema)))
 -> Schema -> Identity Schema)
-> Referenced Schema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema
conversationRoleSchema
            Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
Lens' Schema (InsOrdHashMap Text (Referenced Schema))
S.properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
     -> Identity (Maybe (Referenced Schema)))
    -> InsOrdHashMap Text (Referenced Schema)
    -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
    -> Identity (Maybe (Referenced Schema)))
-> Schema
-> Identity Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap Text (Referenced Schema))
-> Lens'
     (InsOrdHashMap Text (Referenced Schema))
     (Maybe (IxValue (InsOrdHashMap Text (Referenced Schema))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap Text (Referenced Schema))
"actions"
              ((Maybe (IxValue (InsOrdHashMap Text (Referenced Schema)))
  -> Identity (Maybe (Referenced Schema)))
 -> Schema -> Identity Schema)
-> Referenced Schema -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
S.Inline
                ( Schema
actionsSchema
                    Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The set of actions allowed for this role"
                )
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Schema -> NamedSchema
S.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ConversationRole") Schema
convRoleSchema)

instance ToJSON ConversationRole where
  toJSON :: ConversationRole -> Value
toJSON ConversationRole
cr =
    [Pair] -> Value
A.object
      [ Key
"conversation_role" Key -> RoleName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ConversationRole -> RoleName
roleToRoleName ConversationRole
cr,
        Key
"actions" Key -> Set Action -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ConversationRole -> Set Action
roleActions ConversationRole
cr
      ]

roleActions :: ConversationRole -> Set Action
roleActions :: ConversationRole -> Set Action
roleActions ConversationRole
ConvRoleWireAdmin = Actions -> Set Action
allowedActions Actions
allActions
roleActions ConversationRole
ConvRoleWireMember =
  [Action] -> Set Action
forall a. Ord a => [a] -> Set a
Set.fromList
    [ Action
LeaveConversation
    ]
roleActions (ConvRoleCustom RoleName
_ (Actions Set Action
actions)) = Set Action
actions

roleToRoleName :: ConversationRole -> RoleName
roleToRoleName :: ConversationRole -> RoleName
roleToRoleName ConversationRole
ConvRoleWireAdmin = RoleName
roleNameWireAdmin
roleToRoleName ConversationRole
ConvRoleWireMember = RoleName
roleNameWireMember
roleToRoleName (ConvRoleCustom RoleName
l Actions
_) = RoleName
l

instance FromJSON ConversationRole where
  parseJSON :: Value -> Parser ConversationRole
parseJSON = String
-> (Object -> Parser ConversationRole)
-> Value
-> Parser ConversationRole
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"conversationRole" ((Object -> Parser ConversationRole)
 -> Value -> Parser ConversationRole)
-> (Object -> Parser ConversationRole)
-> Value
-> Parser ConversationRole
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    RoleName
role <- Object
o Object -> Key -> Parser RoleName
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"conversation_role"
    Set Action
actions <- Object
o Object -> Key -> Parser (Set Action)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"actions"
    case RoleName -> Maybe Actions -> Maybe ConversationRole
toConvRole RoleName
role (Actions -> Maybe Actions
forall a. a -> Maybe a
Just (Actions -> Maybe Actions) -> Actions -> Maybe Actions
forall a b. (a -> b) -> a -> b
$ Set Action -> Actions
Actions Set Action
actions) of
      Just ConversationRole
cr -> ConversationRole -> Parser ConversationRole
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConversationRole
cr
      Maybe ConversationRole
Nothing -> String -> Parser ConversationRole
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failed to parse: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Object -> String
forall a. Show a => a -> String
show Object
o)

toConvRole :: RoleName -> Maybe Actions -> Maybe ConversationRole
toConvRole :: RoleName -> Maybe Actions -> Maybe ConversationRole
toConvRole (RoleName Text
"wire_admin") Maybe Actions
_ = ConversationRole -> Maybe ConversationRole
forall a. a -> Maybe a
Just ConversationRole
ConvRoleWireAdmin
toConvRole (RoleName Text
"wire_member") Maybe Actions
_ = ConversationRole -> Maybe ConversationRole
forall a. a -> Maybe a
Just ConversationRole
ConvRoleWireMember
toConvRole RoleName
x (Just Actions
as) = ConversationRole -> Maybe ConversationRole
forall a. a -> Maybe a
Just (RoleName -> Actions -> ConversationRole
ConvRoleCustom RoleName
x Actions
as)
toConvRole RoleName
_ Maybe Actions
_ = Maybe ConversationRole
forall a. Maybe a
Nothing

wireConvRoles :: [ConversationRole]
wireConvRoles :: [ConversationRole]
wireConvRoles = [ConversationRole
ConvRoleWireAdmin, ConversationRole
ConvRoleWireMember]

convRoleWireAdmin :: ConversationRole
convRoleWireAdmin :: ConversationRole
convRoleWireAdmin = ConversationRole
ConvRoleWireAdmin

convRoleWireMember :: ConversationRole
convRoleWireMember :: ConversationRole
convRoleWireMember = ConversationRole
ConvRoleWireMember

data ConversationRolesList = ConversationRolesList
  { ConversationRolesList -> [ConversationRole]
convRolesList :: [ConversationRole]
  }
  deriving stock (ConversationRolesList -> ConversationRolesList -> Bool
(ConversationRolesList -> ConversationRolesList -> Bool)
-> (ConversationRolesList -> ConversationRolesList -> Bool)
-> Eq ConversationRolesList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversationRolesList -> ConversationRolesList -> Bool
== :: ConversationRolesList -> ConversationRolesList -> Bool
$c/= :: ConversationRolesList -> ConversationRolesList -> Bool
/= :: ConversationRolesList -> ConversationRolesList -> Bool
Eq, Int -> ConversationRolesList -> ShowS
[ConversationRolesList] -> ShowS
ConversationRolesList -> String
(Int -> ConversationRolesList -> ShowS)
-> (ConversationRolesList -> String)
-> ([ConversationRolesList] -> ShowS)
-> Show ConversationRolesList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversationRolesList -> ShowS
showsPrec :: Int -> ConversationRolesList -> ShowS
$cshow :: ConversationRolesList -> String
show :: ConversationRolesList -> String
$cshowList :: [ConversationRolesList] -> ShowS
showList :: [ConversationRolesList] -> ShowS
Show, (forall x. ConversationRolesList -> Rep ConversationRolesList x)
-> (forall x. Rep ConversationRolesList x -> ConversationRolesList)
-> Generic ConversationRolesList
forall x. Rep ConversationRolesList x -> ConversationRolesList
forall x. ConversationRolesList -> Rep ConversationRolesList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConversationRolesList -> Rep ConversationRolesList x
from :: forall x. ConversationRolesList -> Rep ConversationRolesList x
$cto :: forall x. Rep ConversationRolesList x -> ConversationRolesList
to :: forall x. Rep ConversationRolesList x -> ConversationRolesList
Generic)
  deriving (Gen ConversationRolesList
Gen ConversationRolesList
-> (ConversationRolesList -> [ConversationRolesList])
-> Arbitrary ConversationRolesList
ConversationRolesList -> [ConversationRolesList]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ConversationRolesList
arbitrary :: Gen ConversationRolesList
$cshrink :: ConversationRolesList -> [ConversationRolesList]
shrink :: ConversationRolesList -> [ConversationRolesList]
Arbitrary) via (GenericUniform ConversationRolesList)
  deriving (Typeable ConversationRolesList
Typeable ConversationRolesList =>
(Proxy ConversationRolesList
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ConversationRolesList
Proxy ConversationRolesList
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ConversationRolesList
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ConversationRolesList
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (S.CustomSwagger '[S.FieldLabelModifier (S.LabelMappings '["convRolesList" 'S.:-> "conversation_roles"])] ConversationRolesList)

instance ToJSON ConversationRolesList where
  toJSON :: ConversationRolesList -> Value
toJSON (ConversationRolesList [ConversationRole]
r) =
    [Pair] -> Value
A.object
      [ Key
"conversation_roles" Key -> [ConversationRole] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= [ConversationRole]
r
      ]

instance FromJSON ConversationRolesList where
  parseJSON :: Value -> Parser ConversationRolesList
parseJSON = String
-> (Object -> Parser ConversationRolesList)
-> Value
-> Parser ConversationRolesList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ConversationRolesList" ((Object -> Parser ConversationRolesList)
 -> Value -> Parser ConversationRolesList)
-> (Object -> Parser ConversationRolesList)
-> Value
-> Parser ConversationRolesList
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [ConversationRole] -> ConversationRolesList
ConversationRolesList
      ([ConversationRole] -> ConversationRolesList)
-> Parser [ConversationRole] -> Parser ConversationRolesList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [ConversationRole]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"conversation_roles"

--------------------------------------------------------------------------------
-- RoleName

-- RoleNames with `wire_` prefix are reserved
-- and cannot be created by externals. Therefore, never
-- expose this constructor outside of this module.
newtype RoleName = RoleName {RoleName -> Text
fromRoleName :: Text}
  deriving stock (RoleName -> RoleName -> Bool
(RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool) -> Eq RoleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RoleName -> RoleName -> Bool
== :: RoleName -> RoleName -> Bool
$c/= :: RoleName -> RoleName -> Bool
/= :: RoleName -> RoleName -> Bool
Eq, Eq RoleName
Eq RoleName =>
(RoleName -> RoleName -> Ordering)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> RoleName)
-> (RoleName -> RoleName -> RoleName)
-> Ord RoleName
RoleName -> RoleName -> Bool
RoleName -> RoleName -> Ordering
RoleName -> RoleName -> RoleName
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 :: RoleName -> RoleName -> Ordering
compare :: RoleName -> RoleName -> Ordering
$c< :: RoleName -> RoleName -> Bool
< :: RoleName -> RoleName -> Bool
$c<= :: RoleName -> RoleName -> Bool
<= :: RoleName -> RoleName -> Bool
$c> :: RoleName -> RoleName -> Bool
> :: RoleName -> RoleName -> Bool
$c>= :: RoleName -> RoleName -> Bool
>= :: RoleName -> RoleName -> Bool
$cmax :: RoleName -> RoleName -> RoleName
max :: RoleName -> RoleName -> RoleName
$cmin :: RoleName -> RoleName -> RoleName
min :: RoleName -> RoleName -> RoleName
Ord, Int -> RoleName -> ShowS
[RoleName] -> ShowS
RoleName -> String
(Int -> RoleName -> ShowS)
-> (RoleName -> String) -> ([RoleName] -> ShowS) -> Show RoleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RoleName -> ShowS
showsPrec :: Int -> RoleName -> ShowS
$cshow :: RoleName -> String
show :: RoleName -> String
$cshowList :: [RoleName] -> ShowS
showList :: [RoleName] -> ShowS
Show, (forall x. RoleName -> Rep RoleName x)
-> (forall x. Rep RoleName x -> RoleName) -> Generic RoleName
forall x. Rep RoleName x -> RoleName
forall x. RoleName -> Rep RoleName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RoleName -> Rep RoleName x
from :: forall x. RoleName -> Rep RoleName x
$cto :: forall x. Rep RoleName x -> RoleName
to :: forall x. Rep RoleName x -> RoleName
Generic)
  deriving newtype (RoleName -> Builder
(RoleName -> Builder) -> ToByteString RoleName
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: RoleName -> Builder
builder :: RoleName -> Builder
ToByteString, Eq RoleName
Eq RoleName =>
(Int -> RoleName -> Int) -> (RoleName -> Int) -> Hashable RoleName
Int -> RoleName -> Int
RoleName -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RoleName -> Int
hashWithSalt :: Int -> RoleName -> Int
$chash :: RoleName -> Int
hash :: RoleName -> Int
Hashable)
  deriving (Value -> Parser [RoleName]
Value -> Parser RoleName
(Value -> Parser RoleName)
-> (Value -> Parser [RoleName]) -> FromJSON RoleName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RoleName
parseJSON :: Value -> Parser RoleName
$cparseJSONList :: Value -> Parser [RoleName]
parseJSONList :: Value -> Parser [RoleName]
FromJSON, [RoleName] -> Value
[RoleName] -> Encoding
RoleName -> Value
RoleName -> Encoding
(RoleName -> Value)
-> (RoleName -> Encoding)
-> ([RoleName] -> Value)
-> ([RoleName] -> Encoding)
-> ToJSON RoleName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RoleName -> Value
toJSON :: RoleName -> Value
$ctoEncoding :: RoleName -> Encoding
toEncoding :: RoleName -> Encoding
$ctoJSONList :: [RoleName] -> Value
toJSONList :: [RoleName] -> Value
$ctoEncodingList :: [RoleName] -> Encoding
toEncodingList :: [RoleName] -> Encoding
ToJSON, Typeable RoleName
Typeable RoleName =>
(Proxy RoleName -> Declare (Definitions Schema) NamedSchema)
-> ToSchema RoleName
Proxy RoleName -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy RoleName -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy RoleName -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema RoleName

instance ToSchema RoleName where
  schema :: ValueSchema NamedSwaggerDoc RoleName
schema =
    ((Schema -> Identity Schema)
-> ValueSchema NamedSwaggerDoc RoleName
-> Identity (ValueSchema NamedSwaggerDoc RoleName)
forall s a. HasSchema s a => Lens' s a
Lens' (ValueSchema NamedSwaggerDoc RoleName) Schema
S.schema ((Schema -> Identity Schema)
 -> ValueSchema NamedSwaggerDoc RoleName
 -> Identity (ValueSchema NamedSwaggerDoc RoleName))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> ValueSchema NamedSwaggerDoc RoleName
-> Identity (ValueSchema NamedSwaggerDoc RoleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> ValueSchema NamedSwaggerDoc RoleName
 -> Identity (ValueSchema NamedSwaggerDoc RoleName))
-> Text
-> ValueSchema NamedSwaggerDoc RoleName
-> ValueSchema NamedSwaggerDoc RoleName
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
desc) (ValueSchema NamedSwaggerDoc RoleName
 -> ValueSchema NamedSwaggerDoc RoleName)
-> ValueSchema NamedSwaggerDoc RoleName
-> ValueSchema NamedSwaggerDoc RoleName
forall a b. (a -> b) -> a -> b
$
      Text -> RoleName
RoleName (Text -> RoleName)
-> SchemaP NamedSwaggerDoc Value Value RoleName Text
-> ValueSchema NamedSwaggerDoc RoleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoleName -> Text
fromRoleName (RoleName -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value RoleName Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text -> SchemaP NamedSwaggerDoc Value Value Text Text
text Text
"RoleName"
    where
      desc :: Text
desc =
        Text
"Role name, between 2 and 128 chars, 'wire_' prefix \
        \is reserved for roles designed by Wire (i.e., no \
        \custom roles can have the same prefix)"

instance FromByteString RoleName where
  parser :: Parser RoleName
parser = Parser Text
forall a. FromByteString a => Parser a
parser Parser Text -> (Text -> Parser RoleName) -> Parser RoleName
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser RoleName
-> (RoleName -> Parser RoleName)
-> Maybe RoleName
-> Parser RoleName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser RoleName
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid RoleName") RoleName -> Parser RoleName
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RoleName -> Parser RoleName)
-> (Text -> Maybe RoleName) -> Text -> Parser RoleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe RoleName
parseRoleName

deriving instance Cql RoleName

instance Arbitrary RoleName where
  arbitrary :: Gen RoleName
arbitrary =
    Text -> RoleName
RoleName (Text -> RoleName)
-> (Range 2 128 Text -> Text) -> Range 2 128 Text -> RoleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 2 128 Text -> Text
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange
      (Range 2 128 Text -> RoleName)
-> Gen (Range 2 128 Text) -> Gen RoleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (n :: Nat) (m :: Nat).
(KnownNat n, KnownNat m, n <= m) =>
Gen Char -> Gen (Range n m Text)
genRangeText @2 @128 Gen Char
genChar
    where
      genChar :: Gen Char
genChar = String -> Gen Char
forall a. [a] -> Gen a
QC.elements (String -> Gen Char) -> String -> Gen Char
forall a b. (a -> b) -> a -> b
$ [Char
'a' .. Char
'z'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'_']

roleNameWireAdmin :: RoleName
roleNameWireAdmin :: RoleName
roleNameWireAdmin = Text -> RoleName
RoleName Text
"wire_admin"

roleNameWireMember :: RoleName
roleNameWireMember :: RoleName
roleNameWireMember = Text -> RoleName
RoleName Text
"wire_member"

parseRoleName :: Text -> Maybe RoleName
parseRoleName :: Text -> Maybe RoleName
parseRoleName Text
t
  | Text -> Bool
isValidRoleName Text
t = RoleName -> Maybe RoleName
forall a. a -> Maybe a
Just (Text -> RoleName
RoleName Text
t)
  | Bool
otherwise = Maybe RoleName
forall a. Maybe a
Nothing

-- All RoleNames should have 2-128 chars
isValidRoleName :: Text -> Bool
isValidRoleName :: Text -> Bool
isValidRoleName =
  (String -> Bool) -> (() -> Bool) -> Either String () -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)
    (Either String () -> Bool)
-> (Text -> Either String ()) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Text -> Either String ()
forall a. Parser a -> Text -> Either String a
parseOnly Parser ()
customRoleName
  where
    customRoleName :: Parser ()
customRoleName =
      Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 ((Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
chars)
        Parser Text String
-> Parser Text [Maybe Char] -> Parser Text [Maybe Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Text (Maybe Char) -> Parser Text [Maybe Char]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
126 (Parser Text Char -> Parser Text (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
chars))
        Parser Text [Maybe Char] -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall t. Chunk t => Parser t ()
endOfInput
    chars :: Char -> Bool
chars = String -> Char -> Bool
inClass String
"a-z0-9_"