{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Abstraction to fetch and store feature values from and to the database.
module Galley.Cassandra.MakeFeature where

import Cassandra
import Cassandra qualified as C
import Data.Functor
import Data.Functor.Identity
import Data.Id
import Data.Kind
import Data.List.Singletons (Length)
import Data.Misc (HttpsUrl)
import Data.Singletons (demote)
import Data.Time
import GHC.TypeNats
import Galley.Cassandra.FeatureTH
import Galley.Cassandra.Instances ()
import Generics.SOP
import Imports hiding (Generic, Map)
import Wire.API.Conversation.Protocol (ProtocolTag)
import Wire.API.MLS.CipherSuite
import Wire.API.Team.Feature

-- [Note: default values for configuration fields]
--
-- When reading values for configuration types with multiple fields, we fall
-- back to default values for each field independently, instead of treating the
-- whole configuration as a single value that can be set or not.
--
-- In most cases, either strategy would produce the same result, because there
-- is no way to set only *some* fields using the public API. However, that can
-- happen when a feature flag changes over time and gains new fields, as it has
-- been the case for mlsE2EId.
--
-- Therefore, we use the first strategy consistently for all feature flags,
-- even when it does not matter.

-- | This is necessary in order to convert an @NP f xs@ type to something that
-- CQL can understand.
--
-- The generated code looks like:
-- @@
-- instance TupleP xs where
--   TupleP '[] = ()
--   TupleP '[a] = Identity a
--   TupleP '[a, b] = (a, b)
--   ...
-- @@
$generateTupleP

class MakeFeature cfg where
  type FeatureRow cfg :: [Type]
  type FeatureRow cfg = '[FeatureStatus]

  featureColumns :: NP (K String) (FeatureRow cfg)

  rowToFeature :: NP Maybe (FeatureRow cfg) -> DbFeature cfg
  default rowToFeature ::
    (FeatureRow cfg ~ '[FeatureStatus]) =>
    NP Maybe (FeatureRow cfg) ->
    DbFeature cfg
  rowToFeature = (FeatureStatus -> DbFeature cfg)
-> Maybe FeatureStatus -> DbFeature cfg
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature cfg
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus (Maybe FeatureStatus -> DbFeature cfg)
-> (NP Maybe '[FeatureStatus] -> Maybe FeatureStatus)
-> NP Maybe '[FeatureStatus]
-> DbFeature cfg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP Maybe '[FeatureStatus] -> Maybe FeatureStatus
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd

  featureToRow :: LockableFeature cfg -> NP Maybe (FeatureRow cfg)
  default featureToRow ::
    (FeatureRow cfg ~ '[FeatureStatus]) =>
    LockableFeature cfg ->
    NP Maybe (FeatureRow cfg)
  featureToRow LockableFeature cfg
feat = FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature cfg
feat.status Maybe FeatureStatus -> NP Maybe '[] -> NP Maybe '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature LegalholdConfig where
  featureColumns :: NP (K String) (FeatureRow LegalholdConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"legalhold_status" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature SSOConfig where
  featureColumns :: NP (K String) (FeatureRow SSOConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"sso_status" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature SearchVisibilityAvailableConfig where
  featureColumns :: NP (K String) (FeatureRow SearchVisibilityAvailableConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"search_visibility_status" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

-- | This feature shares its status column with
-- 'SearchVisibilityAvailableConfig'. This means that when fetching all
-- features, this column is repeated in the query, i.e. the query looks like:
-- @@
-- select ..., search_visibility_status, search_visibility_status, ... from team_features ...
-- @@
instance MakeFeature SearchVisibilityInboundConfig where
  featureColumns :: NP (K String) (FeatureRow SearchVisibilityInboundConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"search_visibility_status" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature ValidateSAMLEmailsConfig where
  featureColumns :: NP (K String) (FeatureRow ValidateSAMLEmailsConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"validate_saml_emails" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature DigitalSignaturesConfig where
  featureColumns :: NP (K String) (FeatureRow DigitalSignaturesConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"digital_signatures" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature AppLockConfig where
  type FeatureRow AppLockConfig = '[FeatureStatus, EnforceAppLock, Int32]
  featureColumns :: NP (K String) (FeatureRow AppLockConfig)
featureColumns =
    String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"app_lock_status"
      K String FeatureStatus
-> NP (K String) '[EnforceAppLock, Int32]
-> NP (K String) '[FeatureStatus, EnforceAppLock, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String EnforceAppLock
forall k a (b :: k). a -> K a b
K String
"app_lock_enforce"
      K String EnforceAppLock
-> NP (K String) '[Int32] -> NP (K String) '[EnforceAppLock, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String Int32
forall k a (b :: k). a -> K a b
K String
"app_lock_inactivity_timeout_secs"
      K String Int32 -> NP (K String) '[] -> NP (K String) '[Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow AppLockConfig) -> DbFeature AppLockConfig
rowToFeature (Maybe x
status :* Maybe x
enforce :* Maybe x
timeout :* NP Maybe xs
Nil) =
    (FeatureStatus -> DbFeature AppLockConfig)
-> Maybe FeatureStatus -> DbFeature AppLockConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature AppLockConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status
      -- [Note: default values for configuration fields]
      DbFeature AppLockConfig
-> DbFeature AppLockConfig -> DbFeature AppLockConfig
forall a. Semigroup a => a -> a -> a
<> (AppLockConfig -> AppLockConfig) -> DbFeature AppLockConfig
forall cfg. (cfg -> cfg) -> DbFeature cfg
dbFeatureModConfig
        ( \AppLockConfig
defCfg ->
            EnforceAppLock -> Int32 -> AppLockConfig
AppLockConfig
              (EnforceAppLock -> Maybe EnforceAppLock -> EnforceAppLock
forall a. a -> Maybe a -> a
fromMaybe AppLockConfig
defCfg.applockEnforceAppLock Maybe x
Maybe EnforceAppLock
enforce)
              (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe AppLockConfig
defCfg.applockInactivityTimeoutSecs Maybe x
Maybe Int32
timeout)
        )

  featureToRow :: LockableFeature AppLockConfig
-> NP Maybe (FeatureRow AppLockConfig)
featureToRow LockableFeature AppLockConfig
feat =
    FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature AppLockConfig
feat.status
      Maybe FeatureStatus
-> NP Maybe '[EnforceAppLock, Int32]
-> NP Maybe '[FeatureStatus, EnforceAppLock, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* EnforceAppLock -> Maybe EnforceAppLock
forall a. a -> Maybe a
Just LockableFeature AppLockConfig
feat.config.applockEnforceAppLock
      Maybe EnforceAppLock
-> NP Maybe '[Int32] -> NP Maybe '[EnforceAppLock, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Int32 -> Maybe Int32
forall a. a -> Maybe a
Just LockableFeature AppLockConfig
feat.config.applockInactivityTimeoutSecs
      Maybe Int32 -> NP Maybe '[] -> NP Maybe '[Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature ClassifiedDomainsConfig where
  type FeatureRow ClassifiedDomainsConfig = '[]
  featureColumns :: NP (K String) (FeatureRow ClassifiedDomainsConfig)
featureColumns = NP (K String) '[]
NP (K String) (FeatureRow ClassifiedDomainsConfig)
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow ClassifiedDomainsConfig)
-> DbFeature ClassifiedDomainsConfig
rowToFeature NP Maybe (FeatureRow ClassifiedDomainsConfig)
Nil = DbFeature ClassifiedDomainsConfig
forall a. Monoid a => a
mempty
  featureToRow :: LockableFeature ClassifiedDomainsConfig
-> NP Maybe (FeatureRow ClassifiedDomainsConfig)
featureToRow LockableFeature ClassifiedDomainsConfig
_ = NP Maybe '[]
NP Maybe (FeatureRow ClassifiedDomainsConfig)
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature FileSharingConfig where
  type FeatureRow FileSharingConfig = '[LockStatus, FeatureStatus]
  featureColumns :: NP (K String) (FeatureRow FileSharingConfig)
featureColumns = String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"file_sharing_lock_status" K String LockStatus
-> NP (K String) '[FeatureStatus]
-> NP (K String) '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"file_sharing" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow FileSharingConfig)
-> DbFeature FileSharingConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature FileSharingConfig)
-> Maybe LockStatus -> DbFeature FileSharingConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature FileSharingConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature FileSharingConfig
-> DbFeature FileSharingConfig -> DbFeature FileSharingConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature FileSharingConfig)
-> Maybe FeatureStatus -> DbFeature FileSharingConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature FileSharingConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status

  featureToRow :: LockableFeature FileSharingConfig
-> NP Maybe (FeatureRow FileSharingConfig)
featureToRow LockableFeature FileSharingConfig
feat = LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature FileSharingConfig
feat.lockStatus Maybe LockStatus
-> NP Maybe '[FeatureStatus]
-> NP Maybe '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature FileSharingConfig
feat.status Maybe FeatureStatus -> NP Maybe '[] -> NP Maybe '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature ConferenceCallingConfig where
  type FeatureRow ConferenceCallingConfig = '[LockStatus, FeatureStatus, One2OneCalls]
  featureColumns :: NP (K String) (FeatureRow ConferenceCallingConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"conference_calling"
      K String LockStatus
-> NP (K String) '[FeatureStatus, One2OneCalls]
-> NP (K String) '[LockStatus, FeatureStatus, One2OneCalls]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"conference_calling_status"
      K String FeatureStatus
-> NP (K String) '[One2OneCalls]
-> NP (K String) '[FeatureStatus, One2OneCalls]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String One2OneCalls
forall k a (b :: k). a -> K a b
K String
"conference_calling_one_to_one"
      K String One2OneCalls
-> NP (K String) '[] -> NP (K String) '[One2OneCalls]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow ConferenceCallingConfig)
-> DbFeature ConferenceCallingConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* Maybe x
calls :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature ConferenceCallingConfig)
-> Maybe LockStatus -> DbFeature ConferenceCallingConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature ConferenceCallingConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature ConferenceCallingConfig
-> DbFeature ConferenceCallingConfig
-> DbFeature ConferenceCallingConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature ConferenceCallingConfig)
-> Maybe FeatureStatus -> DbFeature ConferenceCallingConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature ConferenceCallingConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status
      DbFeature ConferenceCallingConfig
-> DbFeature ConferenceCallingConfig
-> DbFeature ConferenceCallingConfig
forall a. Semigroup a => a -> a -> a
<> (One2OneCalls -> DbFeature ConferenceCallingConfig)
-> Maybe One2OneCalls -> DbFeature ConferenceCallingConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ConferenceCallingConfig -> DbFeature ConferenceCallingConfig
forall cfg. cfg -> DbFeature cfg
dbFeatureConfig (ConferenceCallingConfig -> DbFeature ConferenceCallingConfig)
-> (One2OneCalls -> ConferenceCallingConfig)
-> One2OneCalls
-> DbFeature ConferenceCallingConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. One2OneCalls -> ConferenceCallingConfig
ConferenceCallingConfig) Maybe x
Maybe One2OneCalls
calls

  featureToRow :: LockableFeature ConferenceCallingConfig
-> NP Maybe (FeatureRow ConferenceCallingConfig)
featureToRow LockableFeature ConferenceCallingConfig
feat =
    LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature ConferenceCallingConfig
feat.lockStatus
      Maybe LockStatus
-> NP Maybe '[FeatureStatus, One2OneCalls]
-> NP Maybe '[LockStatus, FeatureStatus, One2OneCalls]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature ConferenceCallingConfig
feat.status
      Maybe FeatureStatus
-> NP Maybe '[One2OneCalls]
-> NP Maybe '[FeatureStatus, One2OneCalls]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* One2OneCalls -> Maybe One2OneCalls
forall a. a -> Maybe a
Just LockableFeature ConferenceCallingConfig
feat.config.one2OneCalls
      Maybe One2OneCalls -> NP Maybe '[] -> NP Maybe '[One2OneCalls]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature SelfDeletingMessagesConfig where
  type FeatureRow SelfDeletingMessagesConfig = '[LockStatus, FeatureStatus, Int32]
  featureColumns :: NP (K String) (FeatureRow SelfDeletingMessagesConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"self_deleting_messages_lock_status"
      K String LockStatus
-> NP (K String) '[FeatureStatus, Int32]
-> NP (K String) '[LockStatus, FeatureStatus, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"self_deleting_messages_status"
      K String FeatureStatus
-> NP (K String) '[Int32] -> NP (K String) '[FeatureStatus, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String Int32
forall k a (b :: k). a -> K a b
K String
"self_deleting_messages_ttl"
      K String Int32 -> NP (K String) '[] -> NP (K String) '[Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow SelfDeletingMessagesConfig)
-> DbFeature SelfDeletingMessagesConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* Maybe x
ttl :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature SelfDeletingMessagesConfig)
-> Maybe LockStatus -> DbFeature SelfDeletingMessagesConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature SelfDeletingMessagesConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature SelfDeletingMessagesConfig
-> DbFeature SelfDeletingMessagesConfig
-> DbFeature SelfDeletingMessagesConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature SelfDeletingMessagesConfig)
-> Maybe FeatureStatus -> DbFeature SelfDeletingMessagesConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature SelfDeletingMessagesConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status
      DbFeature SelfDeletingMessagesConfig
-> DbFeature SelfDeletingMessagesConfig
-> DbFeature SelfDeletingMessagesConfig
forall a. Semigroup a => a -> a -> a
<> (Int32 -> DbFeature SelfDeletingMessagesConfig)
-> Maybe Int32 -> DbFeature SelfDeletingMessagesConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SelfDeletingMessagesConfig -> DbFeature SelfDeletingMessagesConfig
forall cfg. cfg -> DbFeature cfg
dbFeatureConfig (SelfDeletingMessagesConfig
 -> DbFeature SelfDeletingMessagesConfig)
-> (Int32 -> SelfDeletingMessagesConfig)
-> Int32
-> DbFeature SelfDeletingMessagesConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> SelfDeletingMessagesConfig
SelfDeletingMessagesConfig) Maybe x
Maybe Int32
ttl

  featureToRow :: LockableFeature SelfDeletingMessagesConfig
-> NP Maybe (FeatureRow SelfDeletingMessagesConfig)
featureToRow LockableFeature SelfDeletingMessagesConfig
feat =
    LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature SelfDeletingMessagesConfig
feat.lockStatus
      Maybe LockStatus
-> NP Maybe '[FeatureStatus, Int32]
-> NP Maybe '[LockStatus, FeatureStatus, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature SelfDeletingMessagesConfig
feat.status
      Maybe FeatureStatus
-> NP Maybe '[Int32] -> NP Maybe '[FeatureStatus, Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Int32 -> Maybe Int32
forall a. a -> Maybe a
Just LockableFeature SelfDeletingMessagesConfig
feat.config.sdmEnforcedTimeoutSeconds
      Maybe Int32 -> NP Maybe '[] -> NP Maybe '[Int32]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature GuestLinksConfig where
  type FeatureRow GuestLinksConfig = '[LockStatus, FeatureStatus]
  featureColumns :: NP (K String) (FeatureRow GuestLinksConfig)
featureColumns = String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"guest_links_lock_status" K String LockStatus
-> NP (K String) '[FeatureStatus]
-> NP (K String) '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"guest_links_status" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow GuestLinksConfig)
-> DbFeature GuestLinksConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature GuestLinksConfig)
-> Maybe LockStatus -> DbFeature GuestLinksConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature GuestLinksConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature GuestLinksConfig
-> DbFeature GuestLinksConfig -> DbFeature GuestLinksConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature GuestLinksConfig)
-> Maybe FeatureStatus -> DbFeature GuestLinksConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature GuestLinksConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status

  featureToRow :: LockableFeature GuestLinksConfig
-> NP Maybe (FeatureRow GuestLinksConfig)
featureToRow LockableFeature GuestLinksConfig
feat = LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature GuestLinksConfig
feat.lockStatus Maybe LockStatus
-> NP Maybe '[FeatureStatus]
-> NP Maybe '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature GuestLinksConfig
feat.status Maybe FeatureStatus -> NP Maybe '[] -> NP Maybe '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature SndFactorPasswordChallengeConfig where
  type FeatureRow SndFactorPasswordChallengeConfig = '[LockStatus, FeatureStatus]
  featureColumns :: NP (K String) (FeatureRow SndFactorPasswordChallengeConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"snd_factor_password_challenge_lock_status"
      K String LockStatus
-> NP (K String) '[FeatureStatus]
-> NP (K String) '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"snd_factor_password_challenge_status"
      K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow SndFactorPasswordChallengeConfig)
-> DbFeature SndFactorPasswordChallengeConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature SndFactorPasswordChallengeConfig)
-> Maybe LockStatus -> DbFeature SndFactorPasswordChallengeConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature SndFactorPasswordChallengeConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature SndFactorPasswordChallengeConfig
-> DbFeature SndFactorPasswordChallengeConfig
-> DbFeature SndFactorPasswordChallengeConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature SndFactorPasswordChallengeConfig)
-> Maybe FeatureStatus
-> DbFeature SndFactorPasswordChallengeConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature SndFactorPasswordChallengeConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status

  featureToRow :: LockableFeature SndFactorPasswordChallengeConfig
-> NP Maybe (FeatureRow SndFactorPasswordChallengeConfig)
featureToRow LockableFeature SndFactorPasswordChallengeConfig
feat = LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature SndFactorPasswordChallengeConfig
feat.lockStatus Maybe LockStatus
-> NP Maybe '[FeatureStatus]
-> NP Maybe '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature SndFactorPasswordChallengeConfig
feat.status Maybe FeatureStatus -> NP Maybe '[] -> NP Maybe '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature ExposeInvitationURLsToTeamAdminConfig where
  featureColumns :: NP (K String) (FeatureRow ExposeInvitationURLsToTeamAdminConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"expose_invitation_urls_to_team_admin" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature OutlookCalIntegrationConfig where
  type FeatureRow OutlookCalIntegrationConfig = '[LockStatus, FeatureStatus]

  featureColumns :: NP (K String) (FeatureRow OutlookCalIntegrationConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"outlook_cal_integration_lock_status"
      K String LockStatus
-> NP (K String) '[FeatureStatus]
-> NP (K String) '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"outlook_cal_integration_status"
      K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow OutlookCalIntegrationConfig)
-> DbFeature OutlookCalIntegrationConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature OutlookCalIntegrationConfig)
-> Maybe LockStatus -> DbFeature OutlookCalIntegrationConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature OutlookCalIntegrationConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature OutlookCalIntegrationConfig
-> DbFeature OutlookCalIntegrationConfig
-> DbFeature OutlookCalIntegrationConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature OutlookCalIntegrationConfig)
-> Maybe FeatureStatus -> DbFeature OutlookCalIntegrationConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature OutlookCalIntegrationConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status

  featureToRow :: LockableFeature OutlookCalIntegrationConfig
-> NP Maybe (FeatureRow OutlookCalIntegrationConfig)
featureToRow LockableFeature OutlookCalIntegrationConfig
feat = LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature OutlookCalIntegrationConfig
feat.lockStatus Maybe LockStatus
-> NP Maybe '[FeatureStatus]
-> NP Maybe '[LockStatus, FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature OutlookCalIntegrationConfig
feat.status Maybe FeatureStatus -> NP Maybe '[] -> NP Maybe '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature MLSConfig where
  type
    FeatureRow MLSConfig =
      '[ LockStatus,
         FeatureStatus,
         ProtocolTag,
         (C.Set UserId),
         (C.Set CipherSuiteTag),
         CipherSuiteTag,
         (C.Set ProtocolTag)
       ]
  featureColumns :: NP (K String) (FeatureRow MLSConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"mls_lock_status"
      K String LockStatus
-> NP
     (K String)
     '[FeatureStatus, ProtocolTag, Set UserId, Set CipherSuiteTag,
       CipherSuiteTag, Set ProtocolTag]
-> NP
     (K String)
     '[LockStatus, FeatureStatus, ProtocolTag, Set UserId,
       Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"mls_status"
      K String FeatureStatus
-> NP
     (K String)
     '[ProtocolTag, Set UserId, Set CipherSuiteTag, CipherSuiteTag,
       Set ProtocolTag]
