-- 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.Schema.Run where

import Cassandra.MigrateSchema (migrateSchema)
import Cassandra.Schema
import Control.Exception (finally)
import Galley.Schema.V20 qualified as V20
import Galley.Schema.V21 qualified as V21
import Galley.Schema.V22 qualified as V22
import Galley.Schema.V23 qualified as V23
import Galley.Schema.V24 qualified as V24
import Galley.Schema.V25 qualified as V25
import Galley.Schema.V26 qualified as V26
import Galley.Schema.V27 qualified as V27
import Galley.Schema.V28 qualified as V28
import Galley.Schema.V29 qualified as V29
import Galley.Schema.V30 qualified as V30
import Galley.Schema.V31 qualified as V31
import Galley.Schema.V32 qualified as V32
import Galley.Schema.V33 qualified as V33
import Galley.Schema.V34 qualified as V34
import Galley.Schema.V35 qualified as V35
import Galley.Schema.V36 qualified as V36
import Galley.Schema.V37 qualified as V37
import Galley.Schema.V38_CreateTableBillingTeamMember qualified as V38_CreateTableBillingTeamMember
import Galley.Schema.V39 qualified as V39
import Galley.Schema.V40_CreateTableDataMigration qualified as V40_CreateTableDataMigration
import Galley.Schema.V41_TeamNotificationQueue qualified as V41_TeamNotificationQueue
import Galley.Schema.V42_TeamFeatureValidateSamlEmails qualified as V42_TeamFeatureValidateSamlEmails
import Galley.Schema.V43_TeamFeatureDigitalSignatures qualified as V43_TeamFeatureDigitalSignatures
import Galley.Schema.V44_AddRemoteIdentifiers qualified as V44_AddRemoteIdentifiers
import Galley.Schema.V45_AddFederationIdMapping qualified as V45_AddFederationIdMapping
import Galley.Schema.V46_TeamFeatureAppLock qualified as V46_TeamFeatureAppLock
import Galley.Schema.V47_RemoveFederationIdMapping qualified as V47_RemoveFederationIdMapping
import Galley.Schema.V48_DeleteRemoteIdentifiers qualified as V48_DeleteRemoteIdentifiers
import Galley.Schema.V49_ReAddRemoteIdentifiers qualified as V49_ReAddRemoteIdentifiers
import Galley.Schema.V50_AddLegalholdWhitelisted qualified as V50_AddLegalholdWhitelisted
import Galley.Schema.V51_FeatureFileSharing qualified as V51_FeatureFileSharing
import Galley.Schema.V52_FeatureConferenceCalling qualified as V52_FeatureConferenceCalling
import Galley.Schema.V53_AddRemoteConvStatus qualified as V53_AddRemoteConvStatus
import Galley.Schema.V54_TeamFeatureSelfDeletingMessages qualified as V54_TeamFeatureSelfDeletingMessages
import Galley.Schema.V55_SelfDeletingMessagesLockStatus qualified as V55_SelfDeletingMessagesLockStatus
import Galley.Schema.V56_GuestLinksTeamFeatureStatus qualified as V56_GuestLinksTeamFeatureStatus
import Galley.Schema.V57_GuestLinksLockStatus qualified as V57_GuestLinksLockStatus
import Galley.Schema.V58_ConversationAccessRoleV2 qualified as V58_ConversationAccessRoleV2
import Galley.Schema.V59_FileSharingLockStatus qualified as V59_FileSharingLockStatus
import Galley.Schema.V60_TeamFeatureSndFactorPasswordChallenge qualified as V60_TeamFeatureSndFactorPasswordChallenge
import Galley.Schema.V61_MLSConversation qualified as V61_MLSConversation
import Galley.Schema.V62_TeamFeatureSearchVisibilityInbound qualified as V62_TeamFeatureSearchVisibilityInbound
import Galley.Schema.V63_MLSConversationClients qualified as V63_MLSConversationClients
import Galley.Schema.V64_Epoch qualified as V64_Epoch
import Galley.Schema.V65_MLSRemoteClients qualified as V65_MLSRemoteClients
import Galley.Schema.V66_AddSplashScreen qualified as V66_AddSplashScreen
import Galley.Schema.V67_MLSFeature qualified as V67_MLSFeature
import Galley.Schema.V68_MLSCommitLock qualified as V68_MLSCommitLock
import Galley.Schema.V69_MLSProposal qualified as V69_MLSProposal
import Galley.Schema.V70_MLSCipherSuite qualified as V70_MLSCipherSuite
import Galley.Schema.V71_MemberClientKeypackage qualified as V71_MemberClientKeypackage
import Galley.Schema.V72_DropManagedConversations qualified as V72_DropManagedConversations
import Galley.Schema.V73_MemberClientTable qualified as V73_MemberClientTable
import Galley.Schema.V74_ExposeInvitationsToTeamAdmin qualified as V74_ExposeInvitationsToTeamAdmin
import Galley.Schema.V75_MLSGroupInfo qualified as V75_MLSGroupInfo
import Galley.Schema.V76_ProposalOrigin qualified as V76_ProposalOrigin
import Galley.Schema.V77_MLSGroupMemberClient qualified as V77_MLSGroupMemberClient
import Galley.Schema.V78_TeamFeatureOutlookCalIntegration qualified as V78_TeamFeatureOutlookCalIntegration
import Galley.Schema.V79_TeamFeatureMlsE2EId qualified as V79_TeamFeatureMlsE2EId
import Galley.Schema.V80_AddConversationCodePassword qualified as V80_AddConversationCodePassword
import Galley.Schema.V81_TeamFeatureMlsE2EIdUpdate qualified as V81_TeamFeatureMlsE2EIdUpdate
import Galley.Schema.V82_RemoteDomainIndexes qualified as V82_RemoteDomainIndexes
import Galley.Schema.V83_CreateTableTeamAdmin qualified as V83_CreateTableTeamAdmin
import Galley.Schema.V84_MLSSubconversation qualified as V84_MLSSubconversation
import Galley.Schema.V85_MLSDraft17 qualified as V85_MLSDraft17
import Galley.Schema.V86_TeamFeatureMlsMigration qualified as V86_TeamFeatureMlsMigration
import Galley.Schema.V87_TeamFeatureSupportedProtocols qualified as V87_TeamFeatureSupportedProtocols
import Galley.Schema.V88_RemoveMemberClientAndTruncateMLSGroupMemberClient qualified as V88_RemoveMemberClientAndTruncateMLSGroupMemberClient
import Galley.Schema.V89_MlsLockStatus qualified as V89_MlsLockStatus
import Galley.Schema.V90_EnforceFileDownloadLocationConfig qualified as V90_EnforceFileDownloadLocationConfig
import Galley.Schema.V91_TeamMemberDeletedLimitedEventFanout qualified as V91_TeamMemberDeletedLimitedEventFanout
import Galley.Schema.V92_MlsE2EIdConfig qualified as V92_MlsE2EIdConfig
import Galley.Schema.V93_ConferenceCallingSftForOneToOne qualified as V93_ConferenceCallingSftForOneToOne
import Imports
import Options.Applicative
import System.Logger.Extended qualified as Log

