{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Accounts.NotificationSettings where

import Hercules.API.Accounts.SimpleAccount (SimpleAccount)
import Hercules.API.Prelude
import Hercules.API.SourceHostingSite.SimpleSite (SimpleSite)

data NotificationLevel
  = Ignore
  | All
  deriving ((forall x. NotificationLevel -> Rep NotificationLevel x)
-> (forall x. Rep NotificationLevel x -> NotificationLevel)
-> Generic NotificationLevel
forall x. Rep NotificationLevel x -> NotificationLevel
forall x. NotificationLevel -> Rep NotificationLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotificationLevel x -> NotificationLevel
$cfrom :: forall x. NotificationLevel -> Rep NotificationLevel x
Generic, Int -> NotificationLevel -> ShowS
[NotificationLevel] -> ShowS
NotificationLevel -> String
(Int -> NotificationLevel -> ShowS)
-> (NotificationLevel -> String)
-> ([NotificationLevel] -> ShowS)
-> Show NotificationLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationLevel] -> ShowS
$cshowList :: [NotificationLevel] -> ShowS
show :: NotificationLevel -> String
$cshow :: NotificationLevel -> String
showsPrec :: Int -> NotificationLevel -> ShowS
$cshowsPrec :: Int -> NotificationLevel -> ShowS
Show, NotificationLevel -> NotificationLevel -> Bool
(NotificationLevel -> NotificationLevel -> Bool)
-> (NotificationLevel -> NotificationLevel -> Bool)
-> Eq NotificationLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationLevel -> NotificationLevel -> Bool
$c/= :: NotificationLevel -> NotificationLevel -> Bool
== :: NotificationLevel -> NotificationLevel -> Bool
$c== :: NotificationLevel -> NotificationLevel -> Bool
Eq, NotificationLevel -> ()
(NotificationLevel -> ()) -> NFData NotificationLevel
forall a. (a -> ()) -> NFData a
rnf :: NotificationLevel -> ()
$crnf :: NotificationLevel -> ()
NFData, [NotificationLevel] -> Encoding
[NotificationLevel] -> Value
NotificationLevel -> Encoding
NotificationLevel -> Value
(NotificationLevel -> Value)
-> (NotificationLevel -> Encoding)
-> ([NotificationLevel] -> Value)
-> ([NotificationLevel] -> Encoding)
-> ToJSON NotificationLevel
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NotificationLevel] -> Encoding
$ctoEncodingList :: [NotificationLevel] -> Encoding
toJSONList :: [NotificationLevel] -> Value
$ctoJSONList :: [NotificationLevel] -> Value
toEncoding :: NotificationLevel -> Encoding
$ctoEncoding :: NotificationLevel -> Encoding
toJSON :: NotificationLevel -> Value
$ctoJSON :: NotificationLevel -> Value
ToJSON, Value -> Parser [NotificationLevel]
Value -> Parser NotificationLevel
(Value -> Parser NotificationLevel)
-> (Value -> Parser [NotificationLevel])
-> FromJSON NotificationLevel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NotificationLevel]
$cparseJSONList :: Value -> Parser [NotificationLevel]
parseJSON :: Value -> Parser NotificationLevel
$cparseJSON :: Value -> Parser NotificationLevel
FromJSON, Proxy NotificationLevel -> Declare (Definitions Schema) NamedSchema
(Proxy NotificationLevel
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NotificationLevel
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy NotificationLevel -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy NotificationLevel -> Declare (Definitions Schema) NamedSchema
ToSchema)