-> NP
     (K String)
     '[FeatureStatus, ProtocolTag, Set UserId, Set CipherSuiteTag,
       CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String ProtocolTag
forall k a (b :: k). a -> K a b
K String
"mls_default_protocol"
      K String ProtocolTag
-> NP
     (K String)
     '[Set UserId, Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
-> NP
     (K String)
     '[ProtocolTag, Set UserId, Set CipherSuiteTag, CipherSuiteTag,
       Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String (Set UserId)
forall k a (b :: k). a -> K a b
K String
"mls_protocol_toggle_users"
      K String (Set UserId)
-> NP
     (K String) '[Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
-> NP
     (K String)
     '[Set UserId, Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String (Set CipherSuiteTag)
forall k a (b :: k). a -> K a b
K String
"mls_allowed_ciphersuites"
      K String (Set CipherSuiteTag)
-> NP (K String) '[CipherSuiteTag, Set ProtocolTag]
-> NP
     (K String) '[Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String CipherSuiteTag
forall k a (b :: k). a -> K a b
K String
"mls_default_ciphersuite"
      K String CipherSuiteTag
-> NP (K String) '[Set ProtocolTag]
-> NP (K String) '[CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String (Set ProtocolTag)
forall k a (b :: k). a -> K a b
K String
"mls_supported_protocols"
      K String (Set ProtocolTag)
