{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -O0 #-}
module Hercules.API
( api,
servantApi,
servantClientApi,
swagger,
useApi,
enterApiE,
API,
ClientAuth,
HerculesAPI (..),
ClientAPI (..),
HerculesServantAPI,
AddAPIVersion,
Id,
Name,
Result (..),
NoContent (..),
noContent,
openapi3,
)
where
import Control.Lens
import Control.Monad
import Data.List qualified as L
import Data.OpenApi qualified as O3
import Data.Proxy (Proxy (..))
import Data.Swagger hiding (Header)
import Hercules.API.Accounts (AccountsAPI)
import Hercules.API.Agents (AgentsAPI)
import Hercules.API.Build as Client
( BuildAPI,
)
import Hercules.API.ClientInfo (ClientInfoAPI)
import Hercules.API.Effects (EffectsAPI)
import Hercules.API.Forge (ForgeAPI)
import Hercules.API.GitLab (GitLabAPI)
import Hercules.API.Health (HealthAPI)
import Hercules.API.Organizations (OrganizationsAPI)
import Hercules.API.Orphans ()
import Hercules.API.Prelude
import Hercules.API.Projects (ProjectsAPI)
import Hercules.API.Repos (ReposAPI)
import Hercules.API.Result (Result (..))
import Hercules.API.Servant (useApi)
import Hercules.API.State (StateAPI)
import Servant.API
import Servant.Auth
import Servant.Auth.Swagger ()
import Servant.OpenApi qualified as SO3
import Servant.Swagger
import Servant.Swagger.UI.Core (SwaggerSchemaUI)
data HerculesAPI auth f = HerculesAPI
{ forall auth f.
HerculesAPI auth f -> f :- ToServantApi (AccountsAPI auth)
accounts :: f :- ToServantApi (AccountsAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (ClientInfoAPI auth)
clientInfo :: f :- ToServantApi (ClientInfoAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (ForgeAPI auth)
forges :: f :- ToServantApi (ForgeAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (ReposAPI auth)
repos :: f :- ToServantApi (ReposAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (ProjectsAPI auth)
projects :: f :- ToServantApi (ProjectsAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (AgentsAPI auth)
agents :: f :- ToServantApi (AgentsAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (BuildAPI auth)
build :: f :- ToServantApi (Client.BuildAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (EffectsAPI auth)
effects :: f :- ToServantApi (EffectsAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (HealthAPI auth)
health :: f :- ToServantApi (HealthAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (OrganizationsAPI auth)
organizations :: f :- ToServantApi (OrganizationsAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (StateAPI auth)
state :: f :- ToServantApi (StateAPI auth),
forall auth f.
HerculesAPI auth f -> f :- ToServantApi (GitLabAPI auth)
gitlab :: f :- ToServantApi (GitLabAPI auth)
}
deriving ((forall x. HerculesAPI auth f -> Rep (HerculesAPI auth f) x)
-> (forall x. Rep (HerculesAPI auth f) x -> HerculesAPI auth f)
-> Generic (HerculesAPI auth f)
forall x. Rep (HerculesAPI auth f) x -> HerculesAPI auth f
forall x. HerculesAPI auth f -> Rep (HerculesAPI auth f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x. Rep (HerculesAPI auth f) x -> HerculesAPI auth f
forall auth f x. HerculesAPI auth f -> Rep (HerculesAPI auth f) x
$cfrom :: forall auth f x. HerculesAPI auth f -> Rep (HerculesAPI auth f) x
from :: forall x. HerculesAPI auth f -> Rep (HerculesAPI auth f) x
$cto :: forall auth f x. Rep (HerculesAPI auth f) x -> HerculesAPI auth f
to :: forall x. Rep (HerculesAPI auth f) x -> HerculesAPI auth f
Generic)
data ClientAPI auth f = ClientAPI
{ forall auth f.
ClientAPI auth f -> f :- ToServantApi (AccountsAPI auth)
clientAccounts :: f :- ToServantApi (AccountsAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ClientInfoAPI auth)
clientClientInfo :: f :- ToServantApi (ClientInfoAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ForgeAPI auth)
clientForges :: f :- ToServantApi (ForgeAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ReposAPI auth)
clientRepos :: f :- ToServantApi (ReposAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ProjectsAPI auth)
clientProjects :: f :- ToServantApi (ProjectsAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (AgentsAPI auth)
clientAgents :: f :- ToServantApi (AgentsAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (BuildAPI auth)
clientBuild :: f :- ToServantApi (Client.BuildAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (EffectsAPI auth)
clientEffects :: f :- ToServantApi (EffectsAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (OrganizationsAPI auth)
clientOrganizations :: f :- ToServantApi (OrganizationsAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (StateAPI auth)
clientState :: f :- ToServantApi (StateAPI auth),
forall auth f.
ClientAPI auth f -> f :- ToServantApi (GitLabAPI auth)
clientGitLab :: f :- ToServantApi (GitLabAPI auth)
}
deriving ((forall x. ClientAPI auth f -> Rep (ClientAPI auth f) x)
-> (forall x. Rep (ClientAPI auth f) x -> ClientAPI auth f)
-> Generic (ClientAPI auth f)
forall x. Rep (ClientAPI auth f) x -> ClientAPI auth f
forall x. ClientAPI auth f -> Rep (ClientAPI auth f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x. Rep (ClientAPI auth f) x -> ClientAPI auth f
forall auth f x. ClientAPI auth f -> Rep (ClientAPI auth f) x
$cfrom :: forall auth f x. ClientAPI auth f -> Rep (ClientAPI auth f) x
from :: forall x. ClientAPI auth f -> Rep (ClientAPI auth f) x
$cto :: forall auth f x. Rep (ClientAPI auth f) x -> ClientAPI auth f
to :: forall x. Rep (ClientAPI auth f) x -> ClientAPI auth f
Generic)
type ClientAuth = Auth '[JWT, Cookie] ()
type HerculesServantAPI auth = AddAPIVersion (ToServantApi (HerculesAPI auth))
type ClientServantAPI auth = AddAPIVersion (ToServantApi (ClientAPI auth))
type AddAPIVersion api = "api" :> "v1" :> api
servantApi :: Proxy (HerculesServantAPI auth)
servantApi :: forall auth. Proxy (HerculesServantAPI auth)
servantApi = Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account." :> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects" :> (auth :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (auth :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (auth :> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account." :> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects" :> (auth :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (auth :> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (auth :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (auth
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm" :> (auth :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens" :> (auth :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke" :> (auth :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (auth
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> (("client" :> ("info" :> (auth :> Get '[JSON] ClientInfo)))
:<|> (("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge." :> (auth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (auth :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge." :> (auth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (auth :> Delete '[JSON] NoContent))))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (auth :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (auth :> Get '[JSON] RepoKey)))))
:<|> (((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project" :> (auth :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (auth
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (auth
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (auth :> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (auth
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (auth
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects" :> (auth :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam' '[Optional] "project" (Name Project)
:> (auth :> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (auth
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (auth :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (auth
:> ("create-user-effect-token"
:> Post '[JSON] CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (auth
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (auth :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (auth :> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (auth
:> GetJsonWithPreflight EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (auth
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed" :> (auth :> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (auth :> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (auth :> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (auth
:> Post '[JSON] NoContent))))))
:<|> (Summary "Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (auth
:> Get
'[JSON]
Log))))))))))))))
:<|> (((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (auth :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (auth :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (auth :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (auth :> Get '[JSON] [AgentSession]))))))))))
:<|> (((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry" :> (auth :> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (auth :> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (auth :> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (auth :> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict] "via-job" (Id Job)
:> (auth
:> Get '[JSON] DerivationInfo)))))))))))
:<|> (((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (auth :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (auth :> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (auth :> Post '[JSON] NoContent)))))))))
:<|> ((Summary "Health check for the database"
:> ("health" :> ("db" :> Get '[JSON] NoContent)))
:<|> ((Summary "Health check for the queue"
:> ("health" :> ("queue" :> Get '[JSON] NoContent)))
:<|> (Summary "Health check for the github"
:> ("health" :> ("github" :> Get '[JSON] NoContent)))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (auth
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (auth
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (auth :> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states" :> (auth :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (auth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (auth
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (auth
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (auth
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (auth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (auth
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (auth :> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (auth :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (auth :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (auth :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth :> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth :> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (auth :> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (auth
:> Post
'[JSON] NoContent)))))))))))))
Proxy (HerculesServantAPI auth)
forall {k} (t :: k). Proxy t
Proxy
servantClientApi :: Proxy (ClientServantAPI auth)
servantClientApi :: forall auth. Proxy (ClientServantAPI auth)
servantClientApi = Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account." :> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects" :> (auth :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (auth :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (auth :> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account." :> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects" :> (auth :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (auth :> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (auth :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (auth
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm" :> (auth :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens" :> (auth :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke" :> (auth :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (auth
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client" :> ("info" :> (auth :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge." :> (auth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (auth :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge." :> (auth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (auth :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (auth :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (auth :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project" :> (auth :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (auth
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (auth
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (auth :> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (auth
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (auth
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects" :> (auth :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (auth :> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (auth
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (auth :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (auth
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (auth
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (auth :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (auth :> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (auth
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (auth
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (auth :> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (auth :> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (auth
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (auth
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (auth
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (auth :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (auth :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (auth :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions" :> (auth :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (auth :> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (auth
:> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (auth
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (auth
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (auth
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (auth :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (auth
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (auth
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (auth
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (auth
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (auth :> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states" :> (auth :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (auth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (auth
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (auth
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (auth
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (auth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (auth
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (auth :> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (auth :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (auth :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (auth :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth :> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth :> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (auth :> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (auth
:> Post
'[JSON] NoContent)))))))))))))
Proxy (ClientServantAPI auth)
forall {k} (t :: k). Proxy t
Proxy
type API auth =
HerculesServantAPI auth
:<|> "api"
:> SwaggerSchemaUI "v1" "swagger.json"
api :: Proxy (API auth)
api :: forall auth. Proxy (API auth)
api = Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account." :> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects" :> (auth :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (auth :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (auth :> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account." :> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects" :> (auth :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (auth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (auth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (auth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (auth :> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (auth :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (auth
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm" :> (auth :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens" :> (auth :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke" :> (auth :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (auth
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> (("client" :> ("info" :> (auth :> Get '[JSON] ClientInfo)))
:<|> (("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge." :> (auth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (auth :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge." :> (auth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (auth :> Delete '[JSON] NoContent))))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (auth :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (auth :> Get '[JSON] RepoKey)))))
:<|> (((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project" :> (auth :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (auth
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (auth
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (auth :> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (auth
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (auth
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects" :> (auth :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam' '[Optional] "project" (Name Project)
:> (auth :> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (auth
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (auth :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (auth
:> ("create-user-effect-token"
:> Post '[JSON] CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (auth
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (auth :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (auth :> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (auth
:> GetJsonWithPreflight EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (auth
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed" :> (auth :> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (auth :> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (auth :> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (auth
:> Post '[JSON] NoContent))))))
:<|> (Summary "Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (auth
:> Get
'[JSON]
Log))))))))))))))
:<|> (((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (auth :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (auth :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (auth :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (auth :> Get '[JSON] [AgentSession]))))))))))
:<|> (((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry" :> (auth :> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (auth :> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (auth :> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (auth :> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict] "via-job" (Id Job)
:> (auth
:> Get '[JSON] DerivationInfo)))))))))))
:<|> (((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (auth :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (auth :> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (auth :> Post '[JSON] NoContent)))))))))
:<|> ((Summary "Health check for the database"
:> ("health" :> ("db" :> Get '[JSON] NoContent)))
:<|> ((Summary "Health check for the queue"
:> ("health" :> ("queue" :> Get '[JSON] NoContent)))
:<|> (Summary "Health check for the github"
:> ("health" :> ("github" :> Get '[JSON] NoContent)))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (auth
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (auth
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (auth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (auth :> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states" :> (auth :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (auth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (auth
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (auth
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (auth
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (auth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (auth
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (auth :> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (auth :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (auth :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (auth :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth :> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (auth :> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (auth :> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (auth
:> Post
'[JSON] NoContent))))))))))))
:<|> ("api" :> SwaggerSchemaUI "v1" "swagger.json"))
Proxy (API auth)
forall {k} (t :: k). Proxy t
Proxy
swagger :: Swagger
swagger :: Swagger
swagger =
Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] () :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent)))))))))))))
-> Swagger
forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] () :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent)))))))))))))
Proxy (ClientServantAPI (Auth '[JWT] ()))
apiWithJWT
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Info -> Identity Info) -> Swagger -> Identity Swagger
forall s a. HasInfo s a => Lens' s a
Lens' Swagger Info
info
((Info -> Identity Info) -> Swagger -> Identity Swagger)
-> ((Text -> Identity Text) -> Info -> Identity Info)
-> (Text -> Identity Text)
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> Info -> Identity Info
forall s a. HasTitle s a => Lens' s a
Lens' Info Text
title
((Text -> Identity Text) -> Swagger -> Identity Swagger)
-> Text -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"Hercules CI API"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Info -> Identity Info) -> Swagger -> Identity Swagger
forall s a. HasInfo s a => Lens' s a
Lens' Swagger Info
info
((Info -> Identity Info) -> Swagger -> Identity Swagger)
-> ((Text -> Identity Text) -> Info -> Identity Info)
-> (Text -> Identity Text)
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> Info -> Identity Info
forall s a. HasVersion s a => Lens' s a
Lens' Info Text
version
((Text -> Identity Text) -> Swagger -> Identity Swagger)
-> Text -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"v1"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Info -> Identity Info) -> Swagger -> Identity Swagger
forall s a. HasInfo s a => Lens' s a
Lens' Swagger Info
info
((Info -> Identity Info) -> Swagger -> Identity Swagger)
-> ((Maybe Text -> Identity (Maybe Text)) -> Info -> Identity Info)
-> (Maybe Text -> Identity (Maybe Text))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Info -> Identity Info
forall s a. HasDescription s a => Lens' s a
Lens' Info (Maybe Text)
description
((Maybe Text -> Identity (Maybe Text))
-> Swagger -> Identity Swagger)
-> Text -> Swagger -> Swagger
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"You have reached the Hercules Continuous Integration Application Programming Interface. This user interface provides human friendly access to the various endpoints. To get a personal access token, use the `hci login` command and inspect `~/.config/hercules-ci/credentials.json`. Unquote the token and put it in a header as `Authorization: Bearer eyJ...`. To get started with Hercules CI, see hercules-ci.com. Happy building! —the Hercules team"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description "Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get '[JSON] ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture' '[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects" :> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam' '[Optional] "project" (Name Project)
:> (Auth '[JWT] () :> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject :> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] () :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post '[JSON] CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description "Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional, Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description "To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get '[JSON] [ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers" :> (Auth '[JWT] () :> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] () :> GetJsonWithPreflight EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture' '[Required, Strict] "baseJobId" (Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed" :> (Auth '[JWT] () :> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] () :> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture' '[Required, Strict] "jobName" Text
:> ("run" :> (Auth '[JWT] () :> Post '[JSON] Job))))))))
:<|> ((Summary "Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))
:<|> (Summary "Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description "Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get '[JSON] ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture' '[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects" :> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam' '[Optional] "project" (Name Project)
:> (Auth '[JWT] () :> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject :> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] () :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post '[JSON] CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description "Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional, Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description "To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get '[JSON] [ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers" :> (Auth '[JWT] () :> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] () :> GetJsonWithPreflight EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture' '[Required, Strict] "baseJobId" (Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed" :> (Auth '[JWT] () :> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] () :> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture' '[Required, Strict] "jobName" Text
:> ("run" :> (Auth '[JWT] () :> Post '[JSON] Job))))))))
:<|> ((Summary "Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))
:<|> (Summary "Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log)))))))))))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (ProjectsAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ProjectsAPI auth)
clientProjects Tag
"project" Text
"Project and job operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> ((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] () :> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] () :> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] () :> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] () :> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam' '[Optional, Strict] "via-job" (Id Job)
:> (Auth '[JWT] ()
:> Get '[JSON] DerivationInfo)))))))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> ((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] () :> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] () :> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] () :> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] () :> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam' '[Optional, Strict] "via-job" (Id Job)
:> (Auth '[JWT] ()
:> Get '[JSON] DerivationInfo))))))))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (BuildAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (BuildAPI auth)
clientBuild Tag
"build" Text
"Build related operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> (Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] () :> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel" :> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> (Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam' '[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] () :> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel" :> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (EffectsAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (EffectsAPI auth)
clientEffects Tag
"effect" Text
"Effect related operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> (("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] () :> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states" :> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam' '[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength, ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture' '[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] () :> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> (("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] () :> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states" :> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam' '[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength, ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture' '[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] () :> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (StateAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (StateAPI auth)
clientState Tag
"state" Text
"State files and locks, commonly used with effects and the hci command"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> ("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> ("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (ForgeAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ForgeAPI auth)
clientForges Tag
"forge" Text
"Forge operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> (("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install" :> (Auth '[JWT] () :> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> (("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install" :> (Auth '[JWT] () :> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall" :> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (GitLabAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (GitLabAPI auth)
clientGitLab Tag
"gitlab" Text
"GitLab-specific operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> (Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> (Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (ReposAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ReposAPI auth)
clientRepos Tag
"repo" Text
"Repository operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> ((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict] "clusterJoinTokenId" (Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> ((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict] "clusterJoinTokenId" (Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession]))))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (AgentsAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (AgentsAPI auth)
clientAgents Tag
"agent" Text
"Agent admin and monitoring operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> ((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> ((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON] AccountInstallationStatus))))))))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (AccountsAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (AccountsAPI auth)
clientAccounts Tag
"account" Text
"Account operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> ((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing" :> Get '[JSON] BillingInfo)))))))))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> ((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing" :> Get '[JSON] BillingInfo))))))))
ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (OrganizationsAPI (Auth '[JWT] ()))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (OrganizationsAPI auth)
clientOrganizations Tag
"organization" Text
"Organizations and billing operations"
Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (ClientAPI (Auth '[JWT] ()) AsApi
-> "client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo)))
-> Tag -> Text -> Swagger -> Swagger
forall {a}.
(AllIsElem
(MapSub "api" (MapSub "v1" (EndpointsList a)))
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))))))))),
HasSwagger a) =>
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi
-> AsApi :- ToServantApi (ClientInfoAPI (Auth '[JWT] ()))
ClientAPI (Auth '[JWT] ()) AsApi
-> "client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ClientInfoAPI auth)
clientClientInfo Tag
"client" Text
"Ad hoc endpoints for the frontend and perhaps some client-side use cases"
where
withTags :: (ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Tag -> Text -> Swagger -> Swagger
withTags ClientAPI (Auth '[JWT] ()) AsApi -> a
f Tag
tag Text
desc = Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
applyTagsFor (Proxy ("api" :> ("v1" :> a))
-> Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get
'[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get
'[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture'
'[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs"
Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam'
'[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] ()
:> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description
"Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict]
"jobName"
Text
:> ("run"
:> (Auth '[JWT] ()
:> Post
'[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT]
()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] ()
:> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get
'[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam'
'[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam'
'[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink"
:> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict] "lockName" Text
:> (ReqBody
'[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict]
"project"
(Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth
'[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict]
"lockLeaseId"
(Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] ()
:> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON]
NoContent)))))))))))))
-> Traversal' Swagger Operation
forall sub api.
(IsSubAPI sub api, HasSwagger sub) =>
Proxy sub -> Proxy api -> Traversal' Swagger Operation
subOperations ((ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Proxy ("api" :> ("v1" :> a))
forall a.
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Proxy ("api" :> ("v1" :> a))
clientApiProxy ClientAPI (Auth '[JWT] ()) AsApi -> a
f) Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] () :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent)))))))))))))
Proxy (ClientServantAPI (Auth '[JWT] ()))
apiWithJWT) [Tag
tag Tag -> (Tag -> Tag) -> Tag
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Tag -> Identity Tag
forall s a. HasDescription s a => Lens' s a
Lens' Tag (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text)) -> Tag -> Identity Tag)
-> Text -> Tag -> Tag
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
desc]
apiWithJWT :: Proxy (ClientServantAPI (Auth '[JWT] ()))
apiWithJWT :: Proxy (ClientServantAPI (Auth '[JWT] ()))
apiWithJWT = forall auth. Proxy (ClientServantAPI auth)
servantClientApi @(Auth '[JWT] ())
openapi3 :: O3.OpenApi
openapi3 :: OpenApi
openapi3 =
Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] () :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent)))))))))))))
-> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
SO3.toOpenApi Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (Auth '[JWT] () :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] () :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] () :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] () :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (Auth '[JWT] () :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (Auth '[JWT] ()
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (Auth '[JWT] ()
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (Auth '[JWT] ()
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (Auth '[JWT] () :> Get '[JSON] [Account]))))))))
:<|> (((Summary "Create a request to authorize the CLI."
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (ReqBody '[JSON] CLIAuthorizationRequestCreate
:> Post '[JSON] CLIAuthorizationRequestCreateResponse))))))
:<|> ((Summary "Check the request status"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> ("status"
:> (Capture "temporaryToken" Text
:> Get '[JSON] CLIAuthorizationRequestStatus)))))))
:<|> (Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> (Auth '[JWT] ()
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (Auth '[JWT] () :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Auth '[JWT] () :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (Auth '[JWT] () :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (Auth '[JWT] ()
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (Auth '[JWT] () :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge."
:> (Auth '[JWT] () :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (Auth '[JWT] () :> Get '[JSON] [Repo])))))
:<|> (Summary
"Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
:> ("parse-git-url"
:> (QueryParam' '[Required, Strict] "gitURL" Text
:> (Auth '[JWT] () :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] () :> Get '[JSON] Project))
:<|> ((Summary "Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name "JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams "jobs" Text
:> (Auth '[JWT] ()
:> Get
'[JSON]
ImmutableGitInput))))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> ((Summary "Retrieve a project"
:> (Auth '[JWT] ()
:> Get '[JSON] Project))
:<|> ((Summary
"Retrieve information about jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch or HEAD"]
"ref"
Text
:> (QueryParam'
'[Optional,
Description
"Git commit hash (from which to load the job handler definition)"]
"rev"
(Name "Rev")
:> (QueryParam'
'[Optional,
Description
"Job handler type, such as onPush or onSchedule"]
"handler"
JobType
:> (QueryParam'
'[Optional,
Description
"Job handler name, such as <name> in onPush.<name>"]
"name"
(Name
"JobName")
:> (QueryParam'
'[Optional,
Description
"Only return successful jobs, or only failed ones"]
"success"
Bool
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided id in the response order."]
"offsetId"
(Id
Job)
:> (QueryParam'
'[Optional,
Description
"Return jobs that come \"after\" the provided index in the response order."]
"offsetIndex"
Int64
:> (QueryParam'
'[Optional,
Description
"Return at most n jobs."]
"limit"
Int64
:> (Auth
'[JWT]
()
:> GetJsonWithPreflight
PagedJobs)))))))))))
:<|> (Summary
"Get source information from the latest successful job/jobs satisfying the provided requirements."
:> (Description
"The job parameter can be omitted to require all jobs for a commit to succeed. This can have the unexpected effect of reverting when a change in the extraInputs causes a regression. So it is recommended to specify one or more jobs. Common examples are \"onPush.default\" for a pinned build or \"onPush.ci\" for a build using extraInputs to integrate continuously."
:> ("source"
:> (QueryParam'
'[Optional,
Description
"Constrain the results by git ref, such as refs/heads/my-branch. Defaults to HEAD."]
"ref"
Text
:> (QueryParams
"jobs" Text
:> (Auth
'[JWT]
()
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (Auth '[JWT] () :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (Auth '[JWT] ()
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (Auth '[JWT] () :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (Auth '[JWT] ()
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find jobs in multiple projects at once"
:> (Description
"For a more powerful single project endpoint, see /api/v1/site/{site}/account/{account}/project/{project}/jobs"
:> ("jobs"
:> (QueryParam'
'[Optional,
Description
"Currently only \"github\" or omit entirely"]
"site"
(Name Forge)
:> (QueryParam'
'[Optional,
Description "Account name filter"]
"account"
(Name Account)
:> (QueryParam'
'[Optional,
Description
"Project name filter. Required if you want to retrieve all jobs"]
"project"
(Name Project)
:> (QueryParam'
'[Optional,
Description
"To get a specific job by index"]
"index"
Int
:> (QueryParam'
'[Optional,
Description
"Number of latest jobs to get, when project name is omitted. Range [1..50], default 10."]
"latest"
Int
:> (Auth '[JWT] ()
:> Get
'[JSON]
[ProjectAndJobs]))))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (Auth '[JWT] () :> Get '[JSON] Job)))))
:<|> (Summary "Get a job's handler declarations, if any."
:> (Description
"Handlers define what to build and do on events such as onPush, onSchedule."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("handlers"
:> (Auth '[JWT] ()
:> Get '[JSON] JobHandlers)))))))
:<|> ((Summary "List all attributes in a job"
:> (Description
"A list of all attributes that have been produced as part of the evaluation of a job."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDetail))))))
:<|> (Summary "Compare two evaluations"
:> (Description
"A list of attributes that have been added, removed or changed between two evaluations. Also lists changes to the IFD derivations."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("evaluation"
:> ("compare"
:> (Capture'
'[Required, Strict]
"baseJobId"
(Id Job)
:> (Auth '[JWT] ()
:> GetJsonWithPreflight
EvaluationDiff))))))))))
:<|> (((Summary "Find all failures in an evaluation's derivations"
:> (Description
"Returns all derivations that have failures in their dependency closures."
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> ("derivations"
:> ("failed"
:> (Auth '[JWT] ()
:> Get '[JSON] Graph)))))))
:<|> (Summary "Create a new job like this job"
:> (Description
"The newly created job will be in the same project, have the same inputs but a new evaluation. The response has the newly created job."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("rerun"
:> (QueryParam "rebuildFailures" Bool
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Create a scheduled job to run now, based on a configuration job."
:> (Description
"This is mostly intended for trying out new scheduled jobs before they are merged. The job is run in the context of the job's branch; not that of the default branch."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("on-schedule"
:> (Capture'
'[Required, Strict] "jobName" Text
:> ("run"
:> (Auth '[JWT] ()
:> Post '[JSON] Job))))))))
:<|> ((Summary
"Cancel the job and any work that becomes redundant"
:> (Description
"Some derivations may keep going, if referenced by active jobs."
:> ("jobs"
:> (Capture'
'[Required, Strict] "jobId" (Id Job)
:> ("cancel"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent))))))
:<|> (Summary
"Read all recorded evaluation log entries"
:> ("jobs"
:> (Capture'
'[Required, Strict]
"jobId"
(Id Job)
:> ("evaluation"
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required]
"logId"
(Id "log")
:> (QueryParam'
'[Optional]
"iMin"
Int
:> (Auth
'[JWT] ()
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Auth '[JWT] () :> Get '[JSON] [ClusterJoinToken])))))
:<|> (Summary
"Generate a new cluster join token for agents to be added to this account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ReqBody '[JSON] CreateClusterJoinToken
:> (Auth '[JWT] () :> Post '[JSON] FullClusterJoinToken)))))))
:<|> ((Summary
"Delete an cluster join token in the account. No new agents will be able to join this account with the specified token."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (Capture'
'[Required, Strict]
"clusterJoinTokenId"
(Id ClusterJoinToken)
:> (Auth '[JWT] () :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (Auth '[JWT] () :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))
:<|> (Summary "Cancel a derivation"
:> (Description
"If running, the build or push process will be killed. It will not be restarted, unless a rebuild is requested, or when output contents are required during evaluation (import from derivation)."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[PlainText, JSON] NoContent)))))))))
:<|> ((Summary "Read a derivation build log"
:> (Description "This interface may change."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> (QueryParam "logId" (Id "log")
:> (Auth '[JWT] ()
:> Get '[PlainText, JSON] Text)))))))))
:<|> ((Summary "Read all recorded log entries"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary "Get information about a derivation."
:> (Description
"Optionally, a job id can be specified to provide context."
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> (QueryParam'
'[Optional, Strict]
"via-job"
(Id Job)
:> (Auth '[JWT] ()
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (Auth '[JWT] () :> Get '[JSON] EffectInfo))))))
:<|> ((Summary "Read all recorded log entries"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("log"
:> ("lines"
:> (QueryParam'
'[Required] "logId" (Id "log")
:> (QueryParam' '[Optional] "iMin" Int
:> (Auth '[JWT] ()
:> Get '[JSON] Log))))))))))
:<|> (Summary
"Cancel the effect. It will cause the Job to have a failed status."
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> ("cancel"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (Auth '[JWT] ()
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (Auth '[JWT] ()
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("billing"
:> Get '[JSON] BillingInfo)))))))))
:<|> (((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (StreamBody
NoFraming OctetStream (SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] () :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse)))))))))
:<|> ("site"
:> (Capture' '[Required, Strict] "site" (Name Forge)
:> ("account"
:> (Capture' '[Required, Strict] "account" (Name Account)
:> ("project"
:> (Capture'
'[Required, Strict] "project" (Name Project)
:> (((Summary "Upload a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (StreamBody
NoFraming
OctetStream
(SourceIO RawBytes)
:> (Auth '[JWT] ()
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (Auth '[JWT] ()
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (Auth '[JWT] ()
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (Auth '[JWT] ()
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (Auth '[JWT] ()
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (Auth '[JWT] () :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (Auth '[JWT] () :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (Auth '[JWT] () :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (Auth '[JWT] ()
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (Auth '[JWT] ()
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (Auth '[JWT] ()
:> Post
'[JSON] NoContent)))))))))))))
Proxy (ClientServantAPI (Auth '[JWT] ()))
apiWithJWT
OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& ([SecurityRequirement] -> Identity [SecurityRequirement])
-> OpenApi -> Identity OpenApi
forall s a. HasSecurity s a => Lens' s a
Lens' OpenApi [SecurityRequirement]
O3.security (([SecurityRequirement] -> Identity [SecurityRequirement])
-> OpenApi -> Identity OpenApi)
-> ([SecurityRequirement] -> [SecurityRequirement])
-> OpenApi
-> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([SecurityRequirement] -> [SecurityRequirement]
forall {a}. Eq a => [a] -> [a]
uniq ([SecurityRequirement] -> [SecurityRequirement])
-> ([SecurityRequirement] -> [SecurityRequirement])
-> [SecurityRequirement]
-> [SecurityRequirement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SecurityRequirement -> String)
-> [SecurityRequirement] -> [SecurityRequirement]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn SecurityRequirement -> String
forall a. Show a => a -> String
show)
where
uniq :: [a] -> [a]
uniq (a
a1 : a
a2 : [a]
as) = if a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2 then [a] -> [a]
uniq (a
a2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) else a
a1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
uniq (a
a2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
uniq [a]
as = [a]
as
clientApiProxy :: (ClientAPI (Auth '[JWT] ()) AsApi -> a) -> Proxy ("api" :> "v1" :> a)
clientApiProxy :: forall a.
(ClientAPI (Auth '[JWT] ()) AsApi -> a)
-> Proxy ("api" :> ("v1" :> a))
clientApiProxy ClientAPI (Auth '[JWT] ()) AsApi -> a
_ = Proxy ("api" :> ("v1" :> a))
forall {k} (t :: k). Proxy t
Proxy
noContent :: (Functor m) => m Servant.API.NoContent -> m ()
noContent :: forall (m :: * -> *). Functor m => m NoContent -> m ()
noContent = m NoContent -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void