{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Hercules.CLI.Client
(
determineDefaultApiBaseUrl,
init,
HerculesClientToken (..),
HerculesClientEnv,
retryOnFail,
retryOnFailAnon,
retryStreamOnFail,
shouldRetryClientError,
clientErrorSummary,
shouldRetryResponse,
waitRetryPolicy,
dieWithHttpError,
prettyPrintHttpErrors,
accountsClient,
projectsClient,
reposClient,
stateClient,
)
where
import Data.Has (Has, getter)
import qualified Data.Text as T
import Hercules.API (ClientAPI (..), ClientAuth, servantClientApi, useApi)
import Hercules.API.Accounts (AccountsAPI)
import Hercules.API.Projects (ProjectsAPI)
import Hercules.API.Repos (ReposAPI)
import Hercules.API.State (ContentDisposition, ContentLength, RawBytes, StateAPI)
import Hercules.Error
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS
import Network.HTTP.Types.Status (Status (statusCode, statusMessage))
import qualified Network.TLS as TLS
import Protolude
import RIO (RIO)
import Servant.API
import Servant.Auth.Client (Token)
import qualified Servant.Client
import Servant.Client.Core (ClientError, ResponseF)
import qualified Servant.Client.Core as Client
import qualified Servant.Client.Core.ClientError as ClientError
import Servant.Client.Generic (AsClientT)
import Servant.Client.Streaming (ClientM, responseStatusCode, showBaseUrl)
import qualified Servant.Client.Streaming
import qualified System.Environment
import qualified UnliftIO
import UnliftIO.Retry (RetryPolicyM, RetryStatus, capDelay, fullJitterBackoff, retrying, rsIterNumber)
client :: ClientAPI ClientAuth (AsClientT ClientM)
client :: ClientAPI ClientAuth (AsClientT ClientM)
client = ToServant (ClientAPI ClientAuth) (AsClientT ClientM)
-> ClientAPI ClientAuth (AsClientT ClientM)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant (ToServant (ClientAPI ClientAuth) (AsClientT ClientM)
-> ClientAPI ClientAuth (AsClientT ClientM))
-> ToServant (ClientAPI ClientAuth) (AsClientT ClientM)
-> ClientAPI ClientAuth (AsClientT ClientM)
forall a b. (a -> b) -> a -> b
$ Proxy
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (ClientAuth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (ClientAuth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (ClientAuth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (ClientAuth :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ClientAuth :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (ClientAuth
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (ClientAuth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (ClientAuth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (ClientAuth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (ClientAuth :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (ClientAuth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (ClientAuth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (ClientAuth
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (ClientAuth :> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (ClientAuth :> 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
:> (ClientAuth
:> Get '[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (ClientAuth :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (ClientAuth :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (ClientAuth :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (ClientAuth
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (ClientAuth :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge." :> (ClientAuth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (ClientAuth :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge." :> (ClientAuth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (ClientAuth :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (ClientAuth :> 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
:> (ClientAuth :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (ClientAuth :> 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
"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
:> (ClientAuth
:> 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
:> (ClientAuth
:> 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"
:> (ClientAuth :> 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
"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
:> (ClientAuth
:> 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
:> (ClientAuth
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (ClientAuth :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam' '[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (ClientAuth
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (ClientAuth
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (ClientAuth :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> (ClientAuth
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find 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
:> (ClientAuth
:> Get
'[JSON]
[ProjectAndJobs])))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (ClientAuth :> 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"
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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)
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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
:> (ClientAuth
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ClientAuth :> 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
:> (ClientAuth :> 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)
:> (ClientAuth :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (ClientAuth :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (ClientAuth :> 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"
:> (ClientAuth
:> 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")
:> (ClientAuth
:> 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
:> (ClientAuth
:> 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)
:> (ClientAuth
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (ClientAuth :> 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
:> (ClientAuth
:> 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"
:> (ClientAuth
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (ClientAuth
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (ClientAuth
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (ClientAuth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (ClientAuth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink" :> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (ClientAuth
:> ("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)
:> (ClientAuth :> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (ClientAuth :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (ClientAuth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture' '[Required, Strict] "lockName" Text
:> (ReqBody '[JSON] StateLockAcquireRequest
:> (ClientAuth
:> 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)
:> (ClientAuth
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (ClientAuth
:> Get
'[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional, Strict]
"version"
Int
:> (ClientAuth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (ClientAuth
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (ClientAuth :> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ClientAuth :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (ClientAuth :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (ClientAuth :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (ClientAuth
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (ClientAuth
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (ClientAuth :> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (ClientAuth :> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (ClientAuth
:> Post
'[JSON] NoContent)))))))))))))
-> Client
ClientM
(AddAPIVersion
((((((("accounts"
:> ("me"
:> (((Summary "Get the account."
:> (ClientAuth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (ClientAuth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (ClientAuth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (ClientAuth :> Post '[JSON] Int)))))))
:<|> ((Summary "Retrieve notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ClientAuth :> Get '[JSON] NotificationSettings))))))
:<|> (Summary "Update notification settings"
:> ("accounts"
:> ("me"
:> ("settings"
:> ("notifications"
:> (ReqBody '[JSON] NotificationSettingsPatch
:> (ClientAuth
:> Patch '[JSON] NotificationSettings)))))))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> (((Summary "Get the account."
:> (ClientAuth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings" :> (ClientAuth :> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (ClientAuth :> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (ClientAuth :> Post '[JSON] Int)))))))
:<|> (("site"
:> (Capture' '[] "site" (Name Forge)
:> ("account"
:> (Capture' '[] "account" (Name Account)
:> (((Summary "Get the account."
:> (ClientAuth :> Get '[JSON] Account))
:<|> (Summary "Get the account settings."
:> ("settings"
:> (ClientAuth
:> Get '[JSON] AccountSettings))))
:<|> ((Summary "Update the account settings."
:> ("settings"
:> (ReqBody '[JSON] AccountSettingsPatch
:> (ClientAuth
:> Patch '[JSON] AccountSettings))))
:<|> (Summary "Disable all projects in the account."
:> ("disable-all-projects"
:> (ClientAuth
:> Post '[JSON] Int)))))))))
:<|> (Summary
"Accounts that the authenticated user owns, admins or collaborates with."
:> ("accounts"
:> (QueryParam "site" (Name Forge)
:> (QueryParam "name" (Name Account)
:> (ClientAuth :> 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
:> (ClientAuth
:> Get
'[JSON] CLIAuthorizationRequest)))))))))
:<|> (((Summary "Retrieve the request"
:> ("auth"
:> ("cli"
:> ("authorization"
:> ("request"
:> (Capture "browserToken" Text
:> ("confirm"
:> (ClientAuth :> Post '[JSON] NoContent))))))))
:<|> (Summary
"List the CLI tokens associated with the current account."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (ClientAuth :> Get '[JSON] CLITokensResponse))))))
:<|> ((Summary "Permanently disallow the use of a CLI token."
:> ("auth"
:> ("cli"
:> ("tokens"
:> (Capture "cliTokenId" (Id "CLIToken")
:> ("revoke"
:> (ClientAuth :> Post '[JSON] NoContent)))))))
:<|> (Summary
"Retrieve installation status after redirect from external source site settings."
:> ("sites"
:> (Capture "forgeId" (Id Forge)
:> ("installation"
:> (Capture "installationId" Int
:> ("status"
:> (ClientAuth
:> Get
'[JSON]
AccountInstallationStatus)))))))))))
:<|> ("client"
:> ("info" :> (ClientAuth :> Get '[JSON] ClientInfo))))
:<|> ((("forges"
:> (Capture "forgeId" (Id Forge)
:> ((Summary "Get the forge." :> (ClientAuth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (ClientAuth :> Delete '[JSON] NoContent)))))
:<|> ("forge"
:> (Capture' '[] "forgeName" (Name Forge)
:> ((Summary "Get the forge." :> (ClientAuth :> Get '[JSON] Forge))
:<|> (Summary "Delete the forge."
:> (ClientAuth :> Delete '[JSON] NoContent))))))
:<|> (((Summary
"Repositories that the account owns or has explicit access to."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("repos" :> (ClientAuth :> 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
:> (ClientAuth :> Get '[JSON] RepoKey)))))
:<|> ((((("projects"
:> (Capture' '[Required, Strict] "projectId" (Id Project)
:> ((Summary "Retrieve a project"
:> (ClientAuth :> 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
"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
:> (ClientAuth
:> 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
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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
"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
:> (ClientAuth
:> 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
:> (ClientAuth
:> Get
'[JSON]
ImmutableGitInput)))))))))))))))
:<|> ((Summary "List all projects owned by an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("projects"
:> (ClientAuth :> Get '[JSON] [Project])))))
:<|> (Summary "Find projects"
:> ("projects"
:> (QueryParam' '[Optional] "site" (Name Forge)
:> (QueryParam'
'[Optional] "account" (Name Account)
:> (QueryParam'
'[Optional] "project" (Name Project)
:> (ClientAuth
:> Get '[JSON] [Project]))))))))
:<|> (((Summary "Create a new project."
:> ("projects"
:> (ClientAuth
:> (ReqBody '[JSON] CreateProject
:> Post '[JSON] (Id Project)))))
:<|> (Summary "Modify a project"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ReqBody '[JSON] PatchProject
:> (ClientAuth :> Patch '[JSON] Project))))))
:<|> ((Summary "Create a token for local effect execution"
:> ("projects"
:> (Capture'
'[Required, Strict] "projectId" (Id Project)
:> (ClientAuth
:> ("create-user-effect-token"
:> Post
'[JSON]
CreateUserEffectTokenResponse)))))
:<|> (Summary "Find 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
:> (ClientAuth
:> Get
'[JSON]
[ProjectAndJobs])))))))))))
:<|> ((((Summary "Retrieve a job"
:> (Description "Retrieve a job"
:> ("jobs"
:> (Capture' '[Required, Strict] "jobId" (Id Job)
:> (ClientAuth :> 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"
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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)
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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
:> (ClientAuth
:> Get
'[JSON]
Log)))))))))))))))))
:<|> (((((Summary "List all cluster join tokens in an account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("clusterJoinTokens"
:> (ClientAuth :> 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
:> (ClientAuth :> 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)
:> (ClientAuth :> Delete '[JSON] NoContent))))))
:<|> (Summary "Show the agents sessions owned by the account."
:> ("accounts"
:> (Capture' '[Required, Strict] "accountId" (Id Account)
:> ("agentSessions"
:> (ClientAuth :> Get '[JSON] [AgentSession])))))))
:<|> ((((Summary "Restart a derivation"
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("derivations"
:> (Capture "derivationPath" Text
:> ("retry"
:> (ClientAuth
:> 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"
:> (ClientAuth
:> 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")
:> (ClientAuth
:> 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
:> (ClientAuth
:> 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)
:> (ClientAuth
:> Get
'[JSON]
DerivationInfo)))))))))))
:<|> ((Summary "Read effect events"
:> ("jobs"
:> (Capture "jobId" (Id Job)
:> ("effects"
:> (Capture "attribute" AttributePath
:> (ClientAuth :> 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
:> (ClientAuth
:> 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"
:> (ClientAuth
:> Post '[JSON] NoContent)))))))))))
:<|> ((((Summary "Get all organizations user has admin access to"
:> (ClientAuth
:> ("api" :> ("organizations" :> Get '[JSON] [Organization]))))
:<|> (Summary "Create a new organization"
:> (ClientAuth
:> ("api"
:> ("organizations"
:> (ReqBody '[JSON] CreateOrganization
:> Post '[JSON] Organization))))))
:<|> ((Summary "Connect an account to an organization"
:> (ClientAuth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> Post '[JSON] NoContent)))))))
:<|> ((Summary "Generate payment link for an organization"
:> (ClientAuth
:> ("api"
:> ("organizations"
:> (Capture "organizationId" (Id Organization)
:> ("paymentLink"
:> Post '[JSON] PaymentLink))))))
:<|> (Summary
"List the active users in an organization's accounts."
:> (ClientAuth
:> ("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)
:> (ClientAuth
:> Put '[JSON] NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (ClientAuth :> Get '[JSON] ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture' '[Required, Strict] "stateName" Text
:> ("data"
:> (QueryParam'
'[Optional, Strict] "version" Int
:> (ClientAuth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict] "lockName" Text
:> (ReqBody
'[JSON] StateLockAcquireRequest
:> (ClientAuth
:> 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)
:> (ClientAuth
:> Put
'[JSON]
NoContent))))))
:<|> (Summary "List all state files"
:> ("states"
:> (ClientAuth
:> Get
'[JSON]
ProjectState))))
:<|> ((Summary "Download a state file"
:> ("state"
:> (Capture'
'[Required, Strict]
"stateName"
Text
:> ("data"
:> (QueryParam'
'[Optional,
Strict]
"version"
Int
:> (ClientAuth
:> StreamGet
NoFraming
OctetStream
(Headers
'[ContentLength,
ContentDisposition]
(SourceIO
RawBytes))))))))
:<|> (Summary "Acquire a lock"
:> ("lock"
:> (Capture'
'[Required, Strict]
"lockName"
Text
:> (ReqBody
'[JSON]
StateLockAcquireRequest
:> (ClientAuth
:> Post
'[JSON]
StateLockAcquireResponse))))))))))))))
:<|> (("lock-leases"
:> (Capture'
'[Required, Strict] "lockLeaseId" (Id "StateLockLease")
:> (ReqBody '[JSON] StateLockUpdateRequest
:> (ClientAuth
:> Post '[JSON] StateLockAcquiredResponse))))
:<|> ("lock-leases"
:> (Capture'
'[Required, Strict]
"lockLeaseId"
(Id "StateLockLease")
:> (ClientAuth :> Delete '[JSON] NoContent)))))
:<|> ((("gitlab"
:> ("installation"
:> (ReqBody '[JSON] CreateInstallationBuilderRequest
:> (ClientAuth :> Post '[JSON] InstallationBuilder))))
:<|> (("gitlab"
:> ("installations"
:> (ClientAuth :> Get '[JSON] InstallationBuilders)))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (ClientAuth
:> Get '[JSON] InstallationBuilder))))))
:<|> ((("gitlab"
:> ("installation"
:> (Capture "installationId" (Id InstallationBuilder)
:> (ClientAuth
:> (ReqBody '[JSON] PatchInstallationBuilder
:> Patch '[JSON] InstallationBuilder)))))
:<|> ("gitlab"
:> ("installation"
:> (Capture
"installationId" (Id InstallationBuilder)
:> (ClientAuth
:> Delete '[JSON] NoContent)))))
:<|> (("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("install"
:> (ClientAuth
:> Post '[JSON] NoContent)))))
:<|> ("accounts"
:> (Capture' '[] "accountId" (Id Account)
:> ("gitlab"
:> ("deinstall"
:> (ClientAuth
:> Post
'[JSON]
NoContent)))))))))))))
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
Servant.Client.Streaming.client (forall auth. Proxy (ClientServantAPI auth)
servantClientApi @ClientAuth)
accountsClient :: AccountsAPI ClientAuth (AsClientT ClientM)
accountsClient :: AccountsAPI ClientAuth (AsClientT ClientM)
accountsClient = (ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (AccountsAPI ClientAuth) (AsClientT ClientM))
-> ClientAPI ClientAuth (AsClientT ClientM)
-> AccountsAPI ClientAuth (AsClientT ClientM)
forall (subapi :: * -> *) (api :: * -> *) mode.
GenericServant subapi mode =>
(api mode -> ToServant subapi mode) -> api mode -> subapi mode
useApi ClientAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM :- ToServantApi (AccountsAPI ClientAuth)
ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (AccountsAPI ClientAuth) (AsClientT ClientM)
forall auth f.
ClientAPI auth f -> f :- ToServantApi (AccountsAPI auth)
clientAccounts ClientAPI ClientAuth (AsClientT ClientM)
client
stateClient :: StateAPI ClientAuth (AsClientT ClientM)
stateClient :: StateAPI ClientAuth (AsClientT ClientM)
stateClient = (ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (StateAPI ClientAuth) (AsClientT ClientM))
-> ClientAPI ClientAuth (AsClientT ClientM)
-> StateAPI ClientAuth (AsClientT ClientM)
forall (subapi :: * -> *) (api :: * -> *) mode.
GenericServant subapi mode =>
(api mode -> ToServant subapi mode) -> api mode -> subapi mode
useApi ClientAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM :- ToServantApi (StateAPI ClientAuth)
ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (StateAPI ClientAuth) (AsClientT ClientM)
forall auth f.
ClientAPI auth f -> f :- ToServantApi (StateAPI auth)
clientState ClientAPI ClientAuth (AsClientT ClientM)
client
projectsClient :: ProjectsAPI ClientAuth (AsClientT ClientM)
projectsClient :: ProjectsAPI ClientAuth (AsClientT ClientM)
projectsClient = (ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (ProjectsAPI ClientAuth) (AsClientT ClientM))
-> ClientAPI ClientAuth (AsClientT ClientM)
-> ProjectsAPI ClientAuth (AsClientT ClientM)
forall (subapi :: * -> *) (api :: * -> *) mode.
GenericServant subapi mode =>
(api mode -> ToServant subapi mode) -> api mode -> subapi mode
useApi ClientAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM :- ToServantApi (ProjectsAPI ClientAuth)
ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (ProjectsAPI ClientAuth) (AsClientT ClientM)
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ProjectsAPI auth)
clientProjects ClientAPI ClientAuth (AsClientT ClientM)
client
reposClient :: ReposAPI ClientAuth (AsClientT ClientM)
reposClient :: ReposAPI ClientAuth (AsClientT ClientM)
reposClient = (ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (ReposAPI ClientAuth) (AsClientT ClientM))
-> ClientAPI ClientAuth (AsClientT ClientM)
-> ReposAPI ClientAuth (AsClientT ClientM)
forall (subapi :: * -> *) (api :: * -> *) mode.
GenericServant subapi mode =>
(api mode -> ToServant subapi mode) -> api mode -> subapi mode
useApi ClientAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM :- ToServantApi (ReposAPI ClientAuth)
ClientAPI ClientAuth (AsClientT ClientM)
-> ToServant (ReposAPI ClientAuth) (AsClientT ClientM)
forall auth f.
ClientAPI auth f -> f :- ToServantApi (ReposAPI auth)
clientRepos ClientAPI ClientAuth (AsClientT ClientM)
client
determineDefaultApiBaseUrl :: IO Text
determineDefaultApiBaseUrl :: IO Text
determineDefaultApiBaseUrl = do
Maybe String
maybeEnv <- String -> IO (Maybe String)
System.Environment.lookupEnv String
"HERCULES_CI_API_BASE_URL"
Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
defaultApiBaseUrl String -> Text
forall a b. ConvertText a b => a -> b
toS Maybe String
maybeEnv
defaultApiBaseUrl :: Text
defaultApiBaseUrl :: Text
defaultApiBaseUrl = Text
"https://hercules-ci.com"
newtype HerculesClientEnv = HerculesClientEnv Servant.Client.ClientEnv
newtype HerculesClientToken = HerculesClientToken Token
runHerculesClientEither :: (NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) => (Token -> Servant.Client.Streaming.ClientM a) -> RIO r (Either Servant.Client.Streaming.ClientError a)
runHerculesClientEither :: forall a r.
(NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> RIO r (Either ClientError a)
runHerculesClientEither Token -> ClientM a
f = do
HerculesClientToken Token
token <- (r -> HerculesClientToken) -> RIO r HerculesClientToken
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> HerculesClientToken
forall a t. Has a t => t -> a
getter
ClientM a -> RIO r (Either ClientError a)
forall a r.
(NFData a, Has HerculesClientEnv r) =>
ClientM a -> RIO r (Either ClientError a)
runHerculesClientEither' (ClientM a -> RIO r (Either ClientError a))
-> ClientM a -> RIO r (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ Token -> ClientM a
f Token
token
runHerculesClientStream ::
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> Servant.Client.Streaming.ClientM a) ->
(Either Servant.Client.Streaming.ClientError a -> IO b) ->
RIO r b
runHerculesClientStream :: forall r a b.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> (Either ClientError a -> IO b) -> RIO r b
runHerculesClientStream Token -> ClientM a
f Either ClientError a -> IO b
g = do
HerculesClientToken Token
token <- (r -> HerculesClientToken) -> RIO r HerculesClientToken
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> HerculesClientToken
forall a t. Has a t => t -> a
getter
HerculesClientEnv ClientEnv
clientEnv <- (r -> HerculesClientEnv) -> RIO r HerculesClientEnv
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> HerculesClientEnv
forall a t. Has a t => t -> a
getter
IO b -> RIO r b
forall a. IO a -> RIO r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> RIO r b) -> IO b -> RIO r b
forall a b. (a -> b) -> a -> b
$ IO b -> IO b
forall a. IO a -> IO a
convertInternalError (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
forall a b.
ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
Servant.Client.Streaming.withClientM (Token -> ClientM a
f Token
token) ClientEnv
clientEnv Either ClientError a -> IO b
g
runHerculesClient' :: (NFData a, Has HerculesClientEnv r) => Servant.Client.Streaming.ClientM a -> RIO r a
runHerculesClient' :: forall a r.
(NFData a, Has HerculesClientEnv r) =>
ClientM a -> RIO r a
runHerculesClient' = ClientM a -> RIO r (Either ClientError a)
forall a r.
(NFData a, Has HerculesClientEnv r) =>
ClientM a -> RIO r (Either ClientError a)
runHerculesClientEither' (ClientM a -> RIO r (Either ClientError a))
-> (Either ClientError a -> RIO r a) -> ClientM a -> RIO r a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either ClientError a -> RIO r a
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate
retryOnFailAnon :: (NFData b, Has HerculesClientEnv r) => Text -> ClientM b -> RIO r b
retryOnFailAnon :: forall b r.
(NFData b, Has HerculesClientEnv r) =>
Text -> ClientM b -> RIO r b
retryOnFailAnon Text
shortDesc ClientM b
m = Text
-> RIO r (Either ClientError b) -> RIO r (Either ClientError b)
forall r a.
Text
-> RIO r (Either ClientError a) -> RIO r (Either ClientError a)
retryOnFailEither Text
shortDesc (RIO r b -> RIO r (Either ClientError b)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try (RIO r b -> RIO r (Either ClientError b))
-> RIO r b -> RIO r (Either ClientError b)
forall a b. (a -> b) -> a -> b
$ ClientM b -> RIO r b
forall a r.
(NFData a, Has HerculesClientEnv r) =>
ClientM a -> RIO r a
runHerculesClient' ClientM b
m) RIO r (Either ClientError b)
-> (Either ClientError b -> RIO r b) -> RIO r b
forall a b. RIO r a -> (a -> RIO r b) -> RIO r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ClientError b -> RIO r b
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate
runHerculesClientEither' :: (NFData a, Has HerculesClientEnv r) => Servant.Client.Streaming.ClientM a -> RIO r (Either Servant.Client.Streaming.ClientError a)
runHerculesClientEither' :: forall a r.
(NFData a, Has HerculesClientEnv r) =>
ClientM a -> RIO r (Either ClientError a)
runHerculesClientEither' ClientM a
m = do
HerculesClientEnv ClientEnv
clientEnv <- (r -> HerculesClientEnv) -> RIO r HerculesClientEnv
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> HerculesClientEnv
forall a t. Has a t => t -> a
getter
IO (Either ClientError a) -> RIO r (Either ClientError a)
forall a. IO a -> RIO r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError a) -> RIO r (Either ClientError a))
-> IO (Either ClientError a) -> RIO r (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ IO (Either ClientError a) -> IO (Either ClientError a)
forall a. IO a -> IO a
convertInternalError (IO (Either ClientError a) -> IO (Either ClientError a))
-> IO (Either ClientError a) -> IO (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a.
NFData a =>
ClientM a -> ClientEnv -> IO (Either ClientError a)
Servant.Client.Streaming.runClientM ClientM a
m ClientEnv
clientEnv
init :: IO HerculesClientEnv
init :: IO HerculesClientEnv
init = do
Manager
manager <- IO Manager
forall (m :: * -> *). MonadIO m => m Manager
Network.HTTP.Client.TLS.newTlsManager
Text
baseUrlText <- IO Text
determineDefaultApiBaseUrl
BaseUrl
baseUrl <- String -> IO BaseUrl
forall (m :: * -> *). MonadThrow m => String -> m BaseUrl
Servant.Client.parseBaseUrl (String -> IO BaseUrl) -> String -> IO BaseUrl
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
baseUrlText
let clientEnv :: Servant.Client.ClientEnv
clientEnv :: ClientEnv
clientEnv = Manager -> BaseUrl -> ClientEnv
Servant.Client.mkClientEnv Manager
manager BaseUrl
baseUrl
HerculesClientEnv -> IO HerculesClientEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HerculesClientEnv -> IO HerculesClientEnv)
-> HerculesClientEnv -> IO HerculesClientEnv
forall a b. (a -> b) -> a -> b
$ ClientEnv -> HerculesClientEnv
HerculesClientEnv ClientEnv
clientEnv
dieWithHttpError :: Client.ClientError -> IO a
dieWithHttpError :: forall a. ClientError -> IO a
dieWithHttpError (Client.FailureResponse RequestF () (BaseUrl, ByteString)
req Response
resp) = do
let status :: Status
status = Response -> Status
forall a. ResponseF a -> Status
responseStatusCode Response
resp
(BaseUrl
base, ByteString
path) = RequestF () (BaseUrl, ByteString) -> (BaseUrl, ByteString)
forall body path. RequestF body path -> path
Client.requestPath RequestF () (BaseUrl, ByteString)
req
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Text
"hci: Request failed; "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Status -> Int
statusCode Status
status)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (Status -> ByteString
statusMessage Status
status)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS (BaseUrl -> String
showBaseUrl BaseUrl
base)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
path)
IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
forall a. IO a
exitFailure
dieWithHttpError ClientError
e = do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: Request failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS (ClientError -> String
forall e. Exception e => e -> String
displayException ClientError
e)
IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
forall a. IO a
exitFailure
prettyPrintHttpErrors :: IO a -> IO a
prettyPrintHttpErrors :: forall a. IO a -> IO a
prettyPrintHttpErrors = (ClientError -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ClientError -> IO a
forall a. ClientError -> IO a
dieWithHttpError
inLowRange :: (Ord a) => a -> (a, a) -> Bool
a
a inLowRange :: forall a. Ord a => a -> (a, a) -> Bool
`inLowRange` (a
p, a
q) = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
p Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
q
shouldRetryResponse :: Either ClientError r -> Bool
shouldRetryResponse :: forall r. Either ClientError r -> Bool
shouldRetryResponse (Left ClientError
e) = ClientError -> Bool
shouldRetryClientError ClientError
e
shouldRetryResponse Either ClientError r
_ = Bool
False
code :: ResponseF a -> Int
code :: forall a. ResponseF a -> Int
code = Status -> Int
statusCode (Status -> Int) -> (ResponseF a -> Status) -> ResponseF a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseF a -> Status
forall a. ResponseF a -> Status
responseStatusCode
shouldRetryClientError :: ClientError -> Bool
shouldRetryClientError :: ClientError -> Bool
shouldRetryClientError (ClientError.FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp) | Response -> Int
forall a. ResponseF a -> Int
code Response
resp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
501 = Bool
False
shouldRetryClientError (ClientError.FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp) | Response -> Int
forall a. ResponseF a -> Int
code Response
resp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
505 = Bool
False
shouldRetryClientError (ClientError.FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp) | Response -> Int
forall a. ResponseF a -> Int
code Response
resp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
408 = Bool
True
shouldRetryClientError (ClientError.FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp) | Response -> Int
forall a. ResponseF a -> Int
code Response
resp Int -> (Int, Int) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inLowRange` (Int
500, Int
600) = Bool
True
shouldRetryClientError (ClientError.DecodeFailure Text
_ Response
_) = Bool
False
shouldRetryClientError (ClientError.UnsupportedContentType MediaType
_ Response
_) = Bool
False
shouldRetryClientError (ClientError.InvalidContentTypeHeader Response
_) = Bool
False
shouldRetryClientError (ClientError.ConnectionError SomeException
_) = Bool
True
shouldRetryClientError ClientError
_ = Bool
False
data HTTPInternalException = HTTPInternalException HTTP.Request SomeException
deriving (Show HTTPInternalException
Typeable HTTPInternalException
Typeable HTTPInternalException
-> Show HTTPInternalException
-> (HTTPInternalException -> SomeException)
-> (SomeException -> Maybe HTTPInternalException)
-> (HTTPInternalException -> String)
-> Exception HTTPInternalException
SomeException -> Maybe HTTPInternalException
HTTPInternalException -> String
HTTPInternalException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
$ctoException :: HTTPInternalException -> SomeException
toException :: HTTPInternalException -> SomeException
$cfromException :: SomeException -> Maybe HTTPInternalException
fromException :: SomeException -> Maybe HTTPInternalException
$cdisplayException :: HTTPInternalException -> String
displayException :: HTTPInternalException -> String
Exception, Int -> HTTPInternalException -> ShowS
[HTTPInternalException] -> ShowS
HTTPInternalException -> String
(Int -> HTTPInternalException -> ShowS)
-> (HTTPInternalException -> String)
-> ([HTTPInternalException] -> ShowS)
-> Show HTTPInternalException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HTTPInternalException -> ShowS
showsPrec :: Int -> HTTPInternalException -> ShowS
$cshow :: HTTPInternalException -> String
show :: HTTPInternalException -> String
$cshowList :: [HTTPInternalException] -> ShowS
showList :: [HTTPInternalException] -> ShowS
Show)
convertInternalError :: IO a -> IO a
convertInternalError :: forall a. IO a -> IO a
convertInternalError = IO a -> IO (Either ClientError a)
forall a. IO a -> IO (Either ClientError a)
deescalateInternalError (IO a -> IO (Either ClientError a))
-> (Either ClientError a -> IO a) -> IO a -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either ClientError a -> IO a
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate
deescalateInternalError :: IO a -> IO (Either ClientError a)
deescalateInternalError :: forall a. IO a -> IO (Either ClientError a)
deescalateInternalError IO a
m = (SomeException -> Maybe ClientError)
-> (ClientError -> IO (Either ClientError a))
-> IO (Either ClientError a)
-> IO (Either ClientError a)
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust SomeException -> Maybe ClientError
matchClientException (Either ClientError a -> IO (Either ClientError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClientError a -> IO (Either ClientError a))
-> (ClientError -> Either ClientError a)
-> ClientError
-> IO (Either ClientError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> Either ClientError a
forall a b. a -> Either a b
Left) (a -> Either ClientError a
forall a b. b -> Either a b
Right (a -> Either ClientError a) -> IO a -> IO (Either ClientError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
m)
where
matchClientException :: SomeException -> Maybe ClientError
matchClientException =
SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe HttpException)
-> (HttpException -> Maybe ClientError)
-> SomeException
-> Maybe ClientError
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
HTTP.HttpExceptionRequest Request
req (HTTP.InternalException SomeException
e)
| Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (SomeException -> Maybe ()
isRetryableHTTPInternalException SomeException
e) ->
ClientError -> Maybe ClientError
forall a. a -> Maybe a
Just (ClientError -> Maybe ClientError)
-> ClientError -> Maybe ClientError
forall a b. (a -> b) -> a -> b
$ SomeException -> ClientError
ClientError.ConnectionError (SomeException -> ClientError) -> SomeException -> ClientError
forall a b. (a -> b) -> a -> b
$ HTTPInternalException -> SomeException
forall e. Exception e => e -> SomeException
toException (HTTPInternalException -> SomeException)
-> HTTPInternalException -> SomeException
forall a b. (a -> b) -> a -> b
$ Request -> SomeException -> HTTPInternalException
HTTPInternalException Request
req (SomeException -> HTTPInternalException)
-> SomeException -> HTTPInternalException
forall a b. (a -> b) -> a -> b
$ SomeException -> SomeException
forall e. Exception e => e -> SomeException
toException SomeException
e
HttpException
_ -> Maybe ClientError
forall a. Maybe a
Nothing
isRetryableHTTPInternalException :: SomeException -> Maybe ()
isRetryableHTTPInternalException =
SomeException -> Maybe TLSException
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe TLSException)
-> (TLSException -> Maybe ()) -> SomeException -> Maybe ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \TLSException
e -> case TLSException
e of
TLS.Terminated Bool
_mysteryBool String
_msg TLSError
tlsError
| TLSError -> Bool
isRetryableTLSError TLSError
tlsError ->
Maybe ()
forall (f :: * -> *). Applicative f => f ()
pass
TLSException
_ -> Maybe ()
forall a. Maybe a
Nothing
isRetryableTLSError :: TLSError -> Bool
isRetryableTLSError =
\case
TLS.Error_Protocol {} -> Bool
True
TLS.Error_EOF {} -> Bool
True
TLS.Error_Packet {} -> Bool
True
TLS.Error_Packet_unexpected {} -> Bool
True
TLS.Error_Packet_Parsing {} -> Bool
True
TLSError
_ -> Bool
False
clientErrorSummary :: ClientError -> Text
clientErrorSummary :: ClientError -> Text
clientErrorSummary (ClientError.FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
resp) = Text
"status " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Status -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Response -> Status
forall a. ResponseF a -> Status
responseStatusCode Response
resp)
clientErrorSummary ClientError.DecodeFailure {} = Text
"decode failure"
clientErrorSummary ClientError.UnsupportedContentType {} = Text
"unsupported content type"
clientErrorSummary ClientError.InvalidContentTypeHeader {} = Text
"invalid content type header"
clientErrorSummary (ClientError.ConnectionError SomeException
e) = Text
"connection error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall a b. (Show a, StringConv String b) => a -> b
show SomeException
e
simpleRetryPredicate :: (Applicative m) => (r -> Bool) -> RetryStatus -> r -> m Bool
simpleRetryPredicate :: forall (m :: * -> *) r.
Applicative m =>
(r -> Bool) -> RetryStatus -> r -> m Bool
simpleRetryPredicate r -> Bool
f RetryStatus
_rs r
r = Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> Bool
f r
r)
retryStreamOnFail ::
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text ->
(Token -> ClientM b) ->
(Either ClientError b -> IO c) ->
RIO r c
retryStreamOnFail :: forall r b c.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text
-> (Token -> ClientM b)
-> (Either ClientError b -> IO c)
-> RIO r c
retryStreamOnFail Text
shortDesc Token -> ClientM b
req Either ClientError b -> IO c
handler = Either ClientError c -> RIO r c
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate (Either ClientError c -> RIO r c)
-> RIO r (Either ClientError c) -> RIO r c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text
-> RIO r (Either ClientError c) -> RIO r (Either ClientError c)
forall r a.
Text
-> RIO r (Either ClientError a) -> RIO r (Either ClientError a)
retryOnFailEither Text
shortDesc (RIO r c -> RIO r (Either ClientError c)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try ((Token -> ClientM b) -> (Either ClientError b -> IO c) -> RIO r c
forall r a b.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> (Either ClientError a -> IO b) -> RIO r b
runHerculesClientStream Token -> ClientM b
req Either ClientError b -> IO c
handler))
retryOnFail ::
(NFData b, Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text ->
(Token -> ClientM b) ->
RIO r b
retryOnFail :: forall b r.
(NFData b, Has HerculesClientToken r, Has HerculesClientEnv r) =>
Text -> (Token -> ClientM b) -> RIO r b
retryOnFail Text
shortDesc Token -> ClientM b
req = Either ClientError b -> RIO r b
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate (Either ClientError b -> RIO r b)
-> RIO r (Either ClientError b) -> RIO r b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text
-> RIO r (Either ClientError b) -> RIO r (Either ClientError b)
forall r a.
Text
-> RIO r (Either ClientError a) -> RIO r (Either ClientError a)
retryOnFailEither Text
shortDesc ((Token -> ClientM b) -> RIO r (Either ClientError b)
forall a r.
(NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> RIO r (Either ClientError a)
runHerculesClientEither Token -> ClientM b
req)
retryOnFailEither ::
Text ->
RIO r (Either ClientError a) ->
RIO r (Either ClientError a)
retryOnFailEither :: forall r a.
Text
-> RIO r (Either ClientError a) -> RIO r (Either ClientError a)
retryOnFailEither Text
shortDesc RIO r (Either ClientError a)
req =
RetryPolicyM (RIO r)
-> (RetryStatus -> Either ClientError a -> RIO r Bool)
-> (RetryStatus -> RIO r (Either ClientError a))
-> RIO r (Either ClientError a)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying
RetryPolicyM (RIO r)
forall (m :: * -> *). MonadIO m => RetryPolicyM m
failureRetryPolicy
((Either ClientError a -> Bool)
-> RetryStatus -> Either ClientError a -> RIO r Bool
forall (m :: * -> *) r.
Applicative m =>
(r -> Bool) -> RetryStatus -> r -> m Bool
simpleRetryPredicate Either ClientError a -> Bool
forall r. Either ClientError r -> Bool
shouldRetryResponse)
( \RetryStatus
rs -> do
Bool -> RIO r () -> RIO r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RetryStatus -> Int
rsIterNumber RetryStatus
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) do
IO () -> RIO r ()
forall a. IO a -> RIO r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO r ()) -> IO () -> RIO r ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
shortDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" retrying."
Either ClientError a
r <- RIO r (Either ClientError a)
req
Maybe ClientError -> (ClientError -> RIO r ()) -> RIO r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Either ClientError a -> Maybe ClientError
forall l r. Either l r -> Maybe l
leftToMaybe Either ClientError a
r) \ClientError
e -> do
IO () -> RIO r ()
forall a. IO a -> RIO r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO r ()) -> IO () -> RIO r ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
shortDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" encountered " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ClientError -> Text
clientErrorSummary ClientError
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
Bool -> RIO r () -> RIO r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientError -> Bool
shouldRetryClientError ClientError
e) do
IO () -> RIO r ()
forall a. IO a -> RIO r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO r ()) -> IO () -> RIO r ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"hci: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
shortDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" will retry."
Either ClientError a -> RIO r (Either ClientError a)
forall a. a -> RIO r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ClientError a
r
)
failureRetryPolicy :: (MonadIO m) => RetryPolicyM m
failureRetryPolicy :: forall (m :: * -> *). MonadIO m => RetryPolicyM m
failureRetryPolicy = Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
capDelay (Int
120 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) (Int -> RetryPolicyM m
forall (m :: * -> *). MonadIO m => Int -> RetryPolicyM m
fullJitterBackoff Int
100000)
waitRetryPolicy :: (MonadIO m) => RetryPolicyM m
waitRetryPolicy :: forall (m :: * -> *). MonadIO m => RetryPolicyM m
waitRetryPolicy = Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
capDelay (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) (Int -> RetryPolicyM m
forall (m :: * -> *). MonadIO m => Int -> RetryPolicyM m
fullJitterBackoff Int
500000)