-> NP (K String) '[] -> NP (K String) '[Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow MLSConfig) -> DbFeature MLSConfig
rowToFeature
    ( Maybe x
lockStatus
        :* Maybe x
status
        :* Maybe x
defProto
        :* Maybe x
toggleUsers
        :* Maybe x
ciphersuites
        :* Maybe x
defCiphersuite
        :* Maybe x
supportedProtos
        :* NP Maybe xs
Nil
      ) =
      (LockStatus -> DbFeature MLSConfig)
-> Maybe LockStatus -> DbFeature MLSConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature MLSConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
        DbFeature MLSConfig -> DbFeature MLSConfig -> DbFeature MLSConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature MLSConfig)
-> Maybe FeatureStatus -> DbFeature MLSConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature MLSConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status
        DbFeature MLSConfig -> DbFeature MLSConfig -> DbFeature MLSConfig
forall a. Semigroup a => a -> a -> a
<> (MLSConfig -> MLSConfig) -> DbFeature MLSConfig
forall cfg. (cfg -> cfg) -> DbFeature cfg
dbFeatureModConfig
          ( \MLSConfig
defCfg ->
              -- [Note: default values for configuration fields]
              --
              -- This case is a bit special, because Cassandra sets do not
              -- distinguish between 'null' and 'empty'. To differentiate
              -- between these cases, we use the `mls_default_protocol` field:
              -- if set, we interpret null sets as empty, otherwise we use the
              -- default.
              let configIsSet :: Bool
configIsSet = Maybe x -> Bool
forall a. Maybe a -> Bool
isJust Maybe x
defProto
               in [UserId]
-> ProtocolTag
-> [CipherSuiteTag]
-> CipherSuiteTag
-> [ProtocolTag]
-> MLSConfig
MLSConfig
                    ( [UserId]
-> (Set UserId -> [UserId]) -> Maybe (Set UserId) -> [UserId]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                        (if Bool
configIsSet then [] else MLSConfig
defCfg.mlsProtocolToggleUsers)
                        Set UserId -> [UserId]
forall a. Set a -> [a]
C.fromSet
                        Maybe x
Maybe (Set UserId)
toggleUsers
                    )
                    (ProtocolTag -> Maybe ProtocolTag -> ProtocolTag
forall a. a -> Maybe a -> a
fromMaybe MLSConfig
defCfg.mlsDefaultProtocol Maybe x
Maybe ProtocolTag
defProto)
                    ( [CipherSuiteTag]
-> (Set CipherSuiteTag -> [CipherSuiteTag])
-> Maybe (Set CipherSuiteTag)
-> [CipherSuiteTag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                        (if Bool
configIsSet then [] else MLSConfig
defCfg.mlsAllowedCipherSuites)
                        Set CipherSuiteTag -> [CipherSuiteTag]
forall a. Set a -> [a]
C.fromSet
                        Maybe x
Maybe (Set CipherSuiteTag)
ciphersuites
                    )
                    (CipherSuiteTag -> Maybe CipherSuiteTag -> CipherSuiteTag
forall a. a -> Maybe a -> a
fromMaybe MLSConfig
defCfg.mlsDefaultCipherSuite Maybe x
Maybe CipherSuiteTag
defCiphersuite)
                    ( [ProtocolTag]
-> (Set ProtocolTag -> [ProtocolTag])
-> Maybe (Set ProtocolTag)
-> [ProtocolTag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                        (if Bool
configIsSet then [] else MLSConfig
defCfg.mlsSupportedProtocols)
                        Set ProtocolTag -> [ProtocolTag]
forall a. Set a -> [a]
C.fromSet
                        Maybe x
Maybe (Set ProtocolTag)
supportedProtos
                    )
          )

  featureToRow :: LockableFeature MLSConfig -> NP Maybe (FeatureRow MLSConfig)
featureToRow LockableFeature MLSConfig
feat =
    LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature MLSConfig
feat.lockStatus
      Maybe LockStatus
-> NP
     Maybe
     '[FeatureStatus, ProtocolTag, Set UserId, Set CipherSuiteTag,
       CipherSuiteTag, Set ProtocolTag]
-> NP
     Maybe
     '[LockStatus, FeatureStatus, ProtocolTag, Set UserId,
       Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature MLSConfig
feat.status
      Maybe FeatureStatus
-> NP
     Maybe
     '[ProtocolTag, Set UserId, Set CipherSuiteTag, CipherSuiteTag,
       Set ProtocolTag]
