module Wire.API.Event.FeatureConfig
( Event (..),
EventType (..),
mkUpdateEvent,
)
where
import Data.Aeson (toJSON)
import Data.Aeson qualified as A
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Json.Util (ToJSONObject (toJSONObject))
import Data.OpenApi qualified as S
import Data.Schema
import Imports
import Test.QuickCheck.Gen
import Wire.API.Team.Feature
import Wire.Arbitrary (Arbitrary (..), GenericUniform (..))
data Event = Event
{ Event -> EventType
_eventType :: EventType,
Event -> Text
_eventFeatureName :: Text,
Event -> Value
_eventData :: A.Value
}
deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
Generic)
deriving ([Event] -> Value
[Event] -> Encoding
Event -> Value
Event -> Encoding
(Event -> Value)
-> (Event -> Encoding)
-> ([Event] -> Value)
-> ([Event] -> Encoding)
-> ToJSON Event
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Event -> Value
toJSON :: Event -> Value
$ctoEncoding :: Event -> Encoding
toEncoding :: Event -> Encoding
$ctoJSONList :: [Event] -> Value
toJSONList :: [Event] -> Value
$ctoEncodingList :: [Event] -> Encoding
toEncodingList :: [Event] -> Encoding
A.ToJSON, Value -> Parser [Event]
Value -> Parser Event
(Value -> Parser Event)
-> (Value -> Parser [Event]) -> FromJSON Event
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Event
parseJSON :: Value -> Parser Event
$cparseJSONList :: Value -> Parser [Event]
parseJSONList :: Value -> Parser [Event]
A.FromJSON) via Schema Event
arbitraryFeature :: forall cfg. (IsFeatureConfig cfg, Arbitrary cfg) => Gen A.Value
arbitraryFeature :: forall cfg. (IsFeatureConfig cfg, Arbitrary cfg) => Gen Value
arbitraryFeature = LockableFeature cfg -> Value
forall a. ToJSON a => a -> Value
toJSON (LockableFeature cfg -> Value)
-> Gen (LockableFeature cfg) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @(LockableFeature cfg)
class AllArbitraryFeatures cfgs where
allArbitraryFeatures :: [Gen A.Value]
instance AllArbitraryFeatures '[] where
allArbitraryFeatures :: [Gen Value]
allArbitraryFeatures = []
instance
( IsFeatureConfig cfg,
Arbitrary cfg,
AllArbitraryFeatures cfgs
) =>
AllArbitraryFeatures (cfg : cfgs)
where
allArbitraryFeatures :: [Gen Value]
allArbitraryFeatures = forall cfg. (IsFeatureConfig cfg, Arbitrary cfg) => Gen Value
arbitraryFeature @cfg Gen Value -> [Gen Value] -> [Gen Value]
forall a. a -> [a] -> [a]
: forall (cfgs :: [*]). AllArbitraryFeatures cfgs => [Gen Value]
forall {k} (cfgs :: k). AllArbitraryFeatures cfgs => [Gen Value]
allArbitraryFeatures @cfgs
instance Arbitrary Event where
arbitrary :: Gen Event
arbitrary =
EventType -> Text -> Value -> Event
Event
(EventType -> Text -> Value -> Event)
-> Gen EventType -> Gen (Text -> Value -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EventType
forall a. Arbitrary a => Gen a
arbitrary
Gen (Text -> Value -> Event) -> Gen Text -> Gen (Value -> Event)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
Gen (Value -> Event) -> Gen Value -> Gen Event
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
oneof (forall (cfgs :: [*]). AllArbitraryFeatures cfgs => [Gen Value]
forall {k} (cfgs :: k). AllArbitraryFeatures cfgs => [Gen Value]
allArbitraryFeatures @Features)
data EventType = Update
deriving (EventType -> EventType -> Bool
(EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool) -> Eq EventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventType -> EventType -> Bool
== :: EventType -> EventType -> Bool
$c/= :: EventType -> EventType -> Bool
/= :: EventType -> EventType -> Bool
Eq, Int -> EventType -> ShowS
[EventType] -> ShowS
EventType -> String
(Int -> EventType -> ShowS)
-> (EventType -> String)
-> ([EventType] -> ShowS)
-> Show EventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventType -> ShowS
showsPrec :: Int -> EventType -> ShowS
$cshow :: EventType -> String
show :: EventType -> String
$cshowList :: [EventType] -> ShowS
showList :: [EventType] -> ShowS
Show, (forall x. EventType -> Rep EventType x)
-> (forall x. Rep EventType x -> EventType) -> Generic EventType
forall x. Rep EventType x -> EventType
forall x. EventType -> Rep EventType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EventType -> Rep EventType x
from :: forall x. EventType -> Rep EventType x
$cto :: forall x. Rep EventType x -> EventType
to :: forall x. Rep EventType x -> EventType
Generic)
deriving (Gen EventType
Gen EventType -> (EventType -> [EventType]) -> Arbitrary EventType
EventType -> [EventType]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen EventType
arbitrary :: Gen EventType
$cshrink :: EventType -> [EventType]
shrink :: EventType -> [EventType]
Arbitrary) via GenericUniform EventType
instance ToSchema EventType where
schema :: ValueSchema NamedSwaggerDoc EventType
schema =
forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"EventType" (SchemaP [Value] Text (Alt Maybe Text) EventType EventType
-> ValueSchema NamedSwaggerDoc EventType)
-> SchemaP [Value] Text (Alt Maybe Text) EventType EventType
-> ValueSchema NamedSwaggerDoc EventType
forall a b. (a -> b) -> a -> b
$
[SchemaP [Value] Text (Alt Maybe Text) EventType EventType]
-> SchemaP [Value] Text (Alt Maybe Text) EventType EventType
forall a. Monoid a => [a] -> a
mconcat
[ Text
-> EventType
-> SchemaP [Value] Text (Alt Maybe Text) EventType EventType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"feature-config.update" EventType
Update
]
eventObjectSchema :: ObjectSchema SwaggerDoc Event
eventObjectSchema :: ObjectSchema SwaggerDoc Event
eventObjectSchema =
EventType -> Text -> Value -> Event
Event
(EventType -> Text -> Value -> Event)
-> SchemaP SwaggerDoc Object [Pair] Event EventType
-> SchemaP SwaggerDoc Object [Pair] Event (Text -> Value -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event -> EventType
_eventType (Event -> EventType)
-> SchemaP SwaggerDoc Object [Pair] EventType EventType
-> SchemaP SwaggerDoc Object [Pair] Event EventType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc EventType
-> SchemaP SwaggerDoc Object [Pair] EventType EventType
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"type" ValueSchema NamedSwaggerDoc EventType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
SchemaP SwaggerDoc Object [Pair] Event (Text -> Value -> Event)
-> SchemaP SwaggerDoc Object [Pair] Event Text
-> SchemaP SwaggerDoc Object [Pair] Event (Value -> Event)
forall a b.
SchemaP SwaggerDoc Object [Pair] Event (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Event a
-> SchemaP SwaggerDoc Object [Pair] Event b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Event -> Text
_eventFeatureName (Event -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] Event Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"name" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
SchemaP SwaggerDoc Object [Pair] Event (Value -> Event)
-> SchemaP SwaggerDoc Object [Pair] Event Value
-> ObjectSchema SwaggerDoc Event
forall a b.
SchemaP SwaggerDoc Object [Pair] Event (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Event a
-> SchemaP SwaggerDoc Object [Pair] Event b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Event -> Value
_eventData (Event -> Value)
-> SchemaP SwaggerDoc Object [Pair] Value Value
-> SchemaP SwaggerDoc Object [Pair] Event Value
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value Value Value
-> SchemaP SwaggerDoc Object [Pair] Value Value
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"data" SchemaP SwaggerDoc Value Value Value Value
jsonValue
instance ToSchema Event where
schema :: ValueSchema NamedSwaggerDoc Event
schema =
Text
-> ObjectSchema SwaggerDoc Event
-> ValueSchema NamedSwaggerDoc Event
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Event" ObjectSchema SwaggerDoc Event
eventObjectSchema
instance ToJSONObject Event where
toJSONObject :: Event -> Object
toJSONObject =
[Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
([Pair] -> Object) -> (Event -> [Pair]) -> Event -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Maybe [Pair] -> [Pair]
forall a. a -> Maybe a -> a
fromMaybe []
(Maybe [Pair] -> [Pair])
-> (Event -> Maybe [Pair]) -> Event -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectSchema SwaggerDoc Event -> Event -> Maybe [Pair]
forall ss v m a b. SchemaP ss v m a b -> a -> Maybe m
schemaOut ObjectSchema SwaggerDoc Event
eventObjectSchema
instance S.ToSchema Event where
declareNamedSchema :: Proxy Event -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = Proxy Event -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
schemaToSwagger
mkUpdateEvent :: forall cfg. (IsFeatureConfig cfg) => LockableFeature cfg -> Event
mkUpdateEvent :: forall cfg. IsFeatureConfig cfg => LockableFeature cfg -> Event
mkUpdateEvent LockableFeature cfg
ws = EventType -> Text -> Value -> Event
Event EventType
Update (forall cfg. IsFeatureConfig cfg => Text
featureName @cfg) (LockableFeature cfg -> Value
forall a. ToJSON a => a -> Value
toJSON LockableFeature cfg
ws)