{-# LANGUAGE RecordWildCards #-}
{-# 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.UserEvent where

import Control.Lens ((?~))
import Control.Lens.TH
import Data.Aeson qualified as A
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Conversion
import Data.Handle (Handle)
import Data.Id
import Data.Json.Util
import Data.Qualified
import Data.Schema
import Imports
import System.Logger.Message hiding (field, (.=))
import Wire.API.Connection
import Wire.API.Locale
import Wire.API.Properties
import Wire.API.Push.V2 qualified as V2
import Wire.API.Routes.Version
import Wire.API.User
import Wire.API.User.Client
import Wire.API.User.Client.Prekey

data Event
  = UserEvent !UserEvent
  | ConnectionEvent !ConnectionEvent
  | PropertyEvent !PropertyEvent
  | ClientEvent !ClientEvent
  | UserGroupEvent !UserGroupEvent
  deriving stock (Eq, Show)

toApsData :: Event -> Maybe V2.ApsData
toApsData (ConnectionEvent (ConnectionUpdated uc name)) =
  case (ucStatus uc, name) of
    (MissingLegalholdConsent, _) -> Nothing
    (Pending, n) -> apsConnRequest <$> n
    (Accepted, n) -> apsConnAccept <$> n
    (Blocked, _) -> Nothing
    (Ignored, _) -> Nothing
    (Sent, _) -> Nothing
    (Cancelled, _) -> Nothing
  where
    apsConnRequest n =
      V2.apsData (V2.ApsLocKey "push.notification.connection.request") [fromName n]
        & V2.apsSound ?~ V2.ApsSound "new_message_apns.caf"
    apsConnAccept n =
      V2.apsData (V2.ApsLocKey "push.notification.connection.accepted") [fromName n]
        & V2.apsSound ?~ V2.ApsSound "new_message_apns.caf"
toApsData _ = Nothing

eventType :: Event -> EventType
eventType (UserEvent (UserCreated _)) = EventTypeUserCreated
eventType (UserEvent (UserActivated _)) = EventTypeUserActivated
eventType (UserEvent (UserSuspended _)) = EventTypeUserSuspended
eventType (UserEvent (UserResumed _)) = EventTypeUserResumed
eventType (UserEvent (UserDeleted _)) = EventTypeUserDeleted
eventType (UserEvent (UserUpdated _)) = EventTypeUserUpdated
eventType (UserEvent (UserIdentityUpdated _)) = EventTypeUserUpdated
eventType (UserEvent (UserIdentityRemoved _)) = EventTypeUserIdentityRemoved
eventType (UserEvent (UserLegalHoldDisabled _)) = EventTypeUserLegalholdDisabled
eventType (UserEvent (UserLegalHoldEnabled _)) = EventTypeUserLegalholdEnabled
eventType (UserEvent (LegalHoldClientRequested _)) = EventTypeUserLegalholdRequested
eventType (UserEvent UserSessionRefreshSuggested) = EventTypeUserSessionRefreshSuggested
eventType (ConnectionEvent _) = EventTypeConnection
eventType (PropertyEvent (PropertySet _ _)) = EventTypePropertiesSet
eventType (PropertyEvent (PropertyDeleted _)) = EventTypePropertiesDeleted
eventType (PropertyEvent PropertiesCleared) = EventTypePropertiesCleared
eventType (ClientEvent (ClientAdded _)) = EventTypeClientAdded
eventType (ClientEvent (ClientRemoved _)) = EventTypeClientRemoved
eventType (UserGroupEvent (UserGroupCreated _)) = EventTypeUserGroupCreated
eventType (UserGroupEvent (UserGroupUpdated _)) = EventTypeUserGroupUpdated
eventType (UserGroupEvent (UserGroupDeleted _)) = EventTypeUserGroupDeleted

data EventType
  = EventTypeUserCreated
  | EventTypeUserActivated
  | EventTypeUserUpdated
  | EventTypeUserIdentityRemoved
  | EventTypeUserSuspended
  | EventTypeUserResumed
  | EventTypeUserDeleted
  | EventTypeUserLegalholdEnabled
  | EventTypeUserLegalholdDisabled
  | EventTypeUserLegalholdRequested
  | EventTypePropertiesSet
  | EventTypePropertiesDeleted
  | EventTypePropertiesCleared
  | EventTypeClientAdded
  | EventTypeClientRemoved
  | EventTypeConnection
  | EventTypeUserGroupCreated
  | EventTypeUserGroupUpdated
  | EventTypeUserGroupDeleted
  | EventTypeUserSessionRefreshSuggested
  deriving stock (Show, Eq, Enum, Bounded)

instance ToSchema EventType where
  schema =
    enum @Text $
      mconcat
        [ element "user.new" EventTypeUserCreated,
          element "user.activate" EventTypeUserActivated,
          element "user.update" EventTypeUserUpdated,
          element "user.identity-remove" EventTypeUserIdentityRemoved,
          element "user.suspend" EventTypeUserSuspended,
          element "user.resume" EventTypeUserResumed,
          element "user.delete" EventTypeUserDeleted,
          element "user.legalhold-enable" EventTypeUserLegalholdEnabled,
          element "user.legalhold-disable" EventTypeUserLegalholdDisabled,
          element "user.legalhold-request" EventTypeUserLegalholdRequested,
          element "user.session-refresh-suggested" EventTypeUserSessionRefreshSuggested,
          element "user.properties-set" EventTypePropertiesSet,
          element "user.properties-delete" EventTypePropertiesDeleted,
          element "user.properties-clear" EventTypePropertiesCleared,
          element "user.client-add" EventTypeClientAdded,
          element "user.client-remove" EventTypeClientRemoved,
          element "user.connection" EventTypeConnection,
          element "user-group.created" EventTypeUserGroupCreated,
          element "user-group.updated" EventTypeUserGroupUpdated,
          element "user-group.deleted" EventTypeUserGroupDeleted
        ]

data UserEvent
  = UserCreated !User
  | -- | A user is activated when the first user identity (email address)
    -- is verified. {#RefActivationEvent}
    UserActivated !User
  | -- | Account & API access of a user has been suspended.
    UserSuspended !UserId
  | -- | Account & API access of a previously suspended user
    -- has been restored.
    UserResumed !UserId
  | -- | The user account has been deleted.
    UserDeleted !(Qualified UserId)
  | UserUpdated !UserUpdatedData
  | UserIdentityUpdated !UserIdentityUpdatedData
  | UserIdentityRemoved !UserIdentityRemovedData
  | UserLegalHoldDisabled !UserId
  | UserLegalHoldEnabled !UserId
  | LegalHoldClientRequested LegalHoldClientRequestedData
  | UserSessionRefreshSuggested
  deriving stock (Eq, Show)

data UserGroupEvent
  = UserGroupCreated !UserGroupId
  | UserGroupUpdated !UserGroupId
  | UserGroupDeleted !UserGroupId
  deriving stock (Eq, Show)

data ConnectionEvent = ConnectionUpdated
  { ucConn :: !UserConnection,
    ucName :: !(Maybe Name)
  }
  deriving stock (Eq, Show)

data PropertyEvent
  = PropertySet !PropertyKey !A.Value
  | PropertyDeleted !PropertyKey
  | PropertiesCleared
  deriving stock (Eq, Show)

data ClientEvent
  = ClientAdded !Client
  | ClientRemoved !ClientId
  deriving stock (Eq, Show)

data UserUpdatedData = UserUpdatedData
  { eupId :: !UserId,
    eupName :: !(Maybe Name),
    eupTextStatus :: !(Maybe TextStatus),
    -- | DEPRECATED
    eupPict :: !(Maybe Pict),
    eupAccentId :: !(Maybe ColourId),
    eupAssets :: !(Maybe [Asset]),
    eupHandle :: !(Maybe Handle),
    eupLocale :: !(Maybe Locale),
    eupManagedBy :: !(Maybe ManagedBy),
    eupSSOId :: !(Maybe UserSSOId),
    eupSSOIdRemoved :: Bool,
    eupSupportedProtocols :: !(Maybe (Set BaseProtocolTag)),
    eupTeam :: !(Maybe TeamId)
  }
  deriving stock (Eq, Show)

data UserIdentityUpdatedData = UserIdentityUpdatedData
  { eiuId :: !UserId,
    eiuEmail :: !(Maybe EmailAddress),
    eiuPhone :: !(Maybe Phone)
  }
  deriving stock (Eq, Show)

data UserIdentityRemovedData = UserIdentityRemovedData
  { eirId :: !UserId,
    eirEmail :: !(Maybe EmailAddress),
    eirPhone :: !(Maybe Phone)
  }
  deriving stock (Eq, Show)

data LegalHoldClientRequestedData = LegalHoldClientRequestedData
  { -- | the user that is under legalhold
    lhcTargetUser :: !UserId,
    -- | the last prekey of the user that is under legalhold
    lhcLastPrekey :: !LastPrekey,
    -- | the client id of the legalhold device
    lhcClientId :: !ClientId
  }
  deriving stock (Eq, Show)

emailRemoved :: UserId -> EmailAddress -> UserEvent
emailRemoved u e =
  UserIdentityRemoved $ UserIdentityRemovedData u (Just e) Nothing

emailUpdated :: UserId -> EmailAddress -> UserEvent
emailUpdated u e =
  UserIdentityUpdated $ UserIdentityUpdatedData u (Just e) Nothing

teamUpdated :: UserId -> TeamId -> UserEvent
teamUpdated u t = UserUpdated (emptyUserUpdatedData u) {eupTeam = Just t}

emptyUserUpdatedData :: UserId -> UserUpdatedData
emptyUserUpdatedData u =
  UserUpdatedData
    { eupId = u,
      eupName = Nothing,
      eupTextStatus = Nothing,
      eupPict = Nothing,
      eupAccentId = Nothing,
      eupAssets = Nothing,
      eupHandle = Nothing,
      eupLocale = Nothing,
      eupManagedBy = Nothing,
      eupSSOId = Nothing,
      eupSSOIdRemoved = False,
      eupSupportedProtocols = Nothing,
      eupTeam = Nothing
    }

-- Event schema

$(makePrisms ''Event)
$(makePrisms ''UserEvent)
$(makePrisms ''PropertyEvent)
$(makePrisms ''ClientEvent)
$(makePrisms ''UserGroupEvent)

eventObjectSchema :: ObjectSchema SwaggerDoc Event
eventObjectSchema =
  snd
    <$> bind
      (eventType .= field "type" schema)
      ( dispatch $ \case
          EventTypeUserCreated ->
            tag _UserEvent (tag _UserCreated (noId .= userSchema))
          EventTypeUserActivated ->
            tag _UserEvent (tag _UserActivated userSchema)
          EventTypeUserUpdated ->
            tag
              _UserEvent
              ( tag
                  _UserUpdated
                  ( field
                      "user"
                      ( object
                          ( UserUpdatedData
                              <$> eupId .= field "id" schema
                              <*> eupName .= maybe_ (optField "name" schema)
                              <*> eupTextStatus .= maybe_ (optField "text_status" schema)
                              <*> eupPict .= maybe_ (optField "picture" schema) -- DEPRECATED
                              <*> eupAccentId .= maybe_ (optField "accent_id" schema)
                              <*> eupAssets .= maybe_ (optField "assets" (array schema))
                              <*> eupHandle .= maybe_ (optField "handle" schema)
                              <*> eupLocale .= maybe_ (optField "locale" schema)
                              <*> eupManagedBy .= maybe_ (optField "managed_by" schema)
                              <*> eupSSOId .= maybe_ (optField "sso_id" genericToSchema)
                              <*> eupSSOIdRemoved .= field "sso_id_deleted" schema
                              <*> eupSupportedProtocols .= maybe_ (optField "supported_protocols" (set schema))
                              <*> eupTeam .= maybe_ (optField "team" schema)
                          )
                      )
                  )
                  <|> tag
                    _UserIdentityUpdated
                    ( field
                        "user"
                        ( object
                            ( UserIdentityUpdatedData
                                <$> eiuId .= field "id" schema
                                <*> eiuEmail .= maybe_ (optField "email" schema)
                                <*> eiuPhone .= maybe_ (optField "phone" schema)
                            )
                        )
                    )
              )
          EventTypeUserIdentityRemoved ->
            tag
              _UserEvent
              ( tag
                  _UserIdentityRemoved
                  ( field
                      "user"
                      ( object
                          ( UserIdentityRemovedData
                              <$> eirId .= field "id" schema
                              <*> eirEmail .= maybe_ (optField "email" schema)
                              <*> eirPhone .= maybe_ (optField "phone" schema)
                          )
                      )
                  )
              )
          EventTypeUserSuspended -> tag _UserEvent (tag _UserSuspended (field "id" schema))
          EventTypeUserResumed -> tag _UserEvent (tag _UserResumed (field "id" schema))
          EventTypeUserDeleted ->
            tag
              _UserEvent
              ( tag
                  _UserDeleted
                  ( field "qualified_id" schema
                      <* qUnqualified .= field "id" schema
                  )
              )
          EventTypeUserLegalholdEnabled ->
            tag
              _UserEvent
              (tag _UserLegalHoldEnabled (field "id" schema))
          EventTypeUserLegalholdDisabled ->
            tag
              _UserEvent
              (tag _UserLegalHoldDisabled (field "id" schema))
          EventTypeUserLegalholdRequested ->
            tag
              _UserEvent
              ( tag
                  _LegalHoldClientRequested
                  ( LegalHoldClientRequestedData
                      <$> lhcTargetUser .= field "id" schema
                      <*> lhcLastPrekey .= field "last_prekey" schema
                      <*> lhcClientId .= field "client" (idObjectSchema schema)
                  )
              )
          EventTypeUserSessionRefreshSuggested ->
            tag
              _UserEvent
              (tag _UserSessionRefreshSuggested (pure ()))
          EventTypePropertiesSet ->
            tag
              _PropertyEvent
              ( tag
                  _PropertySet
                  ( (,)
                      <$> fst .= field "key" genericToSchema
                      <*> snd .= field "value" jsonValue
                  )
              )
          EventTypePropertiesDeleted ->
            tag
              _PropertyEvent
              ( tag
                  _PropertyDeleted
                  (field "key" genericToSchema)
              )
          EventTypePropertiesCleared ->
            tag
              _PropertyEvent
              ( tag
                  _PropertiesCleared
                  (pure ())
              )
          EventTypeClientAdded ->
            tag
              _ClientEvent
              ( tag
                  _ClientAdded
                  (field "client" (clientSchema (Just V6)))
              )
          EventTypeClientRemoved ->
            tag
              _ClientEvent
              ( tag
                  _ClientRemoved
                  (field "client" (idObjectSchema schema))
              )
          EventTypeConnection ->
            tag
              _ConnectionEvent
              ( ConnectionUpdated
                  <$> ucConn .= field "connection" schema
                  <*> ucName .= maybe_ (optField "user" (object (field "name" schema)))
              )
          EventTypeUserGroupCreated ->
            tag
              _UserGroupEvent
              ( tag
                  _UserGroupCreated
                  (field "user_group" (idObjectSchema schema))
              )
          EventTypeUserGroupUpdated ->
            tag
              _UserGroupEvent
              ( tag
                  _UserGroupUpdated
                  (field "user_group" (idObjectSchema schema))
              )
          EventTypeUserGroupDeleted ->
            tag
              _UserGroupEvent
              ( tag
                  _UserGroupDeleted
                  (field "user_group" (idObjectSchema schema))
              )
      )
  where
    noId :: User -> User
    noId u = u {userIdentity = Nothing}

    userSchema :: ObjectSchema SwaggerDoc User
    userSchema = field "user" schema

instance ToJSONObject Event where
  toJSONObject = KM.fromList . fold . schemaOut eventObjectSchema

instance ToSchema Event where
  schema = object eventObjectSchema

deriving via (Schema Event) instance A.ToJSON Event

deriving via (Schema Event) instance A.FromJSON Event

-- Logging

connEventUserId :: ConnectionEvent -> UserId
connEventUserId ConnectionUpdated {..} = ucFrom ucConn

instance ToBytes Event where
  bytes (UserEvent e) = bytes e
  bytes (ConnectionEvent e) = bytes e
  bytes (PropertyEvent e) = bytes e
  bytes (ClientEvent e) = bytes e
  bytes (UserGroupEvent e) = bytes e

instance ToBytes UserEvent where
  bytes (UserCreated u) = val "user.new: " +++ toByteString (userId u)
  bytes (UserActivated u) = val "user.activate: " +++ toByteString (userId u)
  bytes (UserUpdated u) = val "user.update: " +++ toByteString (eupId u)
  bytes (UserIdentityUpdated u) = val "user.update: " +++ toByteString (eiuId u)
  bytes (UserIdentityRemoved u) = val "user.identity-remove: " +++ toByteString (eirId u)
  bytes (UserSuspended u) = val "user.suspend: " +++ toByteString u
  bytes (UserResumed u) = val "user.resume: " +++ toByteString u
  bytes (UserDeleted u) = val "user.delete: " +++ toByteString (qUnqualified u) +++ val "@" +++ toByteString (qDomain u)
  bytes (UserLegalHoldDisabled u) = val "user.legalhold-disable: " +++ toByteString u
  bytes (UserLegalHoldEnabled u) = val "user.legalhold-enable: " +++ toByteString u
  bytes (LegalHoldClientRequested payload) = val "user.legalhold-request: " +++ show payload
  bytes UserSessionRefreshSuggested = val "user.session-refresh-suggested"

instance ToBytes ConnectionEvent where
  bytes e@ConnectionUpdated {} = val "user.connection: " +++ toByteString (connEventUserId e)

instance ToBytes PropertyEvent where
  bytes PropertySet {} = val "user.properties-set"
  bytes PropertyDeleted {} = val "user.properties-delete"
  bytes PropertiesCleared {} = val "user.properties-clear"

instance ToBytes ClientEvent where
  bytes (ClientAdded _) = val "user.client-add"
  bytes (ClientRemoved _) = val "user.client-remove"

instance ToBytes UserGroupEvent where
  bytes (UserGroupCreated u) = val "user-group.created: " +++ toByteString u
  bytes (UserGroupUpdated u) = val "user-group.updated: " +++ toByteString u
  bytes (UserGroupDeleted u) = val "user-group.deleted: " +++ toByteString u