-> NP
     Maybe
     '[FeatureStatus, ProtocolTag, Set UserId, Set CipherSuiteTag,
       CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* ProtocolTag -> Maybe ProtocolTag
forall a. a -> Maybe a
Just LockableFeature MLSConfig
feat.config.mlsDefaultProtocol
      Maybe ProtocolTag
-> NP
     Maybe
     '[Set UserId, Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
-> NP
     Maybe
     '[ProtocolTag, Set UserId, Set CipherSuiteTag, CipherSuiteTag,
       Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Set UserId -> Maybe (Set UserId)
forall a. a -> Maybe a
Just ([UserId] -> Set UserId
forall a. [a] -> Set a
C.Set LockableFeature MLSConfig
feat.config.mlsProtocolToggleUsers)
      Maybe (Set UserId)
-> NP Maybe '[Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
-> NP
     Maybe
     '[Set UserId, Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Set CipherSuiteTag -> Maybe (Set CipherSuiteTag)
forall a. a -> Maybe a
Just ([CipherSuiteTag] -> Set CipherSuiteTag
forall a. [a] -> Set a
C.Set LockableFeature MLSConfig
feat.config.mlsAllowedCipherSuites)
      Maybe (Set CipherSuiteTag)
-> NP Maybe '[CipherSuiteTag, Set ProtocolTag]
-> NP Maybe '[Set CipherSuiteTag, CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* CipherSuiteTag -> Maybe CipherSuiteTag
forall a. a -> Maybe a
Just LockableFeature MLSConfig
feat.config.mlsDefaultCipherSuite
      Maybe CipherSuiteTag
