-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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.Meeting where

import Control.Lens ((?~))
import Data.Aeson (toJSON)
import Data.Id (ConvId, MeetingId, UserId)
import Data.Int qualified as DI
import Data.Json.Util (utcTimeSchema)
import Data.OpenApi qualified as S
import Data.Qualified (Qualified)
import Data.Range (Range)
import Data.Schema
import Data.Time.Clock
import Deriving.Aeson
import Imports
import Wire.API.Conversation (Conversation, GroupConvType)
import Wire.API.PostgresMarshall (PostgresMarshall (..), PostgresUnmarshall (..))
import Wire.API.Routes.Version
import Wire.API.Routes.Versioned (Versioned (..))
import Wire.API.User.Identity (EmailAddress)
import Wire.Arbitrary (Arbitrary, GenericUniform (..))

-- | Core Meeting type
data Meeting = Meeting
  { id :: Qualified MeetingId,
    title :: Range 1 256 Text,
    creator :: Qualified UserId,
    startTime :: UTCTime,
    endTime :: UTCTime,
    recurrence :: Maybe Recurrence,
    conversationId :: Qualified ConvId,
    invitedEmails :: [EmailAddress],
    createdAt :: UTCTime,
    updatedAt :: UTCTime
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema Meeting)
  deriving (Arbitrary) via (GenericUniform Meeting)

meetingObject :: ObjectSchema SwaggerDoc Meeting
meetingObject =
  Meeting
    <$> (.id) .= field "qualified_id" schema
    <*> (.title) .= field "title" schema
    <*> (.creator) .= field "qualified_creator" schema
    <*> (.startTime) .= field "start_time" utcTimeSchema
    <*> (.endTime) .= field "end_time" utcTimeSchema
    <*> (.recurrence) .= maybe_ (optField "recurrence" schema)
    <*> (.conversationId) .= field "qualified_conversation" schema
    <*> (.invitedEmails) .= field "invited_emails" (array schema)
    <*> (.createdAt) .= field "created_at" utcTimeSchema
    <*> (.updatedAt) .= field "updated_at" utcTimeSchema

-- | 'meetingObject' for a given API version. Legacy versions (< V17) additionally
-- render the deprecated @trial@ field (always 'False'); V17 and later omit it.
meetingObjectVersioned :: Maybe Version -> ObjectSchema SwaggerDoc Meeting
meetingObjectVersioned v
  | maybe False (< V17) v =
      meetingObject
        <* ( const ()
               .= fieldWithDocModifier
                 "trial"
                 (description ?~ "Deprecated. Always false; team meetings are never trial.")
                 (c (False :: Bool))
           )
  | otherwise = meetingObject
  where
    -- Constant schema that always encodes @val@ and decodes to @()@, cf. the
    -- @managed@ field of 'Wire.API.Conversation.ConvTeamInfo'.
    c :: (ToJSON a) => a -> ValueSchema SwaggerDoc ()
    c val = mkSchema mempty (const (pure ())) (const (pure (toJSON val)))

-- | Swagger-named ('ValueSchema') form of 'meetingObjectVersioned', used by the
-- plain 'ToSchema' instance and the versioned 'Versioned' instances.
meetingSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Meeting
meetingSchema v =
  versionedObjectWithDocModifier v (description ?~ "A scheduled meeting") (meetingObjectVersioned v)

instance ToSchema Meeting where
  schema = meetingSchema Nothing

