-- 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 Galley.Intra.Journal
  ( teamActivate,
    teamUpdate,
    teamDelete,
    teamSuspend,
    evData,
  )
where

import Control.Lens
import Data.Currency qualified as Currency
import Data.Id
import Data.Proto.Id
import Data.ProtoLens (defMessage)
import Data.Text (pack)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Galley.Effects.TeamStore
import Galley.Types.Teams
import Imports hiding (head)
import Numeric.Natural
import Polysemy
import Polysemy.Input
import Proto.TeamEvents (TeamEvent'EventData, TeamEvent'EventType (..))
import Proto.TeamEvents_Fields qualified as T

-- [Note: journaling]
-- Team journal operations to SQS are a no-op when the service
-- is started without journaling arguments

teamActivate ::
  ( Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  TeamId ->
  Natural ->
  Maybe Currency.Alpha ->
  Maybe TeamCreationTime ->
  Sem r ()
teamActivate :: forall (r :: EffectRow).
(Member (Input UTCTime) r, Member TeamStore r) =>
TeamId
-> Natural -> Maybe Alpha -> Maybe TeamCreationTime -> Sem r ()
teamActivate TeamId
tid Natural
teamSize Maybe Alpha
cur Maybe TeamCreationTime
time = do
  [UserId]
owners <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
getBillingTeamMembers TeamId
tid
  TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
journalEvent TeamEvent'EventType
TeamEvent'TEAM_ACTIVATE TeamId
tid (TeamEvent'EventData -> Maybe TeamEvent'EventData
forall a. a -> Maybe a
Just (TeamEvent'EventData -> Maybe TeamEvent'EventData)
-> TeamEvent'EventData -> Maybe TeamEvent'EventData
forall a b. (a -> b) -> a -> b
$ Natural -> [UserId] -> Maybe Alpha -> TeamEvent'EventData
evData Natural
teamSize [UserId]
owners Maybe Alpha
cur) Maybe TeamCreationTime
time

teamUpdate ::
  ( Member TeamStore r,
    Member (Input UTCTime) r
  ) =>
  TeamId ->
  Natural ->
  [UserId] ->
  Sem r ()
teamUpdate :: forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Natural -> [UserId] -> Sem r ()
teamUpdate TeamId
tid Natural
teamSize [UserId]
billingUserIds =
  TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
journalEvent TeamEvent'EventType
TeamEvent'TEAM_UPDATE TeamId
tid (TeamEvent'EventData -> Maybe TeamEvent'EventData
forall a. a -> Maybe a
Just (TeamEvent'EventData -> Maybe TeamEvent'EventData)
-> TeamEvent'EventData -> Maybe TeamEvent'EventData
forall a b. (a -> b) -> a -> b
$ Natural -> [UserId] -> Maybe Alpha -> TeamEvent'EventData
evData Natural
teamSize [UserId]
billingUserIds Maybe Alpha
forall a. Maybe a
Nothing) Maybe TeamCreationTime
forall a. Maybe a
Nothing

teamDelete ::
  ( Member TeamStore r,
    Member (Input UTCTime) r
  ) =>
  TeamId ->
  Sem r ()
teamDelete :: forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Sem r ()
teamDelete TeamId
tid = TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
journalEvent TeamEvent'EventType
TeamEvent'TEAM_DELETE TeamId
tid Maybe TeamEvent'EventData
forall a. Maybe a
Nothing Maybe TeamCreationTime
forall a. Maybe a
Nothing

teamSuspend ::
  ( Member TeamStore r,
    Member (Input UTCTime) r
  ) =>
  TeamId ->
  Sem r ()
teamSuspend :: forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Sem r ()
teamSuspend TeamId
tid = TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
journalEvent TeamEvent'EventType
TeamEvent'TEAM_SUSPEND TeamId
tid Maybe TeamEvent'EventData
forall a. Maybe a
Nothing Maybe TeamCreationTime
forall a. Maybe a
Nothing

journalEvent ::
  ( Member TeamStore r,
    Member (Input UTCTime) r
  ) =>
  TeamEvent'EventType ->
  TeamId ->
  Maybe TeamEvent'EventData ->
  Maybe TeamCreationTime ->
  Sem r ()
journalEvent :: forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamEvent'EventType
-> TeamId
-> Maybe TeamEvent'EventData
-> Maybe TeamCreationTime
-> Sem r ()
journalEvent TeamEvent'EventType
typ TeamId
tid Maybe TeamEvent'EventData
dat Maybe TeamCreationTime
tim = do
  -- writetime is in microseconds in cassandra 3.11
  Int64
now <- POSIXTime -> Int64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int64) -> (UTCTime -> POSIXTime) -> UTCTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Int64) -> Sem r UTCTime -> Sem r Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  let ts :: Int64
ts = Int64
-> (TeamCreationTime -> Int64) -> Maybe TeamCreationTime -> Int64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int64
now ((Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000000) (Int64 -> Int64)
-> (TeamCreationTime -> Int64) -> TeamCreationTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int64 TeamCreationTime Int64 -> TeamCreationTime -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int64 TeamCreationTime Int64
Iso' TeamCreationTime Int64
tcTime) Maybe TeamCreationTime
tim
      ev :: TeamEvent