-> NP Maybe '[Set ProtocolTag]
-> NP Maybe '[CipherSuiteTag, Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Set ProtocolTag -> Maybe (Set ProtocolTag)
forall a. a -> Maybe a
Just ([ProtocolTag] -> Set ProtocolTag
forall a. [a] -> Set a
C.Set LockableFeature MLSConfig
feat.config.mlsSupportedProtocols)
      Maybe (Set ProtocolTag)
-> NP Maybe '[] -> NP Maybe '[Set ProtocolTag]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature MlsE2EIdConfig where
  type
    FeatureRow MlsE2EIdConfig =
      '[ LockStatus,
         FeatureStatus,
         Int32,
         HttpsUrl,
         HttpsUrl,
         Bool
       ]
  featureColumns :: NP (K String) (FeatureRow MlsE2EIdConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"mls_e2eid_lock_status"
      K String LockStatus
-> NP (K String) '[FeatureStatus, Int32, HttpsUrl, HttpsUrl, Bool]
-> NP
     (K String)
     '[LockStatus, FeatureStatus, Int32, HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"mls_e2eid_status"
      K String FeatureStatus
-> NP (K String) '[Int32, HttpsUrl, HttpsUrl, Bool]
-> NP (K String) '[FeatureStatus, Int32, HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String Int32
forall k a (b :: k). a -> K a b
K String
"mls_e2eid_grace_period"
      K String Int32
-> NP (K String) '[HttpsUrl, HttpsUrl, Bool]
-> NP (K String) '[Int32, HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String HttpsUrl
forall k a (b :: k). a -> K a b
K String
"mls_e2eid_acme_discovery_url"
      K String HttpsUrl
-> NP (K String) '[HttpsUrl, Bool]
-> NP (K String) '[HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String HttpsUrl
forall k a (b :: k). a -> K a b
K String
"mls_e2eid_crl_proxy"
      K String HttpsUrl
-> NP (K String) '[Bool] -> NP (K String) '[HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String Bool
forall k a (b :: k). a -> K a b
K String
"mls_e2eid_use_proxy_on_mobile"
      K String Bool -> NP (K String) '[] -> NP (K String) '[Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow MlsE2EIdConfig) -> DbFeature MlsE2EIdConfig
rowToFeature
    ( Maybe x
lockStatus
        :* Maybe x
status
        :* Maybe x
gracePeriod
        :* Maybe x
acmeDiscoveryUrl
        :* Maybe x
crlProxy
        :* Maybe x
useProxyOnMobile
        :* NP Maybe xs
Nil
      ) =
      (LockStatus -> DbFeature MlsE2EIdConfig)
-> Maybe LockStatus -> DbFeature MlsE2EIdConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature MlsE2EIdConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
        DbFeature MlsE2EIdConfig
-> DbFeature MlsE2EIdConfig -> DbFeature MlsE2EIdConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature MlsE2EIdConfig)
-> Maybe FeatureStatus -> DbFeature MlsE2EIdConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature MlsE2EIdConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status
        DbFeature MlsE2EIdConfig
-> DbFeature MlsE2EIdConfig -> DbFeature MlsE2EIdConfig
forall a. Semigroup a => a -> a -> a
<> (MlsE2EIdConfig -> MlsE2EIdConfig) -> DbFeature MlsE2EIdConfig
forall cfg. (cfg -> cfg) -> DbFeature cfg
dbFeatureModConfig
          ( \MlsE2EIdConfig
defCfg ->
              MlsE2EIdConfig
defCfg
                { verificationExpiration =
                    maybe defCfg.verificationExpiration fromIntegral gracePeriod,
                  acmeDiscoveryUrl = acmeDiscoveryUrl <|> defCfg.acmeDiscoveryUrl,
                  crlProxy = crlProxy <|> defCfg.crlProxy,
                  useProxyOnMobile = fromMaybe defCfg.useProxyOnMobile useProxyOnMobile
                }
          )

  featureToRow :: LockableFeature MlsE2EIdConfig
-> NP Maybe (FeatureRow MlsE2EIdConfig)
featureToRow LockableFeature MlsE2EIdConfig
feat =
    LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature MlsE2EIdConfig
feat.lockStatus
      Maybe LockStatus
-> NP Maybe '[FeatureStatus, Int32, HttpsUrl, HttpsUrl, Bool]
-> NP
     Maybe '[LockStatus, FeatureStatus, Int32, HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature MlsE2EIdConfig
feat.status
      Maybe FeatureStatus
-> NP Maybe '[Int32, HttpsUrl, HttpsUrl, Bool]
-> NP Maybe '[FeatureStatus, Int32, HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (NominalDiffTime -> Int32
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate LockableFeature MlsE2EIdConfig
feat.config.verificationExpiration)
      Maybe Int32
-> NP Maybe '[HttpsUrl, HttpsUrl, Bool]
-> NP Maybe '[Int32, HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* LockableFeature MlsE2EIdConfig
feat.config.acmeDiscoveryUrl
      Maybe HttpsUrl
