content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -- 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 EmailLessUsers where
  
  import Cassandra
  import Cassandra.Util
  import Conduit
  import DanglingUserKeys qualified as K
  import Data.Aeson qualified as Aeson
  import Data.ByteString qualified as BS
  import Data.Conduit.Internal (zipSources)
  import Data.Conduit.List qualified as C
  import Data.Either.Extra
  import Data.Id
  import Data.Text qualified as Text
  import Data.Text.IO qualified as Text
  import Imports
  import System.Logger
  import System.Logger qualified as Log
  import UnliftIO.Async
  import Wire.API.User hiding (userEmail)
  import Wire.UserKeyStore
  
  runCommand :: Logger -> ClientState -> FilePath -> IO ()
  runCommand l brig inconsistenciesFile = do
    runResourceT $
      runConduit $
        zipSources
          (C.sourceList [(1 :: Int32) ..])
          (transPipe (runClient brig) getUsers)
          .| C.mapM
            ( \(i, userDetails) -> do
                Log.info l (Log.field "userIds" (show ((i - 1) * pageSize + fromIntegral (length userDetails))))
                pure $ mapMaybe userWithEmailAndStatus userDetails
            )
          .| C.mapM (liftIO . pooledMapConcurrentlyN 48 (checkUser l brig False))
          .| C.map ((<> "\n") . BS.intercalate "\n" . map (BS.toStrict . Aeson.encode) . catMaybes)
          .| sinkFile inconsistenciesFile
  
  runRepair :: Logger -> ClientState -> FilePath -> FilePath -> Bool -> IO ()
  runRepair l brig inputFile outputFile repairData = do
    inputLines :: [UserId] <- mapMaybe (eitherToMaybe . parseIdFromText) . Text.lines <$> Text.readFile inputFile
    runResourceT $
      runConduit $
        zipSources
          (C.sourceList [(1 :: Int32) ..])
          (C.sourceList inputLines)
          .| C.mapM
            ( \(i, uid) -> do
                when (i `mod` 100 == 0) $
                  Log.info l (Log.field "linesProcessed" i)
                liftIO $ repairUser l brig repairData uid
            )
          .| C.map ((<> "\n") . BS.toStrict . Aeson.encode)
          .| sinkFile outputFile
  
  pageSize :: Int32
  pageSize = 1000
  
  data EmailInfo = EmailInfo
    { userId :: UserId,
      status :: WithWritetime AccountStatus,
      -- | Email in the user table
      userEmail :: WithWritetime EmailAddress,
      -- | Email in the user_keys table
      emailKey :: Maybe (WithWritetime UserId),
      inconsistencyCase :: Text
    }
    deriving (Generic)
  
  instance Aeson.ToJSON EmailInfo
  
  data WithWritetime a = WithWritetime
    { value :: a,
      writetime :: Writetime a
    }
    deriving (Generic)
  
  instance (Aeson.ToJSON a) => Aeson.ToJSON (WithWritetime a)
  
  ----------------------------------------------------------------------------
  -- Queries
  
  getUserDetails :: UserId -> Client (Maybe UserDetailsRow)
  getUserDetails uid = retry x5 $ query1 cql (params LocalQuorum (Identity uid))
    where
      cql :: PrepQuery R (Identity UserId) UserDetailsRow
      cql = "SELECT id, status, writetime(status), email, writetime(email), activated from user where id = ?"
  
  getUsers :: ConduitM () [UserDetailsRow] Client ()
  getUsers = paginateC cql (paramsP LocalQuorum () pageSize) x5
    where
      cql :: PrepQuery R () UserDetailsRow
      cql = "SELECT id, status, writetime(status), email, writetime(email), activated from user"
  
  type UserDetailsRow = (UserId, Maybe AccountStatus, Maybe (Writetime AccountStatus), Maybe EmailAddress, Maybe (Writetime EmailAddress), Bool)
  
  insertMissingEmail :: Logger -> ClientState -> EmailAddress -> UserId -> IO ()
  insertMissingEmail l brig email uid = do
    runClient brig $ K.insertKey l uid (mkEmailKey email)
  
  userWithEmailAndStatus :: UserDetailsRow -> Maybe (UserId, AccountStatus, Writetime AccountStatus, EmailAddress, Writetime EmailAddress)
  userWithEmailAndStatus (uid, mStatus, mStatusWritetime, mEmail, mEmailWritetime, activated) = do
    let act = if activated then Just True else Nothing
    case (,,,,) <$> mStatus <*> mStatusWritetime <*> mEmail <*> mEmailWritetime <*> act of
      Nothing -> Nothing
      Just (status, statusWritetime, email, emailWritetime, _) -> Just (uid, status, statusWritetime, email, emailWritetime)
  
  repairUser :: Logger -> ClientState -> Bool -> UserId -> IO (Maybe EmailInfo)
  repairUser l brig repairData uid = do
    user <- runClient brig $ getUserDetails uid
    let u = userWithEmailAndStatus =<< user
    case u of
      Nothing -> pure Nothing
      Just x -> checkUser l brig repairData x
  
  checkUser :: Logger -> ClientState -> Bool -> (UserId, AccountStatus, Writetime AccountStatus, EmailAddress, Writetime EmailAddress) -> IO (Maybe EmailInfo)
  checkUser l brig repairData (uid, statusValue, statusWritetime, userEmailValue, userEmailWriteTime) = do
    let status = WithWritetime statusValue statusWritetime
        userEmail = WithWritetime userEmailValue userEmailWriteTime
    mKeyDetails <- runClient brig $ K.getKey (mkEmailKey userEmailValue)
    case mKeyDetails of
      Nothing -> do
        let emailKey = Nothing
            inconsistencyCase = if statusValue == Active then "1-missing-email" else "2-missing-email-but-not-active"
        when (repairData && (statusValue == Active)) $ do
          insertMissingEmail l brig userEmailValue uid
        pure . Just $ EmailInfo {userId = uid, ..}
      Just (emailKeyValue, emailClaimTime) -> do
        let emailKey = Just $ WithWritetime emailKeyValue emailClaimTime
        let inconsistencyCase = "3-wrong-email"
        if emailKeyValue == uid
          then pure Nothing
          else pure . Just $ EmailInfo {userId = uid, ..}
  