{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

-- 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 Wire.API.Event.Team
  ( -- * Event
    Event,
    newEvent,
    eventType,
    eventTime,
    eventTeam,
    eventData,

    -- * EventType
    EventType (..),

    -- * EventData
    EventData (..),
  )
where

import Control.Lens (makeLenses, (?~))
import Data.Aeson hiding (object, (.=))
import Data.Aeson qualified as A
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser)
import Data.Id (ConvId, TeamId, UserId)
import Data.Json.Util
import Data.OpenApi qualified as S
import Data.Schema
import Data.Time (UTCTime)
import Imports
import Test.QuickCheck qualified as QC
import Wire.API.Team (Team, TeamUpdateData)
import Wire.API.Team.Permission (Permissions)
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- Event

data Event = Event
  { Event -> TeamId
_eventTeam :: TeamId,
    Event -> UTCTime
_eventTime :: UTCTime,
    Event -> EventData
_eventData :: EventData
  }
  deriving stock (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)

instance ToSchema Event where
  schema :: ValueSchema NamedSwaggerDoc Event
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Event 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" (SchemaP SwaggerDoc Object [Pair] Event Event
 -> ValueSchema NamedSwaggerDoc Event)
-> SchemaP SwaggerDoc Object [Pair] Event Event
-> ValueSchema NamedSwaggerDoc Event
forall a b. (a -> b) -> a -> b
$
      TeamId -> UTCTime -> EventData -> Event
Event
        (TeamId -> UTCTime -> EventData -> Event)
-> SchemaP SwaggerDoc Object [Pair] Event TeamId
-> SchemaP
     SwaggerDoc Object [Pair] Event (UTCTime -> EventData -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event -> TeamId
_eventTeam (Event -> TeamId)
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] Event TeamId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value TeamId TeamId
-> SchemaP SwaggerDoc Object [Pair] TeamId TeamId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"team" SchemaP NamedSwaggerDoc Value Value TeamId TeamId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] Event (UTCTime -> EventData -> Event)
-> SchemaP SwaggerDoc Object [Pair] Event UTCTime
-> SchemaP SwaggerDoc Object [Pair] Event (EventData -> 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 -> UTCTime
_eventTime (Event -> UTCTime)
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] Event UTCTime
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"time" SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
utcTimeSchema
        SchemaP SwaggerDoc Object [Pair] Event (EventData -> Event)
-> SchemaP SwaggerDoc Object [Pair] Event EventData
-> SchemaP SwaggerDoc Object [Pair] Event 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 -> EventData
_eventData (Event -> EventData)
-> SchemaP SwaggerDoc Object [Pair] EventData EventData
-> SchemaP SwaggerDoc Object [Pair] Event EventData
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value EventData EventData
-> SchemaP SwaggerDoc Object [Pair] EventData EventData
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier Text
"data" ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
dataFieldDesc) SchemaP NamedSwaggerDoc Value Value EventData EventData
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP SwaggerDoc Object [Pair] Event Event
-> SchemaP SwaggerDoc Object [Pair] Event EventType
-> SchemaP SwaggerDoc Object [Pair] Event Event
forall a b.
SchemaP SwaggerDoc Object [Pair] Event a
-> SchemaP SwaggerDoc Object [Pair] Event b
-> SchemaP SwaggerDoc Object [Pair] Event a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
-> SchemaP NamedSwaggerDoc Value Value EventType 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
"version" SchemaP NamedSwaggerDoc Value Value EventType EventType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      dataFieldDesc :: Text
dataFieldDesc = Text
"FUTUREWORK: this part of the docs is lying; we're working on it!"

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

eventType :: Event -> EventType
eventType :: Event -> EventType
eventType = EventData -> EventType
eventDataType (EventData -> EventType)
-> (Event -> EventData) -> Event -> EventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> EventData
_eventData

newEvent :: TeamId -> UTCTime -> EventData -> Event
newEvent :: TeamId -> UTCTime -> EventData -> Event
newEvent = TeamId -> UTCTime -> EventData -> Event
Event

instance ToJSON Event where
  toJSON :: Event -> Value
toJSON = Object -> Value
A.Object (Object -> Value) -> (Event -> Object) -> Event -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject

instance ToJSONObject Event where
  toJSONObject :: Event -> Object