-> NP Maybe '[HttpsUrl, Bool]
-> NP Maybe '[HttpsUrl, HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* LockableFeature MlsE2EIdConfig
feat.config.crlProxy
      Maybe HttpsUrl -> NP Maybe '[Bool] -> NP Maybe '[HttpsUrl, Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* Bool -> Maybe Bool
forall a. a -> Maybe a
Just LockableFeature MlsE2EIdConfig
feat.config.useProxyOnMobile
      Maybe Bool -> NP Maybe '[] -> NP Maybe '[Bool]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature MlsMigrationConfig where
  type
    FeatureRow MlsMigrationConfig =
      '[LockStatus, FeatureStatus, UTCTime, UTCTime]

  featureColumns :: NP (K String) (FeatureRow MlsMigrationConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"mls_migration_lock_status"
      K String LockStatus
-> NP (K String) '[FeatureStatus, UTCTime, UTCTime]
-> NP (K String) '[LockStatus, FeatureStatus, UTCTime, UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"mls_migration_status"
      K String FeatureStatus
-> NP (K String) '[UTCTime, UTCTime]
-> NP (K String) '[FeatureStatus, UTCTime, UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String UTCTime
forall k a (b :: k). a -> K a b
K String
"mls_migration_start_time"
      K String UTCTime
-> NP (K String) '[UTCTime] -> NP (K String) '[UTCTime, UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String UTCTime
forall k a (b :: k). a -> K a b
K String
"mls_migration_finalise_regardless_after"
      K String UTCTime -> NP (K String) '[] -> NP (K String) '[UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow MlsMigrationConfig)
-> DbFeature MlsMigrationConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* Maybe x
startTime :* Maybe x
finalizeAfter :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature MlsMigrationConfig)
-> Maybe LockStatus -> DbFeature MlsMigrationConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature MlsMigrationConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature MlsMigrationConfig
-> DbFeature MlsMigrationConfig -> DbFeature MlsMigrationConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature MlsMigrationConfig)
-> Maybe FeatureStatus -> DbFeature MlsMigrationConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature MlsMigrationConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status
      -- FUTUREWORK: allow using the default
      DbFeature MlsMigrationConfig
-> DbFeature MlsMigrationConfig -> DbFeature MlsMigrationConfig
forall a. Semigroup a => a -> a -> a
<> MlsMigrationConfig -> DbFeature MlsMigrationConfig
forall cfg. cfg -> DbFeature cfg
dbFeatureConfig (Maybe UTCTime -> Maybe UTCTime -> MlsMigrationConfig
MlsMigrationConfig Maybe x
Maybe UTCTime
startTime Maybe x
Maybe UTCTime
finalizeAfter)

  featureToRow :: LockableFeature MlsMigrationConfig
-> NP Maybe (FeatureRow MlsMigrationConfig)
featureToRow LockableFeature MlsMigrationConfig
feat =
    LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature MlsMigrationConfig
feat.lockStatus
      Maybe LockStatus
-> NP Maybe '[FeatureStatus, UTCTime, UTCTime]
-> NP Maybe '[LockStatus, FeatureStatus, UTCTime, UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature MlsMigrationConfig
feat.status
      Maybe FeatureStatus
-> NP Maybe '[UTCTime, UTCTime]
-> NP Maybe '[FeatureStatus, UTCTime, UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* LockableFeature MlsMigrationConfig
feat.config.startTime
      Maybe UTCTime
-> NP Maybe '[UTCTime] -> NP Maybe '[UTCTime, UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* LockableFeature MlsMigrationConfig
feat.config.finaliseRegardlessAfter
      Maybe UTCTime -> NP Maybe '[] -> NP Maybe '[UTCTime]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature EnforceFileDownloadLocationConfig where
  type FeatureRow EnforceFileDownloadLocationConfig = '[LockStatus, FeatureStatus, Text]

  featureColumns :: NP (K String) (FeatureRow EnforceFileDownloadLocationConfig)
featureColumns =
    String -> K String LockStatus
forall k a (b :: k). a -> K a b
K String
"enforce_file_download_location_lock_status"
      K String LockStatus
-> NP (K String) '[FeatureStatus, Text]
-> NP (K String) '[LockStatus, FeatureStatus, Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"enforce_file_download_location_status"
      K String FeatureStatus
-> NP (K String) '[Text] -> NP (K String) '[FeatureStatus, Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* String -> K String Text
forall k a (b :: k). a -> K a b
K String
"enforce_file_download_location"
      K String Text -> NP (K String) '[] -> NP (K String) '[Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

  rowToFeature :: NP Maybe (FeatureRow EnforceFileDownloadLocationConfig)
-> DbFeature EnforceFileDownloadLocationConfig
rowToFeature (Maybe x
lockStatus :* Maybe x
status :* Maybe x
location :* NP Maybe xs
Nil) =
    (LockStatus -> DbFeature EnforceFileDownloadLocationConfig)
-> Maybe LockStatus -> DbFeature EnforceFileDownloadLocationConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LockStatus -> DbFeature EnforceFileDownloadLocationConfig
forall cfg. LockStatus -> DbFeature cfg
dbFeatureLockStatus Maybe x
Maybe LockStatus
lockStatus
      DbFeature EnforceFileDownloadLocationConfig
-> DbFeature EnforceFileDownloadLocationConfig
-> DbFeature EnforceFileDownloadLocationConfig
forall a. Semigroup a => a -> a -> a
<> (FeatureStatus -> DbFeature EnforceFileDownloadLocationConfig)
-> Maybe FeatureStatus
-> DbFeature EnforceFileDownloadLocationConfig
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FeatureStatus -> DbFeature EnforceFileDownloadLocationConfig
forall cfg. FeatureStatus -> DbFeature cfg
dbFeatureStatus Maybe x
Maybe FeatureStatus
status
      -- FUTUREWORK: allow using the default
      DbFeature EnforceFileDownloadLocationConfig
-> DbFeature EnforceFileDownloadLocationConfig
-> DbFeature EnforceFileDownloadLocationConfig
forall a. Semigroup a => a -> a -> a
<> EnforceFileDownloadLocationConfig
-> DbFeature EnforceFileDownloadLocationConfig
forall cfg. cfg -> DbFeature cfg
dbFeatureConfig (Maybe Text -> EnforceFileDownloadLocationConfig
EnforceFileDownloadLocationConfig Maybe x
Maybe Text
location)
  featureToRow :: LockableFeature EnforceFileDownloadLocationConfig
-> NP Maybe (FeatureRow EnforceFileDownloadLocationConfig)
featureToRow LockableFeature EnforceFileDownloadLocationConfig
feat =
    LockStatus -> Maybe LockStatus
forall a. a -> Maybe a
Just LockableFeature EnforceFileDownloadLocationConfig
feat.lockStatus
      Maybe LockStatus
-> NP Maybe '[FeatureStatus, Text]
-> NP Maybe '[LockStatus, FeatureStatus, Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* FeatureStatus -> Maybe FeatureStatus
forall a. a -> Maybe a
Just LockableFeature EnforceFileDownloadLocationConfig
feat.status
      Maybe FeatureStatus
-> NP Maybe '[Text] -> NP Maybe '[FeatureStatus, Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* LockableFeature EnforceFileDownloadLocationConfig
feat.config.enforcedDownloadLocation
      Maybe Text -> NP Maybe '[] -> NP Maybe '[Text]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe '[]
forall {k} (a :: k -> *). NP a '[]
Nil

instance MakeFeature LimitedEventFanoutConfig where
  featureColumns :: NP (K String) (FeatureRow LimitedEventFanoutConfig)
featureColumns = String -> K String FeatureStatus
forall k a (b :: k). a -> K a b
K String
"limited_event_fanout_status" K String FeatureStatus
-> NP (K String) '[] -> NP (K String) '[FeatureStatus]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K String) '[]
forall {k} (a :: k -> *). NP a '[]
Nil

fetchFeature ::
  forall cfg m row mrow.
  ( MonadClient m,
    row ~ FeatureRow cfg,
    MakeFeature cfg,
    IsProductType (TupleP mrow) mrow,
    AllZip (IsF Maybe) row mrow,
    Tuple (TupleP mrow)
  ) =>
  TeamId ->
  m (DbFeature cfg)
fetchFeature :: forall cfg (m :: * -> *) (row :: [*]) (mrow :: [*]).
(MonadClient m, row ~ FeatureRow cfg, MakeFeature cfg,
 IsProductType (TupleP mrow) mrow, AllZip (IsF Maybe) row mrow,
 Tuple (TupleP mrow)) =>
TeamId -> m (DbFeature cfg)
fetchFeature TeamId
tid = do
  case forall cfg. MakeFeature cfg => NP (K String) (FeatureRow cfg)
featureColumns @cfg of
    NP (K String) (FeatureRow cfg)
Nil -> DbFeature cfg -> m (DbFeature cfg)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NP Maybe (FeatureRow cfg) -> DbFeature cfg
forall cfg.
MakeFeature cfg =>
NP Maybe (FeatureRow cfg) -> DbFeature cfg
rowToFeature NP Maybe '[]
NP Maybe (FeatureRow cfg)
forall {k} (a :: k -> *). NP a '[]
Nil)
    NP (K String) (FeatureRow cfg)
cols -> do
      Maybe (NP Maybe row)
mRow <- forall (row :: [*]) (mrow :: [*]) (m :: * -> *).
(MonadClient m, IsProductType (TupleP mrow) mrow,
 AllZip (IsF Maybe) row mrow, Tuple (TupleP mrow)) =>
TeamId -> NP (K String) row -> m (Maybe (NP Maybe row))
fetchFeatureRow @row @mrow TeamId
tid NP (K String) row
NP (K String) (FeatureRow cfg)
cols
      DbFeature cfg -> m (DbFeature cfg)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbFeature cfg -> m (DbFeature cfg))
-> DbFeature cfg -> m (DbFeature cfg)
forall a b. (a -> b) -> a -> b
$ (NP Maybe row -> DbFeature cfg)
-> Maybe (NP Maybe row) -> DbFeature cfg
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NP Maybe row -> DbFeature cfg
NP Maybe (FeatureRow cfg) -> DbFeature cfg
forall cfg.
MakeFeature cfg =>
NP Maybe (FeatureRow cfg) -> DbFeature cfg
rowToFeature Maybe (NP Maybe row)
mRow

fetchFeatureRow ::
  forall row mrow m.
  ( MonadClient m,
    IsProductType (TupleP mrow) mrow,
    AllZip (IsF Maybe) row mrow,
    Tuple (TupleP mrow)
  ) =>
  TeamId ->
  NP (K String) row ->
  m (Maybe (NP Maybe row))
fetchFeatureRow :: forall (row :: [*]) (mrow :: [*]) (m :: * -> *).
(MonadClient m, IsProductType (TupleP mrow) mrow,
 AllZip (IsF Maybe) row mrow, Tuple (TupleP mrow)) =>
TeamId -> NP (K String) row -> m (Maybe (NP Maybe row))
fetchFeatureRow TeamId
tid NP (K String) row
cols = do
  let select :: PrepQuery R (Identity TeamId) (TupleP mrow)
      select :: PrepQuery R (Identity TeamId) (TupleP mrow)
select =
        String -> PrepQuery R (Identity TeamId) (TupleP mrow)
forall a. IsString a => String -> a
fromString (String -> PrepQuery R (Identity TeamId) (TupleP mrow))
-> String -> PrepQuery R (Identity TeamId) (TupleP mrow)
forall a b. (a -> b) -> a -> b
$
          String
"select "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (NP (K String) row -> CollapseTo NP String
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse NP (K String) row
cols)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" from team_features where team_id = ?"
  Maybe (TupleP mrow)
row <- RetrySettings -> m (Maybe (TupleP mrow)) -> m (Maybe (TupleP mrow))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m (Maybe (TupleP mrow)) -> m (Maybe (TupleP mrow)))
-> m (Maybe (TupleP mrow)) -> m (Maybe (TupleP mrow))
forall a b. (a -> b) -> a -> b
$ PrepQuery R (Identity TeamId) (TupleP mrow)
-> QueryParams (Identity TeamId) -> m (Maybe (TupleP mrow))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity TeamId) (TupleP mrow)
select (Consistency -> Identity TeamId -> QueryParams (Identity TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId -> Identity TeamId
forall a. a -> Identity a
Identity TeamId
tid))
  Maybe (NP Maybe row) -> m (Maybe (NP Maybe row))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NP Maybe row) -> m (Maybe (NP Maybe row)))
