-- 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/>.

-- | Curate native push tokens based on provider feedback reported
-- via SNS events.
module Gundeck.React
  ( onEvent,
  )
where

import Control.Lens (view, (.~), (^.))
import Data.ByteString.Conversion
import Data.Id (ClientId, UserId)
import Data.List qualified as List
import Data.List.NonEmpty qualified as NonEmpty
import Data.Set qualified as Set
import Data.Text qualified as Text
import Gundeck.Aws (SNSEndpoint, endpointEnabled, endpointToken, endpointUsers)
import Gundeck.Aws qualified as Aws
import Gundeck.Aws.Arn
import Gundeck.Aws.Sns
import Gundeck.Env
import Gundeck.Instances ()
import Gundeck.Monad
import Gundeck.Notification.Data qualified as Stream
import Gundeck.Options (notificationTTL, settings)
import Gundeck.Push.Data qualified as Push
import Gundeck.Push.Native.Types
import Gundeck.Push.Websocket qualified as Web
import Imports
import System.Logger.Class (Msg, msg, val, (+++), (.=), (~~))
import System.Logger.Class qualified as Log
import Wire.API.Event.Gundeck
import Wire.API.Internal.Notification
import Wire.API.Notification (mkNotificationId)
import Wire.API.Push.V2

onEvent :: Event -> Gundeck ()
onEvent ev = case ev ^. evType of
  EndpointUpdated -> onUpdated ev
  DeliveryFailure DeliveryInvalidToken -> onPermFailure ev
  DeliveryFailure DeliveryEndpointDisabled -> onFailure ev
  DeliveryFailure DeliveryFailedPerm -> onPermFailure ev
  DeliveryFailure DeliveryTTLExpired -> onTTLExpired ev
  DeliveryFailure (DeliveryUnknownFailure r) -> onUnknownFailure ev r
  _ -> onUnhandledEventType ev

onUpdated :: Event -> Gundeck ()
onUpdated ev = withEndpoint ev $ \e as ->
  if not (e ^. endpointEnabled)
    then do
      forM_ as $ \a -> do
        logUserEvent (a ^. addrUser) ev $ msg (val "Removing disabled token")
        deleteToken (a ^. addrUser) ev (a ^. addrToken) (a ^. addrClient)
      deleteEndpoint ev
    else do
      -- Note: The assumption is always that if the tokens differ, then
      --       the token in the SNS endpoint has been updated due to provider
      --       feedback (e.g. GCM canonical IDs) and the new token must
      --       already have been registered by the client. Hence the
      --       existing tokens are considered superseded and removed.
      --       This is crucial for proper token curation.
      let (sup, cur) = List.partition (\a -> e ^. endpointToken /= a ^. addrToken) as
      forM_ sup $ \a -> do
        logUserEvent (a ^. addrUser) ev $ msg (val "Removing superseded token")
        deleteToken (a ^. addrUser) ev (a ^. addrToken) (a ^. addrClient)
      if
        | null sup -> pure ()
        | null cur -> deleteEndpoint ev
        | otherwise -> updateEndpoint ev e (map (view addrUser) cur)

onFailure :: Event -> Gundeck ()
onFailure ev = withEndpoint ev $ \e as ->
  unless (e ^. endpointEnabled) $ do
    forM_ as $ \a -> do
      logUserEvent (a ^. addrUser) ev $ msg (val "Removing disabled token")
      deleteToken (a ^. addrUser) ev (a ^. addrToken) (a ^. addrClient)
    deleteEndpoint ev

onPermFailure :: Event -> Gundeck ()
onPermFailure ev = withEndpoint ev $ \_ as -> do
  forM_ as $ \a -> do
    logUserEvent (a ^. addrUser) ev $ msg (val "Removing invalid token")
    deleteToken (a ^. addrUser) ev (a ^. addrToken) (a ^. addrClient)
  deleteEndpoint ev

onTTLExpired :: Event -> Gundeck ()
onTTLExpired ev =
  Log.warn $
    "arn"
      .= toText (ev ^. evEndpoint)
      ~~ "cause"
      .= toText (ev ^. evType)
      ~~ msg (val "Notification TTL expired")

onUnknownFailure :: Event -> Text -> Gundeck ()
onUnknownFailure ev r =
  Log.warn $
    "arn"
      .= toText (ev ^. evEndpoint)
      ~~ "cause"
      .= toText (ev ^. evType)
      ~~ msg (val "Unknown failure, reason: " +++ r)

onUnhandledEventType :: Event -> Gundeck ()
onUnhandledEventType ev =
  Log.warn $
    "arn"
      .= toText (ev ^. evEndpoint)
      ~~ "cause"
      .= toText (ev ^. evType)
      ~~ msg (val "Unhandled event type")

-------------------------------------------------------------------------------
-- Utilities

withEndpoint ::
  Event ->
  (SNSEndpoint -> [Address] -> Gundeck ()) ->
  Gundeck ()
withEndpoint ev f = do
  v <- view awsEnv
  e <- Aws.execute v (Aws.lookupEndpoint (ev ^. evEndpoint))
  for_ e $ \ep -> do
    let us = Set.toList (ep ^. endpointUsers)
    as <- concat <$> mapM (`Push.lookup` Push.LocalQuorum) us
    case filter ((== (ev ^. evEndpoint)) . view addrEndpoint) as of
      [] -> do
        logEvent ev $
          "token"
            .= Text.take 16 (tokenText (ep ^. endpointToken))
            ~~ msg (val "Deleting orphaned SNS endpoint")
        Aws.execute v (Aws.deleteEndpoint (ev ^. evEndpoint))
      as' -> f ep as'

deleteEndpoint :: Event -> Gundeck ()
deleteEndpoint ev = do
  logEvent ev $ msg (val "Deleting SNS endpoint")
  v <- view awsEnv
  Aws.execute v (Aws.deleteEndpoint (ev ^. evEndpoint))

updateEndpoint :: Event -> SNSEndpoint -> [UserId] -> Gundeck ()
updateEndpoint ev ep us = do
  logEvent ev $ msg (val "Updating SNS endpoint")
  v <- view awsEnv
  Aws.execute v (Aws.updateEndpoint (Set.fromList us) (ep ^. endpointToken) (ev ^. evEndpoint))

deleteToken :: UserId -> Event -> Token -> ClientId -> Gundeck ()
deleteToken u ev tk cl = do
  logUserEvent u ev $
    "token"
      .= Text.take 16 (tokenText tk)
      ~~ msg (val "Deleting push token")
  i <- mkNotificationId
  let t = mkPushToken ev tk cl
      p = singletonPayload (PushRemove t)
      n = Notification i False p
      r = NonEmpty.singleton (target u & targetClients .~ [cl])
  void $ Web.push n r (Just u) Nothing Set.empty
  Stream.add i r p =<< view (options . settings . notificationTTL)
  Push.delete u (t ^. tokenTransport) (t ^. tokenApp) tk

mkPushToken :: Event -> Token -> ClientId -> PushToken
mkPushToken ev tk cl =
  let t = ev ^. evEndpoint . snsTopic
   in pushToken (t ^. endpointTransport) (t ^. endpointAppName) tk cl

logEvent :: Event -> (Msg -> Msg) -> Gundeck ()
logEvent ev f =
  Log.info $
    "arn"
      .= toText (ev ^. evEndpoint)
      ~~ "cause"
      .= toText (ev ^. evType)
      ~~ f

logUserEvent :: UserId -> Event -> (Msg -> Msg) -> Gundeck ()
logUserEvent u ev f =
  logEvent ev $
    "user"
      .= toByteString u
      ~~ f