data NotificationSetting = NotificationSetting
  { NotificationSetting -> Maybe NotificationLevel
notificationLevel :: Maybe NotificationLevel,
    NotificationSetting -> Maybe Text
notificationEmail :: Maybe Text
  }
  deriving ((forall x. NotificationSetting -> Rep NotificationSetting x)
-> (forall x. Rep NotificationSetting x -> NotificationSetting)
-> Generic NotificationSetting
forall x. Rep NotificationSetting x -> NotificationSetting
forall x. NotificationSetting -> Rep NotificationSetting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotificationSetting x -> NotificationSetting
$cfrom :: forall x. NotificationSetting -> Rep NotificationSetting x
Generic, Int -> NotificationSetting -> ShowS
[NotificationSetting] -> ShowS
NotificationSetting -> String
(Int -> NotificationSetting -> ShowS)
-> (NotificationSetting -> String)
-> ([NotificationSetting] -> ShowS)
-> Show NotificationSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationSetting] -> ShowS
$cshowList :: [NotificationSetting] -> ShowS
show :: NotificationSetting -> String
$cshow :: NotificationSetting -> String
showsPrec :: Int -> NotificationSetting -> ShowS
$cshowsPrec :: Int -> NotificationSetting -> ShowS
Show, NotificationSetting -> NotificationSetting -> Bool
(NotificationSetting -> NotificationSetting -> Bool)
-> (NotificationSetting -> NotificationSetting -> Bool)
-> Eq NotificationSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationSetting -> NotificationSetting -> Bool
$c/= :: NotificationSetting -> NotificationSetting -> Bool
== :: NotificationSetting -> NotificationSetting -> Bool
$c== :: NotificationSetting -> NotificationSetting -> Bool
Eq, NotificationSetting -> ()
(NotificationSetting -> ()) -> NFData NotificationSetting
forall a. (a -> ()) -> NFData a
rnf :: NotificationSetting -> ()
$crnf :: NotificationSetting -> ()
NFData, [NotificationSetting] -> Encoding
[NotificationSetting] -> Value
NotificationSetting -> Encoding
NotificationSetting -> Value
(NotificationSetting -> Value)
-> (NotificationSetting -> Encoding)
-> ([NotificationSetting] -> Value)
-> ([NotificationSetting] -> Encoding)
-> ToJSON NotificationSetting
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NotificationSetting] -> Encoding
$ctoEncodingList :: [NotificationSetting] -> Encoding
toJSONList :: [NotificationSetting] -> Value
$ctoJSONList :: [NotificationSetting] -> Value
toEncoding :: NotificationSetting -> Encoding
$ctoEncoding :: NotificationSetting -> Encoding
toJSON :: NotificationSetting -> Value
$ctoJSON :: NotificationSetting -> Value
ToJSON, Value -> Parser [NotificationSetting]
Value -> Parser NotificationSetting
(Value -> Parser NotificationSetting)
-> (Value -> Parser [NotificationSetting])
-> FromJSON NotificationSetting
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NotificationSetting]
$cparseJSONList :: Value -> Parser [NotificationSetting]
parseJSON :: Value -> Parser NotificationSetting
$cparseJSON :: Value -> Parser NotificationSetting
FromJSON, Proxy NotificationSetting
-> Declare (Definitions Schema) NamedSchema
(Proxy NotificationSetting
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NotificationSetting
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy NotificationSetting
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy NotificationSetting
-> Declare (Definitions Schema) NamedSchema
ToSchema)

data NotificationAccountOverride = NotificationSettingsOverride
  { NotificationAccountOverride -> SimpleAccount
account :: SimpleAccount,
    NotificationAccountOverride -> NotificationSetting
setting :: NotificationSetting
  }
  deriving ((forall x.
 NotificationAccountOverride -> Rep NotificationAccountOverride x)
-> (forall x.
    Rep NotificationAccountOverride x -> NotificationAccountOverride)
-> Generic NotificationAccountOverride
forall x.
Rep NotificationAccountOverride x -> NotificationAccountOverride
forall x.
NotificationAccountOverride -> Rep NotificationAccountOverride x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep NotificationAccountOverride x -> NotificationAccountOverride
$cfrom :: forall x.
NotificationAccountOverride -> Rep NotificationAccountOverride x
Generic, Int -> NotificationAccountOverride -> ShowS
[NotificationAccountOverride] -> ShowS
NotificationAccountOverride -> String
(Int -> NotificationAccountOverride -> ShowS)
-> (NotificationAccountOverride -> String)
-> ([NotificationAccountOverride] -> ShowS)
-> Show NotificationAccountOverride
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationAccountOverride] -> ShowS
$cshowList :: [NotificationAccountOverride] -> ShowS
show :: NotificationAccountOverride -> String
$cshow :: NotificationAccountOverride -> String
showsPrec :: Int -> NotificationAccountOverride -> ShowS
$cshowsPrec :: Int -> NotificationAccountOverride -> ShowS
Show, NotificationAccountOverride -> NotificationAccountOverride -> Bool
(NotificationAccountOverride
 -> NotificationAccountOverride -> Bool)
-> (NotificationAccountOverride
    -> NotificationAccountOverride -> Bool)