-> Maybe (NP Maybe row) -> m (Maybe (NP Maybe row))
forall a b. (a -> b) -> a -> b
$ (TupleP mrow -> NP Maybe row)
-> Maybe (TupleP mrow) -> Maybe (NP Maybe row)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NP I mrow -> NP Maybe row
forall {k} (f :: k -> *) (xs :: [k]) (ys :: [*]).
AllZip (IsF f) xs ys =>
NP I ys -> NP f xs
unfactorI (NP I mrow -> NP Maybe row)
-> (TupleP mrow -> NP I mrow) -> TupleP mrow -> NP Maybe row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TupleP mrow -> NP I mrow
forall a (xs :: [*]). IsProductType a xs => a -> NP I xs
productTypeFrom) Maybe (TupleP mrow)
row

storeFeature ::
  forall cfg m row mrow.
  ( MonadClient m,
    row ~ FeatureRow cfg,
    MakeFeature cfg,
    IsProductType (TupleP (TeamId : mrow)) (TeamId : mrow),
    AllZip (IsF Maybe) row mrow,
    Tuple (TupleP (TeamId : mrow)),
    KnownNat (Length row)
  ) =>
  TeamId ->
  LockableFeature cfg ->
  m ()
storeFeature :: forall cfg (m :: * -> *) (row :: [*]) (mrow :: [*]).
(MonadClient m, row ~ FeatureRow cfg, MakeFeature cfg,
 IsProductType (TupleP (TeamId : mrow)) (TeamId : mrow),
 AllZip (IsF Maybe) row mrow, Tuple (TupleP (TeamId : mrow)),
 KnownNat (Length row)) =>
TeamId -> LockableFeature cfg -> m ()
storeFeature TeamId
tid LockableFeature cfg
feat = do
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else
      RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        PrepQuery W (TupleP (TeamId : mrow)) ()
-> QueryParams (TupleP (TeamId : mrow)) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write
          PrepQuery W (TupleP (TeamId : mrow)) ()
