-- 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.Routes.Public.Galley.Team where

import Control.Lens ((?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Id
import Data.OpenApi.Schema qualified as S
import Data.Range
import Data.Schema
import Imports
import Servant
import Servant.OpenApi.Internal.Orphans ()
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Routes.MultiVerb
import Wire.API.Routes.Named
import Wire.API.Routes.Public
import Wire.API.Routes.Version
import Wire.API.Team
import Wire.API.Team.Member
import Wire.API.Team.Permission

-- | FUTUREWORK: remove when the create-non-binding-team endpoint is deleted
data NonBindingNewTeam = NonBindingNewTeam
  { NonBindingNewTeam -> Range 1 256 Text
teamName :: Range 1 256 Text,
    NonBindingNewTeam -> Icon
teamIcon :: Icon,
    NonBindingNewTeam -> Maybe (Range 1 256 Text)
teamIconKey :: Maybe (Range 1 256 Text),
    NonBindingNewTeam -> Maybe (Range 1 127 [TeamMember])
teamMembers :: Maybe (Range 1 127 [TeamMember])
  }
  deriving stock (NonBindingNewTeam -> NonBindingNewTeam -> Bool
(NonBindingNewTeam -> NonBindingNewTeam -> Bool)
-> (NonBindingNewTeam -> NonBindingNewTeam -> Bool)
-> Eq NonBindingNewTeam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonBindingNewTeam -> NonBindingNewTeam -> Bool
== :: NonBindingNewTeam -> NonBindingNewTeam -> Bool
$c/= :: NonBindingNewTeam -> NonBindingNewTeam -> Bool
/= :: NonBindingNewTeam -> NonBindingNewTeam -> Bool
Eq, Int -> NonBindingNewTeam -> ShowS
[NonBindingNewTeam] -> ShowS
NonBindingNewTeam -> String
(Int -> NonBindingNewTeam -> ShowS)
-> (NonBindingNewTeam -> String)
-> ([NonBindingNewTeam] -> ShowS)
-> Show NonBindingNewTeam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonBindingNewTeam -> ShowS
showsPrec :: Int -> NonBindingNewTeam -> ShowS
$cshow :: NonBindingNewTeam -> String
show :: NonBindingNewTeam -> String
$cshowList :: [NonBindingNewTeam] -> ShowS
showList :: [NonBindingNewTeam] -> ShowS
Show)
  deriving (Value -> Parser [NonBindingNewTeam]
Value -> Parser NonBindingNewTeam
(Value -> Parser NonBindingNewTeam)
-> (Value -> Parser [NonBindingNewTeam])
-> FromJSON NonBindingNewTeam
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NonBindingNewTeam
parseJSON :: Value -> Parser NonBindingNewTeam
$cparseJSONList :: Value -> Parser [NonBindingNewTeam]
parseJSONList :: Value -> Parser [NonBindingNewTeam]
FromJSON, [NonBindingNewTeam] -> Value
[NonBindingNewTeam] -> Encoding
NonBindingNewTeam -> Value
NonBindingNewTeam -> Encoding
(NonBindingNewTeam -> Value)
-> (NonBindingNewTeam -> Encoding)
-> ([NonBindingNewTeam] -> Value)
-> ([NonBindingNewTeam] -> Encoding)
-> ToJSON NonBindingNewTeam
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NonBindingNewTeam -> Value
toJSON :: NonBindingNewTeam -> Value
$ctoEncoding :: NonBindingNewTeam -> Encoding
toEncoding :: NonBindingNewTeam -> Encoding
$ctoJSONList :: [NonBindingNewTeam] -> Value
toJSONList :: [NonBindingNewTeam] -> Value
$ctoEncodingList :: [NonBindingNewTeam] -> Encoding
toEncodingList :: [NonBindingNewTeam] -> Encoding
ToJSON, Typeable NonBindingNewTeam
Typeable NonBindingNewTeam =>
(Proxy NonBindingNewTeam
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NonBindingNewTeam
Proxy NonBindingNewTeam -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NonBindingNewTeam -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NonBindingNewTeam -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NonBindingNewTeam)

instance ToSchema NonBindingNewTeam where
  schema :: ValueSchema NamedSwaggerDoc NonBindingNewTeam
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] NonBindingNewTeam NonBindingNewTeam
-> ValueSchema NamedSwaggerDoc NonBindingNewTeam
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"NonBindingNewTeam" (SchemaP
   SwaggerDoc Object [Pair] NonBindingNewTeam NonBindingNewTeam
 -> ValueSchema NamedSwaggerDoc NonBindingNewTeam)
-> SchemaP
     SwaggerDoc Object [Pair] NonBindingNewTeam NonBindingNewTeam
-> ValueSchema NamedSwaggerDoc NonBindingNewTeam
forall a b. (a -> b) -> a -> b
$
      Range 1 256 Text
-> Icon
-> Maybe (Range 1 256 Text)
-> Maybe (Range 1 127 [TeamMember])
-> NonBindingNewTeam
NonBindingNewTeam
        (Range 1 256 Text
 -> Icon
 -> Maybe (Range 1 256 Text)
 -> Maybe (Range 1 127 [TeamMember])
 -> NonBindingNewTeam)
-> SchemaP
     SwaggerDoc Object [Pair] NonBindingNewTeam (Range 1 256 Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NonBindingNewTeam
     (Icon
      -> Maybe (Range 1 256 Text)
      -> Maybe (Range 1 127 [TeamMember])
      -> NonBindingNewTeam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (.teamName) (NonBindingNewTeam -> Range 1 256 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 256 Text) (Range 1 256 Text)
-> SchemaP
     SwaggerDoc Object [Pair] NonBindingNewTeam (Range 1 256 Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
-> SchemaP
     SwaggerDoc Object [Pair] (Range 1 256 Text) (Range 1 256 Text)
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
"name" ((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
"team name") SchemaP
  NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NonBindingNewTeam
  (Icon
   -> Maybe (Range 1 256 Text)
   -> Maybe (Range 1 127 [TeamMember])
   -> NonBindingNewTeam)
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam Icon
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NonBindingNewTeam
     (Maybe (Range 1 256 Text)
      -> Maybe (Range 1 127 [TeamMember]) -> NonBindingNewTeam)
forall a b.
SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam a
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.teamIcon) (NonBindingNewTeam -> Icon)
-> SchemaP SwaggerDoc Object [Pair] Icon Icon
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam Icon
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Icon Icon
-> SchemaP SwaggerDoc Object [Pair] Icon Icon
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
"icon" ((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
"team icon (asset ID)") SchemaP NamedSwaggerDoc Value Value Icon Icon
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NonBindingNewTeam
  (Maybe (Range 1 256 Text)
   -> Maybe (Range 1 127 [TeamMember]) -> NonBindingNewTeam)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NonBindingNewTeam
     (Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NonBindingNewTeam
     (Maybe (Range 1 127 [TeamMember]) -> NonBindingNewTeam)
forall a b.
SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam a
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.teamIconKey) (NonBindingNewTeam -> Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 256 Text))
     (Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NonBindingNewTeam
     (Maybe (Range 1 256 Text))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 256 Text)
  (Maybe (Range 1 256 Text))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 256 Text))
     (Maybe (Range 1 256 Text))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 256 Text)
     (Maybe (Range 1 256 Text))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier Text
"icon_key" ((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
"team icon asset key") SchemaP
  NamedSwaggerDoc Value Value (Range 1 256 Text) (Range 1 256 Text)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NonBindingNewTeam
  (Maybe (Range 1 127 [TeamMember]) -> NonBindingNewTeam)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NonBindingNewTeam
     (Maybe (Range 1 127 [TeamMember]))
-> SchemaP
     SwaggerDoc Object [Pair] NonBindingNewTeam NonBindingNewTeam
forall a b.
SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam a
-> SchemaP SwaggerDoc Object [Pair] NonBindingNewTeam b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (.teamMembers)
          (NonBindingNewTeam -> Maybe (Range 1 127 [TeamMember]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 127 [TeamMember]))
     (Maybe (Range 1 127 [TeamMember]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NonBindingNewTeam
     (Maybe (Range 1 127 [TeamMember]))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Range 1 127 [TeamMember])
  (Maybe (Range 1 127 [TeamMember]))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe (Range 1 127 [TeamMember]))
     (Maybe (Range 1 127 [TeamMember]))
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_
            ( Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 127 [TeamMember])
     (Range 1 127 [TeamMember])
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Range 1 127 [TeamMember])
     (Maybe (Range 1 127 [TeamMember]))
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
                Text
"members"
                ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"initial team member ids (between 1 and 127)")
                SchemaP
  SwaggerDoc
  Value
  Value
  (Range 1 127 [TeamMember])
  (Range 1 127 [TeamMember])
sch
            )
    where
      sch :: ValueSchema SwaggerDoc (Range 1 127 [TeamMember])
      sch :: SchemaP
  SwaggerDoc
  Value
  Value
  (Range 1 127 [TeamMember])
  (Range 1 127 [TeamMember])