main :: IO ()
main :: IO ()
main = do
  MigrationOpts
o <- ParserInfo MigrationOpts -> IO MigrationOpts
forall a. ParserInfo a -> IO a
execParser (Parser MigrationOpts
-> InfoMod MigrationOpts -> ParserInfo MigrationOpts
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (MigrationOpts -> MigrationOpts)
forall a. Parser (a -> a)
helper Parser (MigrationOpts -> MigrationOpts)
-> Parser MigrationOpts -> Parser MigrationOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MigrationOpts
migrationOptsParser) InfoMod MigrationOpts
forall {a}. InfoMod a
desc)
  Logger
l <- IO Logger
Log.mkLogger'
  Logger -> MigrationOpts -> [Migration] -> IO ()
migrateSchema
    Logger
l
    MigrationOpts
o
    [Migration]
migrations
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Logger -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> m ()
Log.close Logger
l
  where
    desc :: InfoMod a
desc = String -> InfoMod a
forall a. String -> InfoMod a
header String
"Galley Cassandra Schema" InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> InfoMod a
forall {a}. InfoMod a
fullDesc

lastSchemaVersion :: Int32
lastSchemaVersion :: Int32
lastSchemaVersion = Migration -> Int32
migVersion (Migration -> Int32) -> Migration -> Int32
forall a b. (a -> b) -> a -> b
$ [Migration] -> Migration
forall a. HasCallStack => [a] -> a
last [Migration]
migrations

