-
Notifications
You must be signed in to change notification settings - Fork 325
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Automate concatenation of rows in GetAllTeamFeatureConfigs, rename Fe…
…atureSingletonMlsMigration{Config}- Loading branch information
1 parent
76d3127
commit f1f92c3
Showing
7 changed files
with
108 additions
and
213 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
238 changes: 49 additions & 189 deletions
238
services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,206 +1,66 @@ | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
| {-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} | ||
|
|
||
| module Galley.Cassandra.GetAllTeamFeatureConfigs where | ||
|
|
||
| import Cassandra | ||
| import Cassandra qualified as C | ||
| import Data.Id | ||
| import Data.Misc (HttpsUrl) | ||
| import Data.SOP | ||
| import Data.Time | ||
| import Database.CQL.Protocol | ||
| import Galley.Cassandra.Instances () | ||
| import Galley.Cassandra.MakeFeature | ||
| import Imports | ||
| import Wire.API.Conversation.Protocol (ProtocolTag) | ||
| import Wire.API.MLS.CipherSuite | ||
| import Galley.Cassandra.Orphans () | ||
| import Generics.SOP | ||
| import Imports hiding (Map) | ||
| import Polysemy.Internal | ||
| import Wire.API.Team.Feature | ||
|
|
||
| data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow | ||
| { -- legalhold | ||
| legalhold :: Maybe FeatureStatus, | ||
| -- sso | ||
| sso :: Maybe FeatureStatus, | ||
| -- search visibility | ||
| searchVisibility :: Maybe FeatureStatus, | ||
| -- validate saml emails | ||
| validateSamlEmails :: Maybe FeatureStatus, | ||
| -- digital signatures | ||
| digitalSignatures :: Maybe FeatureStatus, | ||
| -- app lock | ||
| appLock :: Maybe FeatureStatus, | ||
| appLockEnforce :: Maybe EnforceAppLock, | ||
| appLockInactivityTimeoutSecs :: Maybe Int32, | ||
| -- file sharing | ||
| fileSharing :: Maybe FeatureStatus, | ||
| fileSharingLock :: Maybe LockStatus, | ||
| -- self deleting messages | ||
| selfDeletingMessages :: Maybe FeatureStatus, | ||
| selfDeletingMessagesTtl :: Maybe Int32, | ||
| selfDeletingMessagesLock :: Maybe LockStatus, | ||
| -- conference calling | ||
| conferenceCalling :: Maybe FeatureStatus, | ||
| conferenceCallingTtl :: Maybe FeatureTTL, | ||
| conferenceCallingOne2One :: Maybe One2OneCalls, | ||
| conferenceCallingLock :: Maybe LockStatus, | ||
| -- guest links | ||
| guestLinks :: Maybe FeatureStatus, | ||
| guestLinksLock :: Maybe LockStatus, | ||
| -- snd factor | ||
| sndFactor :: Maybe FeatureStatus, | ||
| sndFactorLock :: Maybe LockStatus, | ||
| -- mls | ||
| mls :: Maybe FeatureStatus, | ||
| mlsDefaultProtocol :: Maybe ProtocolTag, | ||
| mlsToggleUsers :: Maybe (C.Set UserId), | ||
| mlsAllowedCipherSuites :: Maybe (C.Set CipherSuiteTag), | ||
| mlsDefaultCipherSuite :: Maybe CipherSuiteTag, | ||
| mlsSupportedProtocols :: Maybe (C.Set ProtocolTag), | ||
| mlsLock :: Maybe LockStatus, | ||
| -- mls e2eid | ||
| mlsE2eid :: Maybe FeatureStatus, | ||
| mlsE2eidGracePeriod :: Maybe Int32, | ||
| mlsE2eidAcmeDiscoverUrl :: Maybe HttpsUrl, | ||
| mlsE2eidMaybeCrlProxy :: Maybe HttpsUrl, | ||
| mlsE2eidMaybeUseProxyOnMobile :: Maybe Bool, | ||
| mlsE2eidLock :: Maybe LockStatus, | ||
| -- mls migration | ||
| mlsMigration :: Maybe FeatureStatus, | ||
| mlsMigrationStartTime :: Maybe UTCTime, | ||
| mlsMigrationFinalizeRegardlessAfter :: Maybe UTCTime, | ||
| mlsMigrationLock :: Maybe LockStatus, | ||
| -- expose invitation urls | ||
| exposeInvitationUrls :: Maybe FeatureStatus, | ||
| -- outlook calendar integration | ||
| outlookCalIntegration :: Maybe FeatureStatus, | ||
| outlookCalIntegrationLock :: Maybe LockStatus, | ||
| -- enforce download location | ||
| enforceDownloadLocation :: Maybe FeatureStatus, | ||
| enforceDownloadLocation_Location :: Maybe Text, | ||
| enforceDownloadLocationLock :: Maybe LockStatus, | ||
| -- limit event fanout | ||
| limitEventFanout :: Maybe FeatureStatus | ||
| } | ||
| deriving (Generic, Show) | ||
| type family ConcatFeatureRow xs where | ||
| ConcatFeatureRow '[] = '[] | ||
| ConcatFeatureRow (x : xs) = Append (FeatureRow x) (ConcatFeatureRow xs) | ||
|
|
||
| recordInstance ''AllTeamFeatureConfigsRow | ||
| type AllFeatureRow = ConcatFeatureRow Features | ||
|
|
||
| emptyRow :: AllTeamFeatureConfigsRow | ||
| emptyRow = | ||
| AllTeamFeatureConfigsRow | ||
| { legalhold = Nothing, | ||
| sso = Nothing, | ||
| searchVisibility = Nothing, | ||
| validateSamlEmails = Nothing, | ||
| digitalSignatures = Nothing, | ||
| appLock = Nothing, | ||
| appLockEnforce = Nothing, | ||
| appLockInactivityTimeoutSecs = Nothing, | ||
| fileSharing = Nothing, | ||
| fileSharingLock = Nothing, | ||
| selfDeletingMessages = Nothing, | ||
| selfDeletingMessagesTtl = Nothing, | ||
| selfDeletingMessagesLock = Nothing, | ||
| conferenceCalling = Nothing, | ||
| conferenceCallingTtl = Nothing, | ||
| conferenceCallingOne2One = Nothing, | ||
| conferenceCallingLock = Nothing, | ||
| guestLinks = Nothing, | ||
| guestLinksLock = Nothing, | ||
| sndFactor = Nothing, | ||
| sndFactorLock = Nothing, | ||
| mls = Nothing, | ||
| mlsDefaultProtocol = Nothing, | ||
| mlsToggleUsers = Nothing, | ||
| mlsAllowedCipherSuites = Nothing, | ||
| mlsDefaultCipherSuite = Nothing, | ||
| mlsSupportedProtocols = Nothing, | ||
| mlsLock = Nothing, | ||
| mlsE2eid = Nothing, | ||
| mlsE2eidGracePeriod = Nothing, | ||
| mlsE2eidAcmeDiscoverUrl = Nothing, | ||
| mlsE2eidMaybeCrlProxy = Nothing, | ||
| mlsE2eidMaybeUseProxyOnMobile = Nothing, | ||
| mlsE2eidLock = Nothing, | ||
| mlsMigration = Nothing, | ||
| mlsMigrationStartTime = Nothing, | ||
| mlsMigrationFinalizeRegardlessAfter = Nothing, | ||
| mlsMigrationLock = Nothing, | ||
| exposeInvitationUrls = Nothing, | ||
| outlookCalIntegration = Nothing, | ||
| outlookCalIntegrationLock = Nothing, | ||
| enforceDownloadLocation = Nothing, | ||
| enforceDownloadLocation_Location = Nothing, | ||
| enforceDownloadLocationLock = Nothing, | ||
| limitEventFanout = Nothing | ||
| } | ||
| emptyRow :: NP Maybe AllFeatureRow | ||
| emptyRow = hpure Nothing | ||
|
|
||
| allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatures DbFeature | ||
| allFeatureConfigsFromRow row = | ||
| mkFeature (row.legalhold :* Nil) | ||
| :* mkFeature (row.sso :* Nil) | ||
| :* mkFeature (row.searchVisibility :* Nil) | ||
| :* mkFeature (row.searchVisibility :* Nil) | ||
| :* mkFeature (row.validateSamlEmails :* Nil) | ||
| :* mkFeature (row.digitalSignatures :* Nil) | ||
| :* mkFeature (row.appLock :* row.appLockEnforce :* row.appLockInactivityTimeoutSecs :* Nil) | ||
| :* mkFeature (row.fileSharingLock :* row.fileSharing :* Nil) | ||
| :* mkFeature Nil | ||
| :* mkFeature (row.conferenceCallingLock :* row.conferenceCalling :* row.conferenceCallingOne2One :* Nil) | ||
| :* mkFeature (row.selfDeletingMessagesLock :* row.selfDeletingMessages :* row.selfDeletingMessagesTtl :* Nil) | ||
| :* mkFeature (row.guestLinksLock :* row.guestLinks :* Nil) | ||
| :* mkFeature (row.sndFactorLock :* row.sndFactor :* Nil) | ||
| :* mkFeature (row.mlsLock :* row.mls :* row.mlsDefaultProtocol :* row.mlsToggleUsers :* row.mlsAllowedCipherSuites :* row.mlsDefaultCipherSuite :* row.mlsSupportedProtocols :* Nil) | ||
| :* mkFeature (row.exposeInvitationUrls :* Nil) | ||
| :* mkFeature (row.outlookCalIntegrationLock :* row.outlookCalIntegration :* Nil) | ||
| :* mkFeature | ||
| ( row.mlsE2eidLock | ||
| :* row.mlsE2eid | ||
| :* row.mlsE2eidGracePeriod | ||
| :* row.mlsE2eidAcmeDiscoverUrl | ||
| :* row.mlsE2eidMaybeCrlProxy | ||
| :* row.mlsE2eidMaybeUseProxyOnMobile | ||
| :* Nil | ||
| ) | ||
| :* mkFeature (row.mlsMigrationLock :* row.mlsMigration :* row.mlsMigrationStartTime :* row.mlsMigrationFinalizeRegardlessAfter :* Nil) | ||
| :* mkFeature (row.enforceDownloadLocationLock :* row.enforceDownloadLocation :* row.enforceDownloadLocation_Location :* Nil) | ||
| :* mkFeature (row.limitEventFanout :* Nil) | ||
| :* Nil | ||
| class ConcatFeatures cfgs where | ||
| mkAllFeatures :: NP Maybe (ConcatFeatureRow cfgs) -> NP DbFeature cfgs | ||
|
|
||
| getAllFeatureConfigs :: (MonadClient m) => TeamId -> m (AllFeatures DbFeature) | ||
| instance ConcatFeatures '[] where | ||
| mkAllFeatures Nil = Nil | ||
|
|
||
| instance | ||
| ( Split (FeatureRow cfg) (ConcatFeatureRow cfgs), | ||
| ConcatFeatures cfgs, | ||
| MakeFeature cfg | ||
| ) => | ||
| ConcatFeatures (cfg : cfgs) | ||
| where | ||
| mkAllFeatures row = case split @(FeatureRow cfg) @(ConcatFeatureRow cfgs) row of | ||
| (row0, row1) -> mkFeature row0 :* mkAllFeatures row1 | ||
|
|
||
| class Split xs ys where | ||
| split :: NP f (Append xs ys) -> (NP f xs, NP f ys) | ||
|
|
||
| instance Split '[] ys where | ||
| split ys = (Nil, ys) | ||
|
|
||
| instance (Split xs ys) => Split (x ': xs) ys where | ||
| split (z :* zs) = case split zs of | ||
| (xs, ys) -> (z :* xs, ys) | ||
|
|
||
| getAllFeatureConfigs :: | ||
| forall row mrow m. | ||
| ( MonadClient m, | ||
| row ~ AllFeatureRow, | ||
| Tuple (TupleP mrow), | ||
| IsProductType (TupleP mrow) mrow, | ||
| AllZip (IsF Maybe) row mrow | ||
| ) => | ||
| TeamId -> | ||
| m (AllFeatures DbFeature) | ||
| getAllFeatureConfigs tid = do | ||
| mRow <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) | ||
| pure $ allFeatureConfigsFromRow $ maybe emptyRow asRecord mRow | ||
| pure $ mkAllFeatures $ maybe emptyRow (unfactorI . productTypeFrom) mRow | ||
| where | ||
| select :: | ||
| PrepQuery | ||
| R | ||
| (Identity TeamId) | ||
| (TupleType AllTeamFeatureConfigsRow) | ||
| select = | ||
| "select \ | ||
| \legalhold_status, \ | ||
| \sso_status, \ | ||
| \search_visibility_status, \ | ||
| \validate_saml_emails, \ | ||
| \digital_signatures, \ | ||
| \app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs, \ | ||
| \file_sharing, file_sharing_lock_status, \ | ||
| \self_deleting_messages_status, self_deleting_messages_ttl, self_deleting_messages_lock_status, \ | ||
| \conference_calling_status, ttl(conference_calling_status), conference_calling_one_to_one, conference_calling, \ | ||
| \guest_links_status, guest_links_lock_status, \ | ||
| \snd_factor_password_challenge_status, snd_factor_password_challenge_lock_status, \ | ||
| \\ | ||
| \mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \ | ||
| \mls_default_ciphersuite, mls_supported_protocols, mls_lock_status, \ | ||
| \\ | ||
| \mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile, mls_e2eid_lock_status, \ | ||
| \\ | ||
| \mls_migration_status, mls_migration_start_time, mls_migration_finalise_regardless_after, \ | ||
| \mls_migration_lock_status, \ | ||
| \\ | ||
| \expose_invitation_urls_to_team_admin, \ | ||
| \outlook_cal_integration_status, outlook_cal_integration_lock_status, \ | ||
| \enforce_file_download_location_status, enforce_file_download_location, enforce_file_download_location_lock_status, \ | ||
| \limited_event_fanout_status \ | ||
| \from team_features where team_id = ?" | ||
| select :: PrepQuery R (Identity TeamId) (TupleP mrow) | ||
| select = fromString "" |
Oops, something went wrong.