-> Eq NotificationAccountOverride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationAccountOverride -> NotificationAccountOverride -> Bool
$c/= :: NotificationAccountOverride -> NotificationAccountOverride -> Bool
== :: NotificationAccountOverride -> NotificationAccountOverride -> Bool
$c== :: NotificationAccountOverride -> NotificationAccountOverride -> Bool
Eq, NotificationAccountOverride -> ()
(NotificationAccountOverride -> ())
-> NFData NotificationAccountOverride
forall a. (a -> ()) -> NFData a
rnf :: NotificationAccountOverride -> ()
$crnf :: NotificationAccountOverride -> ()
NFData, [NotificationAccountOverride] -> Encoding
[NotificationAccountOverride] -> Value
NotificationAccountOverride -> Encoding
NotificationAccountOverride -> Value
(NotificationAccountOverride -> Value)
-> (NotificationAccountOverride -> Encoding)
-> ([NotificationAccountOverride] -> Value)
-> ([NotificationAccountOverride] -> Encoding)
-> ToJSON NotificationAccountOverride
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NotificationAccountOverride] -> Encoding
$ctoEncodingList :: [NotificationAccountOverride] -> Encoding
toJSONList :: [NotificationAccountOverride] -> Value
$ctoJSONList :: [NotificationAccountOverride] -> Value
toEncoding :: NotificationAccountOverride -> Encoding
$ctoEncoding :: NotificationAccountOverride -> Encoding
toJSON :: NotificationAccountOverride -> Value
$ctoJSON :: NotificationAccountOverride -> Value
ToJSON, Value -> Parser [NotificationAccountOverride]
Value -> Parser NotificationAccountOverride
(Value -> Parser NotificationAccountOverride)
-> (Value -> Parser [NotificationAccountOverride])
-> FromJSON NotificationAccountOverride
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NotificationAccountOverride]
$cparseJSONList :: Value -> Parser [NotificationAccountOverride]
parseJSON :: Value -> Parser NotificationAccountOverride
$cparseJSON :: Value -> Parser NotificationAccountOverride
FromJSON, Proxy NotificationAccountOverride
-> Declare (Definitions Schema) NamedSchema
(Proxy NotificationAccountOverride
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NotificationAccountOverride
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy NotificationAccountOverride
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy NotificationAccountOverride
-> Declare (Definitions Schema) NamedSchema
ToSchema)

data AuthorizedEmail = AuthorizedEmail
  { AuthorizedEmail -> Text
address :: Text,
    AuthorizedEmail -> Bool
isPrimary :: Bool,
    AuthorizedEmail -> Maybe SimpleSite
source :: Maybe SimpleSite
  }
  deriving ((forall x. AuthorizedEmail -> Rep AuthorizedEmail x)
-> (forall x. Rep AuthorizedEmail x -> AuthorizedEmail)
-> Generic AuthorizedEmail
forall x. Rep AuthorizedEmail x -> AuthorizedEmail
forall x. AuthorizedEmail -> Rep AuthorizedEmail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthorizedEmail x -> AuthorizedEmail
$cfrom :: forall x. AuthorizedEmail -> Rep AuthorizedEmail x
Generic, Int -> AuthorizedEmail -> ShowS
[AuthorizedEmail] -> ShowS
AuthorizedEmail -> String
(Int -> AuthorizedEmail -> ShowS)
-> (AuthorizedEmail -> String)
-> ([AuthorizedEmail] -> ShowS)
-> Show AuthorizedEmail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizedEmail] -> ShowS
$cshowList :: [AuthorizedEmail] -> ShowS
show :: AuthorizedEmail -> String
$cshow :: AuthorizedEmail -> String
showsPrec :: Int -> AuthorizedEmail -> ShowS
$cshowsPrec :: Int -> AuthorizedEmail -> ShowS
Show, AuthorizedEmail -> AuthorizedEmail -> Bool
(AuthorizedEmail -> AuthorizedEmail -> Bool)
-> (AuthorizedEmail -> AuthorizedEmail -> Bool)
-> Eq AuthorizedEmail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizedEmail -> AuthorizedEmail -> Bool
$c/= :: AuthorizedEmail -> AuthorizedEmail -> Bool
== :: AuthorizedEmail -> AuthorizedEmail -> Bool
$c== :: AuthorizedEmail -> AuthorizedEmail -> Bool
Eq, AuthorizedEmail -> ()
(AuthorizedEmail -> ()) -> NFData AuthorizedEmail
forall a. (a -> ()) -> NFData a
rnf :: AuthorizedEmail -> ()
$crnf :: AuthorizedEmail -> ()
NFData, [AuthorizedEmail] -> Encoding
[AuthorizedEmail] -> Value
AuthorizedEmail -> Encoding
AuthorizedEmail -> Value
(AuthorizedEmail -> Value)
-> (AuthorizedEmail -> Encoding)
-> ([AuthorizedEmail] -> Value)
-> ([AuthorizedEmail] -> Encoding)
-> ToJSON AuthorizedEmail
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AuthorizedEmail] -> Encoding
$ctoEncodingList :: [AuthorizedEmail] -> Encoding
toJSONList :: [AuthorizedEmail] -> Value
$ctoJSONList :: [AuthorizedEmail] -> Value
toEncoding :: AuthorizedEmail -> Encoding
$ctoEncoding :: AuthorizedEmail -> Encoding
toJSON :: AuthorizedEmail -> Value
$ctoJSON :: AuthorizedEmail -> Value
ToJSON, Value -> Parser [AuthorizedEmail]
Value -> Parser AuthorizedEmail
(Value -> Parser AuthorizedEmail)
-> (Value -> Parser [AuthorizedEmail]) -> FromJSON AuthorizedEmail
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AuthorizedEmail]
$cparseJSONList :: Value -> Parser [AuthorizedEmail]
parseJSON :: Value -> Parser AuthorizedEmail
$cparseJSON :: Value -> Parser AuthorizedEmail
FromJSON, Proxy AuthorizedEmail -> Declare (Definitions Schema) NamedSchema
(Proxy AuthorizedEmail -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AuthorizedEmail
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy AuthorizedEmail -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy AuthorizedEmail -> Declare (Definitions Schema) NamedSchema
ToSchema)

