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

module Wire.API.Team
  ( -- * Team
    Team (..),
    newTeam,
    teamId,
    teamCreator,
    teamName,
    teamIcon,
    teamIconKey,
    teamBinding,
    teamSplashScreen,
    TeamBinding (..),
    Icon (..),

    -- * TeamList
    TeamList (..),
    newTeamList,
    teamListTeams,
    teamListHasMore,

    -- * NewTeam
    NewTeam (..),
    newTeamObjectSchema,
    newNewTeam,

    -- * TeamUpdateData
    TeamUpdateData (..),
    newTeamUpdateData,
    newTeamDeleteDataWithCode,
    nameUpdate,
    iconUpdate,
    iconKeyUpdate,
    splashScreenUpdate,

    -- * TeamDeleteData
    TeamDeleteData (..),
    newTeamDeleteData,
    tdAuthPassword,
    tdVerificationCode,

    -- * Misc
    TeamCreationTime (..),
    tcTime,
  )
where

import Control.Lens (makeLenses, over, (?~))
import Data.Aeson (FromJSON, ToJSON, Value (..), toJSON)
import Data.Aeson.Types (Parser)
import Data.Attoparsec.ByteString qualified as Atto (Parser, string)
import Data.Attoparsec.Combinator (choice)
import Data.ByteString.Conversion
import Data.Code qualified as Code
import Data.Id (TeamId, UserId)
import Data.Misc (PlainTextPassword6)
import Data.OpenApi (HasDeprecated (deprecated))
import Data.OpenApi qualified as S
import Data.Range
import Data.Schema
import Data.Text.Encoding qualified as T
import Imports
import Test.QuickCheck.Gen (suchThat)
import Wire.API.Asset (AssetKey)
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- Team

data Team = Team
  { _teamId :: TeamId,
    _teamCreator :: UserId,
    _teamName :: Text,
    _teamIcon :: Icon,
    _teamIconKey :: Maybe Text,
    _teamBinding :: TeamBinding,
    _teamSplashScreen :: Icon
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform Team)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema Team)

newTeam :: TeamId -> UserId -> Text -> Icon -> TeamBinding -> Team
newTeam tid uid nme ico tb = Team tid uid nme ico Nothing tb DefaultIcon

instance ToSchema Team where
  schema =
    objectWithDocModifier desc $
      Team
        <$> _teamId .= field "id" schema
        <*> _teamCreator .= field "creator" schema
        <*> _teamName .= field "name" schema
        <*> _teamIcon .= field "icon" schema
        <*> _teamIconKey .= maybe_ (optField "icon_key" schema)
        <*> _teamBinding .= (fromMaybe Binding <$> optFieldWithDocModifier "binding" bindingDesc schema)
        <*> _teamSplashScreen .= (fromMaybe DefaultIcon <$> optField "splash_screen" schema)
    where
      desc = description ?~ "`binding` is deprecated, and should be ignored. The non-binding teams API is not used (and will not be supported from API version V4 onwards), and `binding` will always be `true`."
      bindingDesc v =
        v
          & description ?~ "Deprecated, please ignore."
          & deprecated ?~ True

-- | How a team "binds" its members (users)
--
-- A `Binding` team is the normal team which we see in the UI. A user is
-- on-boarded as part of the team. If the team gets deleted/suspended the user
-- gets deleted/suspended.
--
-- A `NonBinding` team is a concept only in the backend. It is a team someone
-- can create and someone who has an account on Wire can join that team. This
-- way, in theory, one person can join many teams. This concept never made it as
-- a concept of product, but got used a lot of writing integration tests. Newer
-- features don't really work well with this and sometimes we have to rewrite
-- parts of the tests to use `Binding` teams.
--
-- Please try to not use `NonBinding` teams in tests anymore. In future, we
-- would like it to be deleted, but it is hard to delete because it requires a
-- bunch of tests to be rewritten.
data TeamBinding
  = Binding
  | NonBinding
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform TeamBinding)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema TeamBinding)

instance ToSchema TeamBinding where
  schema =
    over doc (deprecated ?~ True) $
      enum @Bool $
        mconcat [element True Binding, element False NonBinding]

--------------------------------------------------------------------------------
-- TeamList

data TeamList = TeamList
  { _teamListTeams :: [Team],
    _teamListHasMore :: Bool
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform TeamList)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema TeamList)

newTeamList :: [Team] -> Bool -> TeamList
newTeamList = TeamList

instance ToSchema TeamList where
  schema =
    object $
      TeamList
        <$> _teamListTeams .= field "teams" (array schema)
        <*> _teamListHasMore .= field "has_more" schema

--------------------------------------------------------------------------------
-- NewTeam