sch = Range 1 127 [TeamMember] -> [TeamMember]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 127 [TeamMember] -> [TeamMember])
-> SchemaP
     SwaggerDoc Value Value [TeamMember] (Range 1 127 [TeamMember])
-> SchemaP
     SwaggerDoc
     Value
     Value
     (Range 1 127 [TeamMember])
     (Range 1 127 [TeamMember])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Value Value [TeamMember] [TeamMember]
-> SchemaP
     SwaggerDoc Value Value [TeamMember] (Range 1 127 [TeamMember])
forall (n :: Nat) (m :: Nat) d v w a b.
(KnownNat n, KnownNat m, Within a n m,
 HasRangedSchemaDocModifier d b) =>
SchemaP d v w a b -> SchemaP d v w a (Range n m b)
rangedSchema (ValueSchema NamedSwaggerDoc TeamMember
-> SchemaP SwaggerDoc Value Value [TeamMember] [TeamMember]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc TeamMember
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

type TeamAPI =
  Named
    "create-non-binding-team"
    ( Summary "Create a new non binding team"
        :> Until 'V4
        :> ZUser
        :> ZConn
        :> CanThrow InvalidAction
        :> "teams"
        :> ReqBody '[Servant.JSON] NonBindingNewTeam
        :> MultiVerb
             'POST
             '[JSON]
             '[ WithHeaders
                  '[DescHeader "Location" "Team ID" TeamId]
                  TeamId
                  (RespondEmpty 201 "Team ID as `Location` header value")
              ]
             TeamId
    )
    :<|> Named
           "update-team"
           ( Summary "Update team properties"
               :> ZUser
               :> ZConn
               :> CanThrow 'NotATeamMember
               :> CanThrow ('MissingPermission ('Just 'SetTeamData))
               :> "teams"
               :> Capture "tid" TeamId
               :> ReqBody '[JSON] TeamUpdateData
               :> MultiVerb
                    'PUT
                    '[JSON]
                    '[RespondEmpty 200 "Team updated"]
                    ()
           )
    :<|> Named
           "get-teams"
           ( Summary "Get teams (deprecated); use `GET /teams/:tid`"
               :> Until 'V4
               :> ZUser
               :> "teams"
               :> Get '[JSON] TeamList
           )
    :<|> Named
           "get-team"
           ( Summary "Get a team by ID"
               :> ZUser
               :> CanThrow 'TeamNotFound
               :> "teams"
               :> Capture "tid" TeamId
               :> Get '[JSON] Team
           )
    :<|> Named
           "delete-team"
           ( Summary "Delete a team"
               :> ZUser
               :> ZConn
               :> CanThrow 'TeamNotFound
               :> CanThrow ('MissingPermission ('Just 'DeleteTeam))
               :> CanThrow 'NotATeamMember
               :> CanThrow OperationDenied
               :> CanThrow 'DeleteQueueFull
               :> CanThrow AuthenticationError
               :> "teams"
               :> Capture "tid" TeamId
               :> ReqBody '[Servant.JSON] TeamDeleteData
               :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 202 "Team is scheduled for removal"] ()
           )