toJSONObject Event
e =
    [Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
      [ Key
"type" Key -> EventType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Event -> EventType
eventType Event
e,
        Key
"team" Key -> TeamId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Event -> TeamId
_eventTeam Event
e,
        Key
"time" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Event -> UTCTime
_eventTime Event
e,
        Key
"data" Key -> EventData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Event -> EventData
_eventData Event
e
      ]

instance FromJSON Event where
  parseJSON :: Value -> Parser Event
parseJSON = String -> (Object -> Parser Event) -> Value -> Parser Event
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"event" ((Object -> Parser Event) -> Value -> Parser Event)
-> (Object -> Parser Event) -> Value -> Parser Event
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    EventType
ty <- Object
o Object -> Key -> Parser EventType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe Value
dt <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data"
    TeamId -> UTCTime -> EventData -> Event
Event
      (TeamId -> UTCTime -> EventData -> Event)
-> Parser TeamId -> Parser (UTCTime -> EventData -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TeamId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"team"
      Parser (UTCTime -> EventData -> Event)
-> Parser UTCTime -> Parser (EventData -> Event)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
      Parser (EventData -> Event) -> Parser EventData -> Parser Event
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventType -> Maybe Value -> Parser EventData
parseEventData EventType
ty Maybe Value
dt

instance Arbitrary Event where
  arbitrary :: Gen Event
arbitrary = do
    EventType
typ <- Gen EventType
forall a. Arbitrary a => Gen a
arbitrary
    TeamId -> UTCTime -> EventData -> Event
Event
      (TeamId -> UTCTime -> EventData -> Event)
-> Gen TeamId -> Gen (UTCTime -> EventData -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TeamId
forall a. Arbitrary a => Gen a
arbitrary
      Gen (UTCTime -> EventData -> Event)
-> Gen UTCTime -> Gen (EventData -> 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 UTCTime
forall a. Arbitrary a => Gen a
arbitrary
      Gen (EventData -> Event) -> Gen EventData -> 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
<*> EventType -> Gen EventData
genEventData EventType
typ

--------------------------------------------------------------------------------
-- EventType

data EventType
  = TeamCreate
  | TeamDelete
  | TeamUpdate
  | MemberJoin
  | MemberLeave
  | MemberUpdate
  | ConvCreate
  | ConvDelete
  deriving stock (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)
  deriving (Value -> Parser [EventType]
Value -> Parser EventType
(Value -> Parser EventType)
-> (Value -> Parser [EventType]) -> FromJSON EventType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EventType
parseJSON :: Value -> Parser EventType
$cparseJSONList :: Value -> Parser [EventType]
parseJSONList :: Value -> Parser [EventType]
FromJSON, [EventType] -> Value
[EventType] -> Encoding
EventType -> Value
EventType -> Encoding
(EventType -> Value)
-> (EventType -> Encoding)
-> ([EventType] -> Value)
-> ([EventType] -> Encoding)
-> ToJSON EventType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EventType -> Value
toJSON :: EventType -> Value
$ctoEncoding :: EventType -> Encoding
toEncoding :: EventType -> Encoding
$ctoJSONList :: [EventType] -> Value
toJSONList :: [EventType] -> Value
$ctoEncodingList :: [EventType] -> Encoding
toEncodingList :: [EventType] -> Encoding
ToJSON, Typeable EventType
Typeable EventType =>
(Proxy EventType -> Declare (Definitions Schema) NamedSchema)
-> ToSchema EventType
Proxy EventType -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy EventType -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy EventType -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema EventType

instance ToSchema EventType where
  schema :: SchemaP NamedSwaggerDoc Value Value EventType 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
 -> SchemaP NamedSwaggerDoc Value Value EventType EventType)
-> SchemaP [Value] Text (Alt Maybe Text) EventType EventType
-> SchemaP NamedSwaggerDoc Value Value EventType 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
"team.create" EventType
TeamCreate,
          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
"team.delete" EventType
TeamDelete,
          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
"team.update" EventType
TeamUpdate,
          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
"team.member-join" EventType
MemberJoin,
          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
"team.member-leave" EventType
MemberLeave,
          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
"team.member-update" EventType
MemberUpdate,
          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
"team.conversation-create" EventType
ConvCreate,
          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
"team.conversation-delete" EventType
ConvDelete
        ]

--------------------------------------------------------------------------------
-- EventData

data EventData
  = EdTeamCreate Team
  | EdTeamDelete
  | EdTeamUpdate TeamUpdateData
  | EdMemberJoin UserId
  | EdMemberLeave UserId
  | EdMemberUpdate UserId (Maybe Permissions)
  | EdConvCreate ConvId
  | EdConvDelete ConvId
  deriving stock (EventData -> EventData -> Bool
(EventData -> EventData -> Bool)
-> (EventData -> EventData -> Bool) -> Eq EventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventData -> EventData -> Bool
== :: EventData -> EventData -> Bool
$c/= :: EventData -> EventData -> Bool
/= :: EventData -> EventData -> Bool
Eq, Int -> EventData -> ShowS
[EventData] -> ShowS
EventData -> String
(Int -> EventData -> ShowS)
-> (EventData -> String)
-> ([EventData] -> ShowS)
-> Show EventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventData -> ShowS
showsPrec :: Int -> EventData -> ShowS
$cshow :: EventData -> String
show :: EventData -> String
$cshowList :: [EventData] -> ShowS
showList :: [EventData] -> ShowS
Show, (forall x. EventData -> Rep EventData x)
-> (forall x. Rep EventData x -> EventData) -> Generic EventData
forall x. Rep EventData x -> EventData
forall x. EventData -> Rep EventData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EventData -> Rep EventData x
from :: forall x. EventData -> Rep EventData x
$cto :: forall x. Rep EventData x -> EventData
to :: forall x. Rep EventData x -> EventData
Generic)

-- FUTUREWORK: this is outright wrong; see "Wire.API.Event.Conversation" on how to do this properly.
instance ToSchema EventData where
  schema :: SchemaP NamedSwaggerDoc Value Value EventData EventData
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] EventData EventData
-> SchemaP NamedSwaggerDoc Value Value EventData EventData
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"EventData" (SchemaP SwaggerDoc Object [Pair] EventData EventData
 -> SchemaP NamedSwaggerDoc Value Value EventData EventData)
-> SchemaP SwaggerDoc Object [Pair] EventData EventData
-> SchemaP NamedSwaggerDoc Value Value EventData EventData
forall a b. (a -> b) -> a -> b
$
      Team -> EventData
EdTeamCreate
        (Team -> EventData)
-> SchemaP SwaggerDoc Object [Pair] EventData Team
-> SchemaP SwaggerDoc Object [Pair] EventData EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EventData -> Team
forall a. HasCallStack => a
undefined :: EventData -> Team) (EventData -> Team)
-> SchemaP SwaggerDoc Object [Pair] Team Team
-> SchemaP SwaggerDoc Object [Pair] EventData Team
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Team Team
-> SchemaP SwaggerDoc Object [Pair] Team Team
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"team" SchemaP NamedSwaggerDoc Value Value Team Team
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

instance ToJSON EventData where
  toJSON :: EventData -> Value
toJSON (EdTeamCreate Team
tem) = Team -> Value
forall a. ToJSON a => a -> Value
toJSON Team
tem
  toJSON EventData
EdTeamDelete = Value
Null
  toJSON (EdMemberJoin UserId
usr) = [Pair] -> Value
A.object [Key
"user" Key -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= UserId
usr]
  toJSON (EdMemberUpdate UserId
usr Maybe Permissions
mPerm) =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      Key
"user"
        Key -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= UserId
usr
        # "permissions"
        A..= mPerm
        # []
  toJSON (EdMemberLeave UserId
usr) = [Pair] -> Value
A.object [Key
"user" Key -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= UserId
usr]
  toJSON (EdConvCreate ConvId
cnv) = [Pair] -> Value
A.object [Key
"conv" Key -> ConvId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ConvId
cnv]
  toJSON (EdConvDelete ConvId
cnv) = [Pair] -> Value
A.object [Key
"conv" Key -> ConvId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ConvId
cnv]
  toJSON (EdTeamUpdate TeamUpdateData
upd) = TeamUpdateData -> Value
forall a. ToJSON a => a -> Value
toJSON TeamUpdateData
upd

eventDataType :: EventData -> EventType
eventDataType :: EventData -> EventType
eventDataType (EdTeamCreate Team
_) = EventType
TeamCreate
eventDataType EventData
EdTeamDelete = EventType
TeamDelete
eventDataType (EdTeamUpdate TeamUpdateData
_) = EventType
TeamUpdate
eventDataType (EdMemberJoin UserId
_) = EventType
MemberJoin
eventDataType (EdMemberLeave UserId
_) = EventType
MemberLeave
eventDataType (EdMemberUpdate UserId
_ Maybe Permissions
_) = EventType
MemberUpdate
eventDataType (EdConvCreate ConvId
_) = EventType
ConvCreate
eventDataType (EdConvDelete ConvId
_) = EventType
ConvDelete

parseEventData :: EventType -> Maybe Value -> Parser EventData
parseEventData :: EventType -> Maybe Value -> Parser EventData
parseEventData EventType
MemberJoin Maybe Value
Nothing = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing event data for type 'team.member-join'"
parseEventData EventType
MemberJoin (Just Value
j) = do
  let f :: Object -> Parser EventData
f Object
o = UserId -> EventData
EdMemberJoin (UserId -> EventData) -> Parser UserId -> Parser EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
  String -> (Object -> Parser EventData) -> Value -> Parser EventData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"member join data" Object -> Parser EventData
f Value
j
parseEventData EventType
MemberUpdate Maybe Value
Nothing = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing event data for type 'team.member-update"
parseEventData EventType
MemberUpdate (Just Value
j) = do
  let f :: Object -> Parser EventData
f Object
o = UserId -> Maybe Permissions -> EventData
EdMemberUpdate (UserId -> Maybe Permissions -> EventData)
-> Parser UserId -> Parser (Maybe Permissions -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user" Parser (Maybe Permissions -> EventData)
-> Parser (Maybe Permissions) -> Parser EventData
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Permissions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions"
  String -> (Object -> Parser EventData) -> Value -> Parser EventData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"member update data" Object -> Parser EventData
f Value
j
parseEventData EventType
MemberLeave Maybe Value
Nothing = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing event data for type 'team.member-leave'"
parseEventData EventType
MemberLeave (Just Value
j) = do
  let f :: Object -> Parser EventData
f Object
o = UserId -> EventData
EdMemberLeave (UserId -> EventData) -> Parser UserId -> Parser EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
  String -> (Object -> Parser EventData) -> Value -> Parser EventData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"member leave data" Object -> Parser EventData
f Value
j
parseEventData EventType
ConvCreate Maybe Value
Nothing = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing event data for type 'team.conversation-create"
parseEventData EventType
ConvCreate (Just Value
j) = do
  let f :: Object -> Parser EventData
f Object
o = ConvId -> EventData
EdConvCreate (ConvId -> EventData) -> Parser ConvId -> Parser EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ConvId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conv"
  String -> (Object -> Parser EventData) -> Value -> Parser EventData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"conversation create data" Object -> Parser EventData
f Value
j
parseEventData EventType
ConvDelete Maybe Value
Nothing = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing event data for type 'team.conversation-delete"
parseEventData EventType
ConvDelete (Just Value
j) = do
  let f :: Object -> Parser EventData
f Object
o = ConvId -> EventData
EdConvDelete (ConvId -> EventData) -> Parser ConvId -> Parser EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ConvId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conv"
  String -> (Object -> Parser EventData) -> Value -> Parser EventData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"conversation delete data" Object -> Parser EventData
f Value
j
parseEventData EventType
TeamCreate Maybe Value
Nothing = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing event data for type 'team.create'"
parseEventData EventType
TeamCreate (Just Value
j) = Team -> EventData
EdTeamCreate (Team -> EventData) -> Parser Team -> Parser EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Team
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j
parseEventData EventType
TeamUpdate Maybe Value
Nothing = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing event data for type 'team.update'"
parseEventData EventType
TeamUpdate (Just Value
j) = TeamUpdateData -> EventData
EdTeamUpdate (TeamUpdateData -> EventData)
-> Parser TeamUpdateData -> Parser EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TeamUpdateData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j
parseEventData EventType
_ Maybe Value
Nothing = EventData -> Parser EventData
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventData
EdTeamDelete
parseEventData EventType
t (Just Value
_) = String -> Parser EventData
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser EventData) -> String -> Parser EventData
forall a b. (a -> b) -> a -> b
$ String
"unexpected event data for type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EventType -> String
forall a. Show a => a -> String
show EventType
t

genEventData :: EventType -> QC.Gen EventData
genEventData :: EventType -> Gen EventData
genEventData = \case
  EventType
TeamCreate -> Team -> EventData
EdTeamCreate (Team -> EventData) -> Gen Team -> Gen EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Team
forall a. Arbitrary a => Gen a
arbitrary
  EventType
TeamDelete -> EventData -> Gen EventData
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventData
EdTeamDelete
  EventType
TeamUpdate -> TeamUpdateData -> EventData
EdTeamUpdate (TeamUpdateData -> EventData)
-> Gen TeamUpdateData -> Gen EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TeamUpdateData
forall a. Arbitrary a => Gen a
arbitrary
  EventType
MemberJoin -> UserId -> EventData
EdMemberJoin (UserId -> EventData) -> Gen UserId -> Gen EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UserId
forall a. Arbitrary a => Gen a
arbitrary
  EventType
MemberLeave -> UserId -> EventData
EdMemberLeave (UserId -> EventData) -> Gen UserId -> Gen EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UserId
forall a. Arbitrary a => Gen a
arbitrary
  EventType
MemberUpdate -> UserId -> Maybe Permissions -> EventData
EdMemberUpdate (UserId -> Maybe Permissions -> EventData)
-> Gen UserId -> Gen (Maybe Permissions -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UserId
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe Permissions -> EventData)
-> Gen (Maybe Permissions) -> Gen EventData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Permissions)
forall a. Arbitrary a => Gen a
arbitrary
  EventType
ConvCreate -> ConvId -> EventData
EdConvCreate (ConvId -> EventData) -> Gen ConvId -> Gen EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ConvId
forall a. Arbitrary a => Gen a
arbitrary
  EventType
ConvDelete -> ConvId -> EventData
EdConvDelete (ConvId -> EventData) -> Gen ConvId -> Gen EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ConvId
forall a. Arbitrary a => Gen a
arbitrary

makeLenses ''Event