{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Hercules.API.Accounts where

import Hercules.API.Accounts.Account (Account)
import Hercules.API.Accounts.AccountInstallationStatus (AccountInstallationStatus)
import Hercules.API.Accounts.AccountSettings (AccountSettings)
import Hercules.API.Accounts.AccountSettingsPatch (AccountSettingsPatch)
import Hercules.API.Accounts.CLIAuthorizationRequest (CLIAuthorizationRequest)
import Hercules.API.Accounts.CLIAuthorizationRequestCreate (CLIAuthorizationRequestCreate)
import Hercules.API.Accounts.CLIAuthorizationRequestCreateResponse (CLIAuthorizationRequestCreateResponse)
import Hercules.API.Accounts.CLIAuthorizationRequestStatus (CLIAuthorizationRequestStatus)
import Hercules.API.Accounts.CLITokensResponse (CLITokensResponse)
import Hercules.API.Accounts.NotificationSettings (NotificationSettings)
import Hercules.API.Accounts.NotificationSettingsPatch (NotificationSettingsPatch)
import Hercules.API.Prelude hiding (id)
import Hercules.API.SourceHostingSite.SourceHostingSite
  ( SourceHostingSite,
  )
import Servant.API
import Servant.API.Generic
import Servant.Auth ()

data AccountResourceGroup auth f = AccountResourceGroup
  { forall auth f.
AccountResourceGroup auth f
-> f
   :- (Summary "Get the account." :> (auth :> Get '[JSON] Account))
get ::
      f :- Summary ("Get the account.")
        :> auth
        :> Get '[JSON] Account,
    forall auth f.
AccountResourceGroup auth f
-> f
   :- (Summary "Get the account settings."
       :> ("settings" :> (auth :> Get '[JSON] AccountSettings)))
getSettings ::
      f :- Summary ("Get the account settings.")
        :> "settings"
        :> auth
        :> Get '[JSON] AccountSettings,
    forall auth f.
AccountResourceGroup auth f
-> f
   :- (Summary "Update the account settings."
       :> ("settings"
           :> (ReqBody '[JSON] AccountSettingsPatch
               :> (auth :> Patch '[JSON] AccountSettings))))
patchSettings ::
      f :- Summary ("Update the account settings.")
        :> "settings"
        :> ReqBody '[JSON] AccountSettingsPatch
        :> auth
        :> Patch '[JSON] AccountSettings,
    forall auth f.
AccountResourceGroup auth f
-> f
   :- (Summary "Disable all projects in the account."
       :> ("disable-all-projects" :> (auth :> Post '[JSON] Int)))
postDisableAllProjects ::
      f :- Summary ("Disable all projects in the account.")
        :> "disable-all-projects"
        :> auth
        :> Post '[JSON] Int
  }
  deriving ((forall x.
 AccountResourceGroup auth f -> Rep (AccountResourceGroup auth f) x)
-> (forall x.
    Rep (AccountResourceGroup auth f) x -> AccountResourceGroup auth f)
-> Generic (AccountResourceGroup auth f)
forall x.
Rep (AccountResourceGroup auth f) x -> AccountResourceGroup auth f
forall x.
AccountResourceGroup auth f -> Rep (AccountResourceGroup auth f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x.
Rep (AccountResourceGroup auth f) x -> AccountResourceGroup auth f
forall auth f x.
AccountResourceGroup auth f -> Rep (AccountResourceGroup auth f) x
$cto :: forall auth f x.
Rep (AccountResourceGroup auth f) x -> AccountResourceGroup auth f
$cfrom :: forall auth f x.
AccountResourceGroup auth f -> Rep (AccountResourceGroup auth f) x
Generic)

accountById' :: t -> AccountsAPI auth f -> subapi auth f
accountById' t
id AccountsAPI auth f
client = AccountsAPI auth f
client AccountsAPI auth f
-> (AccountsAPI auth f -> GToServant (Rep (subapi auth f)))
-> subapi auth f
forall {k} (subapi :: k -> * -> *) (api :: k -> * -> *) mode
       (a :: k).
(GenericServant (api a) mode, GenericServant (subapi a) mode) =>
api a mode
-> (api a mode -> ToServant (subapi a) mode) -> subapi a mode
`enterApiE` \AccountsAPI auth f
api -> AccountsAPI auth f
-> f
   :- Substitute
        ("accounts"
         :> (Capture' '[] "accountId" (Id Account) :> Placeholder))
        (ToServantApi (AccountResourceGroup auth))
forall auth f.
AccountsAPI auth f
-> f
   :- Substitute
        ("accounts"
         :> (Capture' '[] "accountId" (Id Account) :> Placeholder))
        (ToServantApi (AccountResourceGroup auth))
accountById AccountsAPI auth f
api t
id

accountByAuth' :: AccountsAPI a mode -> subapi a mode
accountByAuth' AccountsAPI a mode
client = AccountsAPI a mode
client AccountsAPI a mode
-> (AccountsAPI a mode -> GToServant (Rep (subapi a mode)))
-> subapi a mode
forall {k} (subapi :: k -> * -> *) (api :: k -> * -> *) mode
       (a :: k).
(GenericServant (api a) mode, GenericServant (subapi a) mode) =>
api a mode
-> (api a mode -> ToServant (subapi a) mode) -> subapi a mode
`enterApiE` AccountsAPI a mode -> GToServant (Rep (subapi a mode))
forall auth f.
AccountsAPI auth f
-> f
   :- Substitute
        ("accounts" :> ("me" :> Placeholder))
        (ToServantApi (AccountResourceGroup auth))
accountByAuth

data AccountsAPI auth f = AccountsAPI
  { forall auth f.
AccountsAPI auth f
-> f
   :- Substitute
        ("accounts" :> ("me" :> Placeholder))
        (ToServantApi (AccountResourceGroup auth))
accountByAuth ::
      f
        :- Substitute ("accounts" :> "me" :> Placeholder) (ToServantApi (AccountResourceGroup auth)),
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary "Retrieve notification settings"
       :> ("accounts"
           :> ("me"
               :> ("settings"
                   :> ("notifications"
                       :> (auth :> Get '[JSON] NotificationSettings))))))
accountByAuthGetNotificationSettings ::
      f
        :- Summary "Retrieve notification settings"
        :> "accounts"
        :> "me"
        :> "settings"
        :> "notifications"
        :> auth
        :> Get '[JSON] NotificationSettings,
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary "Update notification settings"
       :> ("accounts"
           :> ("me"
               :> ("settings"
                   :> ("notifications"
                       :> (ReqBody '[JSON] NotificationSettingsPatch
                           :> (auth :> Patch '[JSON] NotificationSettings)))))))
accountByAuthPatchNotificationSettings ::
      f
        :- Summary "Update notification settings"
        :> "accounts"
        :> "me"
        :> "settings"
        :> "notifications"
        :> ReqBody '[JSON] NotificationSettingsPatch
        :> auth
        :> Patch '[JSON] NotificationSettings,
    forall auth f.
AccountsAPI auth f
-> f
   :- Substitute
        ("accounts"
         :> (Capture' '[] "accountId" (Id Account) :> Placeholder))
        (ToServantApi (AccountResourceGroup auth))
accountById ::
      f
        :- Substitute
             ("accounts" :> Capture "accountId" (Id Account) :> Placeholder)
             (ToServantApi (AccountResourceGroup auth)),
    forall auth f.
AccountsAPI auth f
-> f
   :- Substitute
        ("site"
         :> (Capture' '[] "site" (Name SourceHostingSite)
             :> ("account"
                 :> (Capture' '[] "account" (Name Account) :> Placeholder))))
        (ToServantApi (AccountResourceGroup auth))
accountByName ::
      f
        :- Substitute
             ( "site"
                 :> Capture "site" (Name SourceHostingSite)
                 :> "account"
                 :> Capture "account" (Name Account)
                 :> Placeholder
             )
             (ToServantApi (AccountResourceGroup auth)),
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary
         "Accounts that the authenticated user owns, admins or collaborates with."
       :> ("accounts"
           :> (QueryParam "site" (Name SourceHostingSite)
               :> (QueryParam "name" (Name Account)
                   :> (auth :> Get '[JSON] [Account])))))
findAccounts ::
      f :- Summary "Accounts that the authenticated user owns, admins or collaborates with."
        :> "accounts"
        :> QueryParam "site" (Name SourceHostingSite)
        :> QueryParam "name" (Name Account)
        :> auth
        :> Get '[JSON] [Account],
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary "Create a request to authorize the CLI."
       :> ("auth"
           :> ("cli"
               :> ("authorization"
                   :> ("request"
                       :> (ReqBody '[JSON] CLIAuthorizationRequestCreate
                           :> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
postCLIAuthorizationRequest ::
      f :- Summary "Create a request to authorize the CLI."
        :> "auth"
        :> "cli"
        :> "authorization"
        :> "request"
        :> ReqBody '[JSON] CLIAuthorizationRequestCreate
        :> Post '[JSON] CLIAuthorizationRequestCreateResponse,
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary "Check the request status"
       :> ("auth"
           :> ("cli"
               :> ("authorization"
                   :> ("request"
                       :> ("status"
                           :> (Capture "temporaryToken" Text
                               :> Get '[JSON] CLIAuthorizationRequestStatus)))))))
getCLIAuthorizationRequestStatus ::
      f :- Summary "Check the request status"
        :> "auth"
        :> "cli"
        :> "authorization"
        :> "request"
        :> "status"
        :> Capture "temporaryToken" Text
        :> Get '[JSON] CLIAuthorizationRequestStatus,
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary "Retrieve the request"
       :> ("auth"
           :> ("cli"
               :> ("authorization"
                   :> ("request"
                       :> (Capture "browserToken" Text
                           :> (auth :> Get '[JSON] CLIAuthorizationRequest)))))))
getCLIAuthorizationRequest ::
      f :- Summary "Retrieve the request"
        :> "auth"
        :> "cli"
        :> "authorization"
        :> "request"
        :> Capture "browserToken" Text
        :> auth
        :> Get '[JSON] CLIAuthorizationRequest,
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary "Retrieve the request"
       :> ("auth"
           :> ("cli"
               :> ("authorization"
                   :> ("request"
                       :> (Capture "browserToken" Text
                           :> ("confirm" :> (auth :> Post '[JSON] NoContent))))))))
confirmCLIAuthorizationRequest ::
      f :- Summary "Retrieve the request"
        :> "auth"
        :> "cli"
        :> "authorization"
        :> "request"
        :> Capture "browserToken" Text
        :> "confirm"
        :> auth
        :> Post '[JSON] NoContent,
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary
         "List the CLI tokens associated with the current account."
       :> ("auth"
           :> ("cli"
               :> ("tokens" :> (auth :> Get '[JSON] CLITokensResponse)))))
getCLITokens ::
      f :- Summary "List the CLI tokens associated with the current account."
        :> "auth"
        :> "cli"
        :> "tokens"
        :> auth
        :> Get '[JSON] CLITokensResponse,
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary "Permanently disallow the use of a CLI token."
       :> ("auth"
           :> ("cli"
               :> ("tokens"
                   :> (Capture "cliTokenId" (Id "CLIToken")
                       :> ("revoke" :> (auth :> Post '[JSON] NoContent)))))))
revokeCLIToken ::
      f :- Summary "Permanently disallow the use of a CLI token."
        :> "auth"
        :> "cli"
        :> "tokens"
        :> Capture "cliTokenId" (Id "CLIToken")
        :> "revoke"
        :> auth
        :> Post '[JSON] NoContent,
    forall auth f.
AccountsAPI auth f
-> f
   :- (Summary
         "Retrieve installation status after redirect from external source site settings."
       :> ("sites"
           :> (Capture "siteId" (Id SourceHostingSite)
               :> ("installation"
                   :> (Capture "installationId" Int
                       :> ("status"
                           :> (auth :> Get '[JSON] AccountInstallationStatus)))))))
installationStatus ::
      f :- Summary "Retrieve installation status after redirect from external source site settings."
        :> "sites"
        :> Capture "siteId" (Id SourceHostingSite)
        :> "installation"
        :> Capture "installationId" Int
        :> "status"
        :> auth
        :> Get '[JSON] AccountInstallationStatus
  }
  deriving ((forall x. AccountsAPI auth f -> Rep (AccountsAPI auth f) x)
-> (forall x. Rep (AccountsAPI auth f) x -> AccountsAPI auth f)
-> Generic (AccountsAPI auth f)
forall x. Rep (AccountsAPI auth f) x -> AccountsAPI auth f
forall x. AccountsAPI auth f -> Rep (AccountsAPI auth f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x. Rep (AccountsAPI auth f) x -> AccountsAPI auth f
forall auth f x. AccountsAPI auth f -> Rep (AccountsAPI auth f) x
$cto :: forall auth f x. Rep (AccountsAPI auth f) x -> AccountsAPI auth f
$cfrom :: forall auth f x. AccountsAPI auth f -> Rep (AccountsAPI auth f) x
Generic)