data NotificationSettings = NotificationSettings
  { NotificationSettings -> [AuthorizedEmail]
authorizedEmails :: [AuthorizedEmail],
    NotificationSettings -> Maybe NotificationSetting
defaultSetting :: Maybe NotificationSetting,
    NotificationSettings -> [NotificationAccountOverride]
accountOverrides :: [NotificationAccountOverride]
  }
  deriving ((forall x. NotificationSettings -> Rep NotificationSettings x)
-> (forall x. Rep NotificationSettings x -> NotificationSettings)
-> Generic NotificationSettings
forall x. Rep NotificationSettings x -> NotificationSettings
forall x. NotificationSettings -> Rep NotificationSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotificationSettings x -> NotificationSettings
$cfrom :: forall x. NotificationSettings -> Rep NotificationSettings x
Generic, Int -> NotificationSettings -> ShowS
[NotificationSettings] -> ShowS
NotificationSettings -> String
(Int -> NotificationSettings -> ShowS)
-> (NotificationSettings -> String)
-> ([NotificationSettings] -> ShowS)
-> Show NotificationSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationSettings] -> ShowS
$cshowList :: [NotificationSettings] -> ShowS
show :: NotificationSettings -> String
$cshow :: NotificationSettings -> String
showsPrec :: Int -> NotificationSettings -> ShowS
$cshowsPrec :: Int -> NotificationSettings -> ShowS
Show, NotificationSettings -> NotificationSettings -> Bool
(NotificationSettings -> NotificationSettings -> Bool)
-> (NotificationSettings -> NotificationSettings -> Bool)
-> Eq NotificationSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationSettings -> NotificationSettings -> Bool
$c/= :: NotificationSettings -> NotificationSettings -> Bool
== :: NotificationSettings -> NotificationSettings -> Bool
$c== :: NotificationSettings -> NotificationSettings -> Bool
Eq, NotificationSettings -> ()
(NotificationSettings -> ()) -> NFData NotificationSettings
forall a. (a -> ()) -> NFData a
rnf :: NotificationSettings -> ()
$crnf :: NotificationSettings -> ()
NFData, [NotificationSettings] -> Encoding
[NotificationSettings] -> Value
NotificationSettings -> Encoding
NotificationSettings -> Value
(NotificationSettings -> Value)
-> (NotificationSettings -> Encoding)
-> ([NotificationSettings] -> Value)
-> ([NotificationSettings] -> Encoding)
-> ToJSON NotificationSettings
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NotificationSettings] -> Encoding
$ctoEncodingList :: [NotificationSettings] -> Encoding
toJSONList :: [NotificationSettings] -> Value
$ctoJSONList :: [NotificationSettings] -> Value
toEncoding :: NotificationSettings -> Encoding
$ctoEncoding :: NotificationSettings -> Encoding
toJSON :: NotificationSettings -> Value
$ctoJSON :: NotificationSettings -> Value
ToJSON, Value -> Parser [NotificationSettings]
Value -> Parser NotificationSettings
(Value -> Parser NotificationSettings)
-> (Value -> Parser [NotificationSettings])
-> FromJSON NotificationSettings
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NotificationSettings]
$cparseJSONList :: Value -> Parser [NotificationSettings]
parseJSON :: Value -> Parser NotificationSettings
$cparseJSON :: Value -> Parser NotificationSettings
FromJSON, Proxy NotificationSettings
-> Declare (Definitions Schema) NamedSchema
(Proxy NotificationSettings
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NotificationSettings
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy NotificationSettings
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy NotificationSettings
-> Declare (Definitions Schema) NamedSchema
ToSchema)