{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Accounts.Account where

import qualified Hercules.API.Organizations.Organization as Organization
import Hercules.API.Prelude
import Hercules.API.SourceHostingSite.SourceHostingSite (SourceHostingSite)

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

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

data Account = Account
  { Account -> Id Account
id :: Id Account,
    Account -> Text
sourceHostingSiteSlug :: Text,
    Account -> Text
slug :: Text,
    Account -> AccountType
typ :: AccountType,
    Account -> Text
displayName :: Text,
    Account -> Text
imageURL :: Text,
    Account -> Maybe Organization
organization :: Maybe Organization.Organization,
    -- | Whether Hercules CI is installed on this account as an App.
    --
    -- An account that does not have an installation can not be
    -- properly accessed by Hercules, but may be visible nonetheless
    -- at times because of OAuth scopes.
    --
    -- As an example, non-installed accounts show up when a GitHub
    -- user signs in for the first time via OAuth, until they decide
    -- to install it on their GitHub user. Another example is GitHub
    -- organizations that don't have an installation yet.
    Account -> Bool
isInstalled :: Bool,
    -- | Whether the current user has permission in the to installing
    -- Hercules CI on this account.
    Account -> Bool
isInstallable :: Bool,
    Account -> Maybe MembershipRole
membershipRole :: Maybe MembershipRole,
    Account -> Maybe (Map Text SourceHostingSite)
sourceHostingSites :: Maybe (Map Text SourceHostingSite),
    Account -> Maybe Text
manageInstallationURL :: Maybe Text,
    Account -> Maybe Bool
installationIsSelection :: Maybe Bool
  }
  deriving ((forall x. Account -> Rep Account x)
-> (forall x. Rep Account x -> Account) -> Generic Account
forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
Generic, Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
(Int -> Account -> ShowS)
-> (Account -> String) -> ([Account] -> ShowS) -> Show Account
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show, Account -> Account -> Bool
(Account -> Account -> Bool)
-> (Account -> Account -> Bool) -> Eq Account
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Account -> Account -> Bool
$c/= :: Account -> Account -> Bool
== :: Account -> Account -> Bool
$c== :: Account -> Account -> Bool
Eq, Account -> ()
(Account -> ()) -> NFData Account
forall a. (a -> ()) -> NFData a
rnf :: Account -> ()
$crnf :: Account -> ()
NFData, [Account] -> Encoding
[Account] -> Value
Account -> Encoding
Account -> Value
(Account -> Value)
-> (Account -> Encoding)
-> ([Account] -> Value)
-> ([Account] -> Encoding)
-> ToJSON Account
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Account] -> Encoding
$ctoEncodingList :: [Account] -> Encoding
toJSONList :: [Account] -> Value
$ctoJSONList :: [Account] -> Value
toEncoding :: Account -> Encoding
$ctoEncoding :: Account -> Encoding
toJSON :: Account -> Value
$ctoJSON :: Account -> Value
ToJSON, Value -> Parser [Account]
Value -> Parser Account
(Value -> Parser Account)
-> (Value -> Parser [Account]) -> FromJSON Account
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Account]
$cparseJSONList :: Value -> Parser [Account]
parseJSON :: Value -> Parser Account
$cparseJSON :: Value -> Parser Account
FromJSON, Proxy Account -> Declare (Definitions Schema) NamedSchema
(Proxy Account -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Account
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy Account -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy Account -> Declare (Definitions Schema) NamedSchema
ToSchema)