hercules-ci-api-0.8.0.0: Hercules CI API definition with Servant
Safe HaskellSafe-Inferred
LanguageHaskell2010

Hercules.API.State

Synopsis

Documentation

type ContentLength = Header "Content-Length" Integer Source #

type ContentDisposition = Header "Content-Disposition" Text Source #

data ProjectStateResourceGroup auth f Source #

Constructors

ProjectStateResourceGroup 

Fields

Instances

Instances details
Generic (ProjectStateResourceGroup auth f) Source # 
Instance details

Defined in Hercules.API.State

Associated Types

type Rep (ProjectStateResourceGroup auth f) :: Type -> Type #

type Rep (ProjectStateResourceGroup auth f) Source # 
Instance details

Defined in Hercules.API.State

type Rep (ProjectStateResourceGroup auth f) = D1 ('MetaData "ProjectStateResourceGroup" "Hercules.API.State" "hercules-ci-api-0.8.0.0-inplace" 'False) (C1 ('MetaCons "ProjectStateResourceGroup" 'PrefixI 'True) ((S1 ('MetaSel ('Just "putStateData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Upload a state file" :> ("state" :> (Capture' '[Required, Strict] "stateName" Text :> ("data" :> (StreamBody NoFraming OctetStream (SourceIO RawBytes) :> (auth :> Put '[JSON] NoContent)))))))) :*: S1 ('MetaSel ('Just "getStates") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "List all state files" :> ("states" :> (auth :> Get '[JSON] ProjectState)))))) :*: (S1 ('MetaSel ('Just "getStateData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (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)))))))))) :*: S1 ('MetaSel ('Just "acquireLock") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- (Summary "Acquire a lock" :> ("lock" :> (Capture' '[Required, Strict] "lockName" Text :> (ReqBody '[JSON] StateLockAcquireRequest :> (auth :> Post '[JSON] StateLockAcquireResponse))))))))))

data StateAPI auth f Source #

Constructors

StateAPI 

Fields

Instances

Instances details
Generic (StateAPI auth f) Source # 
Instance details

Defined in Hercules.API.State

Associated Types

type Rep (StateAPI auth f) :: Type -> Type #

Methods

from :: StateAPI auth f -> Rep (StateAPI auth f) x #

to :: Rep (StateAPI auth f) x -> StateAPI auth f #

type Rep (StateAPI auth f) Source # 
Instance details

Defined in Hercules.API.State

type Rep (StateAPI auth f) = D1 ('MetaData "StateAPI" "Hercules.API.State" "hercules-ci-api-0.8.0.0-inplace" 'False) (C1 ('MetaCons "StateAPI" 'PrefixI 'True) ((S1 ('MetaSel ('Just "byProjectId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- Substitute ("projects" :> (Capture' '[Required, Strict] "projectId" (Id Project) :> Placeholder)) (ToServantApi (ProjectStateResourceGroup auth)))) :*: S1 ('MetaSel ('Just "byProjectName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- Substitute ("site" :> (Capture' '[Required, Strict] "site" (Name Forge) :> ("account" :> (Capture' '[Required, Strict] "account" (Name Account) :> ("project" :> (Capture' '[Required, Strict] "project" (Name Project) :> Placeholder)))))) (ToServantApi (ProjectStateResourceGroup auth))))) :*: (S1 ('MetaSel ('Just "updateLockLease") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- ("lock-leases" :> (Capture' '[Required, Strict] "lockLeaseId" (Id "StateLockLease") :> (ReqBody '[JSON] StateLockUpdateRequest :> (auth :> Post '[JSON] StateLockAcquiredResponse)))))) :*: S1 ('MetaSel ('Just "deleteLockLease") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f :- ("lock-leases" :> (Capture' '[Required, Strict] "lockLeaseId" (Id "StateLockLease") :> (auth :> Delete '[JSON] NoContent))))))))