instance ToSchema (Versioned 'V15 Meeting) where
  schema = Versioned <$> unVersioned .= meetingSchema (Just V15)

-- | A 'Meeting' extended with the full 'Conversation' associated with it, as
-- returned when creating or updating a meeting. The underlying 'Meeting' is
-- reused (no field duplication) and flattened into the JSON object in the
-- 'ToSchema' instance, so that the legacy @qualified_conversation@ field and
-- the full @conversation@ are returned alongside the meeting fields.
data MeetingWithConversation = MeetingWithConversation
  { meeting :: Meeting,
    conversation :: Conversation GroupConvType
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema MeetingWithConversation)
  deriving (Arbitrary) via (GenericUniform MeetingWithConversation)

meetingWithConversationObject :: Maybe Version -> ObjectSchema SwaggerDoc MeetingWithConversation
meetingWithConversationObject v =
  MeetingWithConversation
    <$> (.meeting) .= meetingObjectVersioned v
    <*> (.conversation) .= field "conversation" schema

meetingWithConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc MeetingWithConversation
meetingWithConversationSchema v =
  versionedObjectWithDocModifier
    v
    (description ?~ "A scheduled meeting with its associated conversation")
    (meetingWithConversationObject v)

instance ToSchema MeetingWithConversation where
  schema = meetingWithConversationSchema Nothing

instance ToSchema (Versioned 'V15 MeetingWithConversation) where
  schema = Versioned <$> unVersioned .= meetingWithConversationSchema (Just V15)

-- | Legacy 'Meeting' list (V16) still renders the deprecated @trial@ field
-- (always 'False') for backwards compatibility.
instance {-# OVERLAPPING #-} ToSchema (Versioned 'V16 [Meeting]) where
  schema =
    Versioned
      <$> unVersioned
        .= named "MeetingListV16" (array (meetingSchema (Just V16)))

-- | Request to create a new meeting
data NewMeeting = NewMeeting
  { startTime :: UTCTime,
    endTime :: UTCTime,
    recurrence :: Maybe Recurrence,
    title :: Range 1 256 Text,
    invitedEmails :: [EmailAddress]
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewMeeting)
  deriving (Arbitrary) via (GenericUniform NewMeeting)

data Recurrence = Recurrence
  { -- | The interval between occurrences, e.g., every 2 weeks for Weekly frequency with interval=2
    freq :: Frequency,
    interval :: Int,
    until :: Maybe UTCTime
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema Recurrence)
  deriving (Arbitrary) via (GenericUniform Recurrence)

data Frequency = Daily | Weekly | Monthly | Yearly
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema Frequency)
  deriving (Arbitrary) via (GenericUniform Frequency)

instance ToSchema Frequency where
  schema =
    enum @Text $
      mconcat
        [ element "daily" Daily,
          element "weekly" Weekly,
          element "monthly" Monthly,
          element "yearly" Yearly
        ]

instance ToSchema NewMeeting where
  schema =
    objectWithDocModifier (description ?~ "Request to create a new meeting") $
      NewMeeting
        <$> (.startTime) .= field "start_time" utcTimeSchema
        <*> (.endTime) .= field "end_time" utcTimeSchema
        <*> (.recurrence) .= maybe_ (optField "recurrence" schema)
        <*> (.title) .= field "title" schema
        <*> (.invitedEmails) .= (fromMaybe [] <$> optField "invited_emails" (array schema))

-- | Request to update an existing meeting
data UpdateMeeting = UpdateMeeting
  { startTime :: Maybe UTCTime,
    endTime :: Maybe UTCTime,
    title :: Maybe (Range 1 256 Text),
    -- | 'Just x' means "set 'recurrence' to 'x', meaning set to a value or unset it"
    recurrence :: Maybe (Maybe Recurrence)
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema UpdateMeeting)
  deriving (Arbitrary) via (GenericUniform UpdateMeeting)

instance ToSchema UpdateMeeting where
  schema =
    objectWithDocModifier (description ?~ "Request to update a meeting") $
      UpdateMeeting
        <$> (.startTime) .= maybe_ (optField "start_time" utcTimeSchema)
        <*> (.endTime) .= maybe_ (optField "end_time" utcTimeSchema)
        <*> (.title) .= maybe_ (optField "title" schema)
        <*> (.recurrence) .= fmap Just (maybe_ (maybe_ (optField' "recurrence" schema)))

instance ToSchema Recurrence where
  schema =
    objectWithDocModifier (description ?~ "Recurrence pattern for meetings") $
      Recurrence
        <$> (.freq) .= field "frequency" schema
        <*> (.interval) .= (fromMaybe 1 <$> optField "interval" schema)
        <*> (.until) .= maybe_ (optField "until" utcTimeSchema)

-- | Request to add/remove invited email
newtype MeetingEmailsInvitation = MeetingEmailsInvitation
  { emails :: [EmailAddress]
  }
  deriving stock (Eq, Show, Generic)
  deriving (ToJSON, FromJSON, S.ToSchema) via (Schema MeetingEmailsInvitation)
  deriving (Arbitrary) via (GenericUniform MeetingEmailsInvitation)

instance ToSchema MeetingEmailsInvitation where
  schema =
    objectWithDocModifier (description ?~ "Emails invitation") $
      MeetingEmailsInvitation
        <$> (.emails) .= field "emails" (array schema)

instance PostgresMarshall (Maybe Text, Maybe DI.Int32, Maybe UTCTime) (Maybe Recurrence) where
  postgresMarshall Nothing = (Nothing, Nothing, Nothing)
  postgresMarshall (Just r) =
    ( Just $ case r.freq of
        Daily -> "daily"
        Weekly -> "weekly"
        Monthly -> "monthly"
        Yearly -> "yearly",
      Just (fromIntegral r.interval),
      r.until
    )

instance PostgresUnmarshall (Maybe Text, Maybe DI.Int32, Maybe UTCTime) (Maybe Recurrence) where
  postgresUnmarshall (Nothing, _, _) = Right Nothing
  postgresUnmarshall (Just f, Just i, u) = do
    freq <- case f of
      "daily" -> Right Daily
      "weekly" -> Right Weekly
      "monthly" -> Right Monthly
      "yearly" -> Right Yearly
      _ -> Left $ "Unknown frequency: " <> f
    pure . Just $
      Recurrence
        { freq = freq,
          interval = fromIntegral i,
          until = u
        }
  postgresUnmarshall (Just _, Nothing, _) = Left "Missing interval for recurrence"