insert
          ( Consistency
-> TupleP (TeamId : mrow) -> QueryParams (TupleP (TeamId : mrow))
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (NP I (TeamId : mrow) -> TupleP (TeamId : mrow)
forall a (xs :: [*]). IsProductType a xs => NP I xs -> a
productTypeTo (TeamId -> I TeamId
forall a. a -> I a
I TeamId
tid I TeamId -> NP I mrow -> NP I (TeamId : mrow)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP Maybe row -> NP I mrow
forall {k} (f :: k -> *) (xs :: [k]) (ys :: [*]).
AllZip (IsF f) xs ys =>
NP f xs -> NP I ys
factorI (LockableFeature cfg -> NP Maybe (FeatureRow cfg)
forall cfg.
MakeFeature cfg =>
LockableFeature cfg -> NP Maybe (FeatureRow cfg)
featureToRow LockableFeature cfg
feat)))
          )
  where
    n :: Int
    n :: Int
n = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (a :: Natural).
(SingKind Natural, SingI a) =>
Demote Natural
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(Length row))

    insert :: PrepQuery W (TupleP (TeamId ': mrow)) ()
    insert :: PrepQuery W (TupleP (TeamId : mrow)) ()
insert =
      String -> PrepQuery W (TupleP (TeamId : mrow)) ()
forall a. IsString a => String -> a
fromString (String -> PrepQuery W (TupleP (TeamId : mrow)) ())
-> String -> PrepQuery W (TupleP (TeamId : mrow)) ()
forall a b. (a -> b) -> a -> b
$
        String
"insert into team_features (team_id, "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (NP (K String) row -> CollapseTo NP String
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (forall cfg. MakeFeature cfg => NP (K String) (FeatureRow cfg)
featureColumns @cfg))
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") values ("
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Enum a => a -> a
succ Int
n) String
"?")
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

class (FeatureRow cfg ~ row) => StoreFeatureLockStatus (row :: [Type]) cfg where
  storeFeatureLockStatus' :: (MonadClient m) => TeamId -> Tagged cfg LockStatus -> m ()

instance
  {-# OVERLAPPING #-}
  ( FeatureRow cfg ~ (LockStatus ': row),
    MakeFeature cfg
  ) =>
  StoreFeatureLockStatus (LockStatus ': row) cfg
  where
  storeFeatureLockStatus' :: forall (m :: * -> *).
MonadClient m =>
TeamId -> Tagged cfg LockStatus -> m ()
storeFeatureLockStatus' TeamId
tid Tagged cfg LockStatus
lock = do
    let col :: String
col = K String LockStatus -> String
forall {k} a (b :: k). K a b -> a
unK (NP (K String) (LockStatus : row) -> K String LockStatus
forall {k} (f :: k -> *) (x :: k) (xs :: [k]). NP f (x : xs) -> f x
hd (forall cfg. MakeFeature cfg => NP (K String) (FeatureRow cfg)
featureColumns @cfg))
        insert :: PrepQuery W (TeamId, LockStatus) ()
        insert :: PrepQuery W (TeamId, LockStatus) ()
insert =
          String -> PrepQuery W (TeamId, LockStatus) ()
forall a. IsString a => String -> a
fromString (String -> PrepQuery W (TeamId, LockStatus) ())
-> String -> PrepQuery W (TeamId, LockStatus) ()
forall a b. (a -> b) -> a -> b
$
            String
"insert into team_features (team_id, " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
col String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") values (?, ?)"
    RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (TeamId, LockStatus) ()
-> QueryParams (TeamId, LockStatus) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (TeamId, LockStatus) ()
insert (Consistency
-> (TeamId, LockStatus) -> QueryParams (TeamId, LockStatus)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId
tid, (Tagged cfg LockStatus -> LockStatus
forall a b. Tagged a b -> b
untag Tagged cfg LockStatus
lock)))

instance (FeatureRow cfg ~ row) => StoreFeatureLockStatus row cfg where
  storeFeatureLockStatus' :: forall (m :: * -> *).
MonadClient m =>
TeamId -> Tagged cfg LockStatus -> m ()
storeFeatureLockStatus' TeamId
_ Tagged cfg LockStatus
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

storeFeatureLockStatus ::
  forall cfg m.
  (MonadClient m, StoreFeatureLockStatus (FeatureRow cfg) cfg) =>
  TeamId ->
  Tagged cfg LockStatus ->
  m ()
storeFeatureLockStatus :: forall cfg (m :: * -> *).
(MonadClient m, StoreFeatureLockStatus (FeatureRow cfg) cfg) =>
TeamId -> Tagged cfg LockStatus -> m ()
storeFeatureLockStatus = forall (row :: [*]) cfg (m :: * -> *).
(StoreFeatureLockStatus row cfg, MonadClient m) =>
TeamId -> Tagged cfg LockStatus -> m ()
storeFeatureLockStatus' @(FeatureRow cfg)

-- | Convert @NP f [x1, ..., xn]@ to @NP I [f x1, ..., f xn]@.
--
-- This works because @I . f = f@.
factorI :: forall f xs ys. (AllZip (IsF f) xs ys) => NP f xs -> NP I ys
factorI :: forall {k} (f :: k -> *) (xs :: [k]) (ys :: [*]).
AllZip (IsF f) xs ys =>
NP f xs -> NP I ys
factorI NP f xs
Nil = NP I ys
NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil
factorI (f x
x :* NP f xs
xs) = f x -> I (f x)
forall a. a -> I a
I f x
x I (f x) -> NP I (Tail ys) -> NP I (f x : Tail ys)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP f xs -> NP I (Tail ys)
forall {k} (f :: k -> *) (xs :: [k]) (ys :: [*]).
AllZip (IsF f) xs ys =>
NP f xs -> NP I ys
factorI NP f xs
xs

-- | Convert @NP I [f x1, ..., f xn]@ to @NP f [x1, ..., xn]@.
--
-- See 'factorI'.
unfactorI :: forall f xs ys. (AllZip (IsF f) xs ys) => NP I ys -> NP f xs
unfactorI :: forall {k} (f :: k -> *) (xs :: [k]) (ys :: [*]).
AllZip (IsF f) xs ys =>
NP I ys -> NP f xs
unfactorI NP I ys
Nil = NP f xs
NP f '[]
forall {k} (a :: k -> *). NP a '[]
Nil
unfactorI (I x
x :* NP I xs
xs) = x
f (Head xs)
x f (Head xs) -> NP f (Tail xs) -> NP f (Head xs : Tail xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I xs -> NP f (Tail xs)
forall {k} (f :: k -> *) (xs :: [k]) (ys :: [*]).
AllZip (IsF f) xs ys =>
NP I ys -> NP f xs
unfactorI NP I xs
xs

-- | This is to emulate a constraint-level lambda.
class (f x ~ y) => IsF f x y | y -> x

instance (f x ~ y) => IsF f x y