data NewTeam = NewTeam
  { newTeamName :: Range 1 256 Text,
    newTeamIcon :: Icon,
    newTeamIconKey :: Maybe (Range 1 256 Text)
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewTeam)
  deriving (Arbitrary) via (GenericUniform NewTeam)

newTeamObjectSchema :: ObjectSchema SwaggerDoc NewTeam
newTeamObjectSchema =
  NewTeam
    <$> newTeamName .= fieldWithDocModifier "name" (description ?~ "team name") schema
    <*> newTeamIcon .= field "icon" schema
    <*> newTeamIconKey .= maybe_ (optFieldWithDocModifier "icon_key" (description ?~ "The decryption key for the team icon S3 asset") schema)

instance ToSchema NewTeam where
  schema = object newTeamObjectSchema

newNewTeam :: Range 1 256 Text -> Icon -> NewTeam
newNewTeam nme ico = NewTeam nme ico Nothing

--------------------------------------------------------------------------------
-- TeamUpdateData

data Icon = Icon AssetKey | DefaultIcon
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform Icon)
  deriving (ToJSON, FromJSON, S.ToSchema) via Schema Icon

instance FromByteString Icon where
  parser =
    choice
      [ Icon <$> (parser :: Atto.Parser AssetKey),
        DefaultIcon <$ Atto.string "default"
      ]

instance ToByteString Icon where
  builder (Icon key) = builder key
  builder DefaultIcon = "default"

instance ToSchema Icon where
  schema =
    (T.decodeUtf8 . toByteString')
      .= parsedTextWithDoc desc "Icon" (runParser parser . T.encodeUtf8)
      & doc' . S.schema . S.example ?~ toJSON ("3-1-47de4580-ae51-4650-acbb-d10c028cb0ac" :: Text)
    where
      desc =
        "S3 asset key for an icon image with retention information. Allows special value 'default'."

-- | Cassandra writetime(binding) timestamp
newtype TeamCreationTime = TeamCreationTime
  { _tcTime :: Int64
  }

makeLenses ''TeamCreationTime

data TeamUpdateData = TeamUpdateData
  { _nameUpdate :: Maybe (Range 1 256 Text),
    _iconUpdate :: Maybe Icon,
    _iconKeyUpdate :: Maybe (Range 1 256 Text),
    _splashScreenUpdate :: Maybe Icon
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema TeamUpdateData)

instance Arbitrary TeamUpdateData where
  arbitrary = arb `suchThat` valid
    where
      arb = TeamUpdateData <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
      valid (TeamUpdateData Nothing Nothing Nothing Nothing) = False
      valid _ = True

newTeamUpdateData :: TeamUpdateData
newTeamUpdateData = TeamUpdateData Nothing Nothing Nothing Nothing

validateTeamUpdateData :: TeamUpdateData -> Parser TeamUpdateData
validateTeamUpdateData u =
  when
    (isNothing (_nameUpdate u) && isNothing (_iconUpdate u) && isNothing (_iconKeyUpdate u) && isNothing (_splashScreenUpdate u))
    (fail "TeamUpdateData: no update data specified")
    $> u

instance ToSchema TeamUpdateData where
  schema =
    (`withParser` validateTeamUpdateData)
      . object
      $ TeamUpdateData
        <$> _nameUpdate .= maybe_ (optField "name" schema)
        <*> _iconUpdate .= maybe_ (optField "icon" schema)
        <*> _iconKeyUpdate .= maybe_ (optField "icon_key" schema)
        <*> _splashScreenUpdate .= maybe_ (optField "splash_screen" schema)

--------------------------------------------------------------------------------
-- TeamDeleteData

data TeamDeleteData = TeamDeleteData
  { _tdAuthPassword :: Maybe PlainTextPassword6,
    _tdVerificationCode :: Maybe Code.Value
  }
  deriving stock (Eq, Show)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema TeamDeleteData)

instance Arbitrary TeamDeleteData where
  arbitrary = TeamDeleteData <$> arbitrary <*> arbitrary

newTeamDeleteData :: Maybe PlainTextPassword6 -> TeamDeleteData
newTeamDeleteData = flip TeamDeleteData Nothing

newTeamDeleteDataWithCode :: Maybe PlainTextPassword6 -> Maybe Code.Value -> TeamDeleteData
newTeamDeleteDataWithCode = TeamDeleteData

instance ToSchema TeamDeleteData where
  schema =
    object $
      TeamDeleteData
        <$> _tdAuthPassword .= optField "password" (maybeWithDefault Null schema)
        <*> _tdVerificationCode .= maybe_ (optField "verification_code" schema)

makeLenses ''Team
makeLenses ''TeamList
makeLenses ''TeamUpdateData
makeLenses ''TeamDeleteData