ev =
        TeamEvent
forall msg. Message msg => msg
defMessage
          TeamEvent -> (TeamEvent -> TeamEvent) -> TeamEvent
forall a b. a -> (a -> b) -> b
& LensLike' Identity TeamEvent TeamEvent'EventType
forall (f :: * -> *) s a.
(Functor f, HasField s "eventType" a) =>
LensLike' f s a
T.eventType LensLike' Identity TeamEvent TeamEvent'EventType
-> TeamEvent'EventType -> TeamEvent -> TeamEvent
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TeamEvent'EventType
typ
          TeamEvent -> (TeamEvent -> TeamEvent) -> TeamEvent
forall a b. a -> (a -> b) -> b
& LensLike' Identity TeamEvent ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "teamId" a) =>
LensLike' f s a
T.teamId LensLike' Identity TeamEvent ByteString
-> ByteString -> TeamEvent -> TeamEvent
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TeamId -> ByteString
forall {k} (a :: k). Id a -> ByteString
toBytes TeamId
tid
          TeamEvent -> (TeamEvent -> TeamEvent) -> TeamEvent
forall a b. a -> (a -> b) -> b
& LensLike' Identity TeamEvent Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "utcTime" a) =>
LensLike' f s a
T.utcTime LensLike' Identity TeamEvent Int64
-> Int64 -> TeamEvent -> TeamEvent
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int64
ts
          TeamEvent -> (TeamEvent -> TeamEvent) -> TeamEvent
forall a b. a -> (a -> b) -> b
& LensLike' Identity TeamEvent (Maybe TeamEvent'EventData)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'eventData" a) =>
LensLike' f s a
T.maybe'eventData LensLike' Identity TeamEvent (Maybe TeamEvent'EventData)
-> Maybe TeamEvent'EventData -> TeamEvent -> TeamEvent
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe TeamEvent'EventData
dat
  TeamEvent -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamEvent -> Sem r ()
enqueueTeamEvent TeamEvent
ev

----------------------------------------------------------------------------
-- utils

evData :: Natural -> [UserId] -> Maybe Currency.Alpha -> TeamEvent'EventData
evData :: Natural -> [UserId] -> Maybe Alpha -> TeamEvent'EventData
evData Natural
memberCount [UserId]
billingUserIds Maybe Alpha
cur =
  TeamEvent'EventData
forall msg. Message msg => msg
defMessage
    TeamEvent'EventData
-> (TeamEvent'EventData -> TeamEvent'EventData)
-> TeamEvent'EventData
forall a b. a -> (a -> b) -> b
& LensLike' Identity TeamEvent'EventData Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "memberCount" a) =>
LensLike' f s a
T.memberCount LensLike' Identity TeamEvent'EventData Int32
-> Int32 -> TeamEvent'EventData -> TeamEvent'EventData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
memberCount
    TeamEvent'EventData
-> (TeamEvent'EventData -> TeamEvent'EventData)
-> TeamEvent'EventData
forall a b. a -> (a -> b) -> b
& LensLike' Identity TeamEvent'EventData [ByteString]
forall (f :: * -> *) s a.
(Functor f, HasField s "billingUser" a) =>
LensLike' f s a
T.billingUser LensLike' Identity TeamEvent'EventData [ByteString]
-> [ByteString] -> TeamEvent'EventData -> TeamEvent'EventData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (UserId -> ByteString
forall {k} (a :: k). Id a -> ByteString
toBytes (UserId -> ByteString) -> [UserId] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId]
billingUserIds)
    TeamEvent'EventData
-> (TeamEvent'EventData -> TeamEvent'EventData)
-> TeamEvent'EventData
forall a b. a -> (a -> b) -> b
& LensLike' Identity TeamEvent'EventData (Maybe Text)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'currency" a) =>
LensLike' f s a
T.maybe'currency LensLike' Identity TeamEvent'EventData (Maybe Text)
-> Maybe Text -> TeamEvent'EventData -> TeamEvent'EventData
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (String -> Text
pack (String -> Text) -> (Alpha -> String) -> Alpha -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alpha -> String
forall a. Show a => a -> String
show (Alpha -> Text) -> Maybe Alpha -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alpha
cur)