migrations :: [Migration]
migrations :: [Migration]
migrations =
  [ Migration
V20.migration,
    Migration
V21.migration,
    Migration
V22.migration,
    Migration
V23.migration,
    Migration
V24.migration,
    Migration
V25.migration,
    Migration
V26.migration,
    Migration
V27.migration,
    Migration
V28.migration,
    Migration
V29.migration,
    Migration
V30.migration,
    Migration
V31.migration,
    Migration
V32.migration,
    Migration
V33.migration,
    Migration
V34.migration,
    Migration
V35.migration,
    Migration
V36.migration,
    Migration
V37.migration,
    Migration
V38_CreateTableBillingTeamMember.migration,
    Migration
V39.migration,
    Migration
V40_CreateTableDataMigration.migration,
    Migration
V41_TeamNotificationQueue.migration,
    Migration
V42_TeamFeatureValidateSamlEmails.migration,
    Migration
V43_TeamFeatureDigitalSignatures.migration,
    Migration
V44_AddRemoteIdentifiers.migration,
    Migration
V45_AddFederationIdMapping.migration,
    Migration
V46_TeamFeatureAppLock.migration,
    Migration
V47_RemoveFederationIdMapping.migration,
    Migration
V48_DeleteRemoteIdentifiers.migration,
    Migration
V49_ReAddRemoteIdentifiers.migration,
    Migration
V50_AddLegalholdWhitelisted.migration,
    Migration
V51_FeatureFileSharing.migration,
    Migration
V52_FeatureConferenceCalling.migration,
    Migration
V53_AddRemoteConvStatus.migration,
    Migration
V54_TeamFeatureSelfDeletingMessages.migration,
    Migration
V55_SelfDeletingMessagesLockStatus.migration,
    Migration
V56_GuestLinksTeamFeatureStatus.migration,
    Migration
V57_GuestLinksLockStatus.migration,
    Migration
V58_ConversationAccessRoleV2.migration,
    Migration
V59_FileSharingLockStatus.migration,
    Migration
V60_TeamFeatureSndFactorPasswordChallenge.migration,
    Migration
V61_MLSConversation.migration,
    Migration
V62_TeamFeatureSearchVisibilityInbound.migration,
    Migration
V63_MLSConversationClients.migration,
    Migration
V64_Epoch.migration,
    Migration
V65_MLSRemoteClients.migration,
    Migration
V66_AddSplashScreen.migration,
    Migration
V67_MLSFeature.migration,
    Migration
V68_MLSCommitLock.migration,
    Migration
V69_MLSProposal.migration,
    Migration
V70_MLSCipherSuite.migration,
    Migration
V71_MemberClientKeypackage.migration,
    Migration
V72_DropManagedConversations.migration,
    Migration
V73_MemberClientTable.migration,
    Migration
V74_ExposeInvitationsToTeamAdmin.migration,
    Migration
V75_MLSGroupInfo.migration,
    Migration
V76_ProposalOrigin.migration,
    Migration
V77_MLSGroupMemberClient.migration,
    Migration
V78_TeamFeatureOutlookCalIntegration.migration,
    Migration
V79_TeamFeatureMlsE2EId.migration,
    Migration
V80_AddConversationCodePassword.migration,
    Migration
V81_TeamFeatureMlsE2EIdUpdate.migration,
    Migration
V82_RemoteDomainIndexes.migration,
    Migration
V83_CreateTableTeamAdmin.migration,
    Migration
V84_MLSSubconversation.migration,
    Migration
V85_MLSDraft17.migration,
    Migration
V86_TeamFeatureMlsMigration.migration,
    Migration
V87_TeamFeatureSupportedProtocols.migration,
    Migration
V88_RemoveMemberClientAndTruncateMLSGroupMemberClient.migration,
    Migration
V89_MlsLockStatus.migration,
    Migration
V90_EnforceFileDownloadLocationConfig.migration,
    Migration
V91_TeamMemberDeletedLimitedEventFanout.migration,
    Migration
V92_MlsE2EIdConfig.migration,
    Migration
V93_ConferenceCallingSftForOneToOne.migration
    -- FUTUREWORK: once #1726 has made its way to master/production,
    -- the 'message' field in connections table can be dropped.
    -- See also https://github.com/wireapp/wire-server/pull/1747/files
    -- for an explanation
    -- FUTUREWORK: once #1751 has made its way to master/production,
    -- the 'otr_muted' field in the member table can be dropped.
  ]