packages feed

hercules-ci-api (empty) → 0.6.0.0

raw patch · 67 files changed

+2240/−0 lines, 67 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, containers, cookie, exceptions, hashable, hercules-ci-api, hercules-ci-api-core, http-api-data, http-media, lens, lens-aeson, memory, network-uri, profunctors, servant, servant-auth, servant-auth-swagger, servant-swagger, servant-swagger-ui-core, string-conv, swagger2, text, time, uuid

Files

+ CHANGELOG.md view
@@ -0,0 +1,77 @@+# Changelog++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/)+and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).++## [0.6.0.0] - 2020-03-07++### Added++ - Build logs+ - Evaluation log+ - Attribute types+ - Effects+ - State files+ - CLI authorization flow+ - Endpoint for resolving git urls to projects++### Changed++ - Adaptations to support servant streaming++## [0.5.0.0] - 2020-01-30++### Changed++- `hercules-ci-api-core` and `hercules-ci-api-agent` packages have been extracted.++### Added++- Account settings+- Project enable/disable+- Some authorization-related fields+- Billing+- Derivation info and events+- Job derivation statistics and improved status reporting+- Derivation and Job restarts+- Job cancellation++## [0.4.0.0] - 2019-08-30++### Fixed++- Swagger schema was wrong for a Result+- Swagger schema is now written using UTF-8 encoding++### Changed++- /jobs endpoint changed to be hierarchical++### Added++- Submit number of concurrent tasks to the backend for better scheduling of evaluations (to avoid IFD deadlocks)++- New endpoint to return evaluation build dependencies for IFD+++## [0.3.0.0] - 2019-07-05++### Added++- The CachixCache JSON format for configuring binary caches.++- Endpoints for lifecycle management: hello, hearbeat, goodbye.++- requiredFeatures support++## 0.1.0.0++Initial release++[0.6.0.0]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.4.0.0...hercules-ci-api-0.6.0.0+[0.5.0.0]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.4.0.0...hercules-ci-api-0.5.0.0+[0.4.0.0]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.3.0.0...hercules-ci-api-0.4.0.0+[0.3.0.0]: https://github.com/hercules-ci/hercules-ci-agent/compare/hercules-ci-agent-0.1.0.0...hercules-ci-api-0.3.0.0+[Unreleased]: https://github.com/hercules-ci/hercules-ci-agent/compare/stable...master
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ hercules-ci-api.cabal view
@@ -0,0 +1,182 @@+cabal-version:      1.12+name:               hercules-ci-api+version:            0.6.0.0+synopsis:           Hercules CI API definition with Servant+homepage:           https://github.com/hercules-ci/hercules-ci-agent#readme+bug-reports:        https://github.com/hercules-ci/hercules-ci-agent/issues+author:             Hercules CI contributors+maintainer:         info@hercules-ci.com+copyright:          2018-2021 Hercules CI+license:            Apache-2.0+build-type:         Simple+extra-source-files: CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/hercules-ci/hercules-ci++library+  exposed-modules:+    Hercules.API+    Hercules.API.Accounts+    Hercules.API.Accounts.Account+    Hercules.API.Accounts.AccountSettings+    Hercules.API.Accounts.AccountSettingsPatch+    Hercules.API.Accounts.CLIAuthorizationRequest+    Hercules.API.Accounts.CLIAuthorizationRequestCreate+    Hercules.API.Accounts.CLIAuthorizationRequestCreateResponse+    Hercules.API.Accounts.CLIAuthorizationRequestStatus+    Hercules.API.Agents+    Hercules.API.Agents.AgentInfo+    Hercules.API.Agents.AgentSession+    Hercules.API.Agents.AgentSessionCreated+    Hercules.API.Agents.ClusterJoinToken+    Hercules.API.Agents.CreateClusterJoinToken+    Hercules.API.Agents.FullClusterJoinToken+    Hercules.API.Attribute+    Hercules.API.Auth+    Hercules.API.BillingStatus+    Hercules.API.Build+    Hercules.API.Build.AgentRequirements+    Hercules.API.Build.DerivationEvent+    Hercules.API.Build.DerivationEvent.BuiltOutput+    Hercules.API.Build.DerivationInfo+    Hercules.API.Build.DerivationInfo.DerivationInput+    Hercules.API.Build.DerivationInfo.DerivationOutput+    Hercules.API.Build.EvaluationDependency+    Hercules.API.Build.EvaluationDetail+    Hercules.API.Build.FailureGraph+    Hercules.API.Build.Log+    Hercules.API.Build.LogLine+    Hercules.API.Derivation+    Hercules.API.Effects+    Hercules.API.Effects.EffectEvent+    Hercules.API.Effects.EffectInfo+    Hercules.API.Evaluation.AttributeError+    Hercules.API.Evaluation.Evaluation+    Hercules.API.Health+    Hercules.API.Message+    Hercules.API.Organizations+    Hercules.API.Organizations.BillingInfo+    Hercules.API.Organizations.CreateOrganization+    Hercules.API.Organizations.Organization+    Hercules.API.Organizations.PaymentLink+    Hercules.API.Orphans+    Hercules.API.Projects+    Hercules.API.Projects.CreateProject+    Hercules.API.Projects.CreateUserEffectTokenResponse+    Hercules.API.Projects.Job+    Hercules.API.Projects.PatchProject+    Hercules.API.Projects.Project+    Hercules.API.Projects.SimpleJob+    Hercules.API.Repos+    Hercules.API.Repos.Repo+    Hercules.API.Repos.RepoKey+    Hercules.API.Result+    Hercules.API.Servant.Status+    Hercules.API.SourceHostingSite.SourceHostingSite+    Hercules.API.State+    Hercules.API.State.ProjectState+    Hercules.API.State.StateFile+    Hercules.API.State.StateVersion+    Hercules.Frontend++  hs-source-dirs:     src+  default-extensions:+    NoImplicitPrelude+    DeriveGeneric+    DeriveTraversable+    DisambiguateRecordFields+    FlexibleContexts+    InstanceSigs+    LambdaCase+    MultiParamTypeClasses+    OverloadedStrings+    RankNTypes+    TupleSections+    TypeApplications+    TypeOperators++  ghc-options:+    -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures+    -fwarn-name-shadowing -fwarn-incomplete-patterns++  build-depends:+      aeson+    , base                     >=4.7    && <5+    , bytestring+    , containers+    , cookie+    , exceptions+    , hashable+    , hercules-ci-api-core+    , http-api-data+    , http-media+    , lens+    , lens-aeson+    , memory+    , network-uri+    , profunctors+    , servant                  >=0.14.1+    , servant-auth+    , servant-auth-swagger+    , servant-swagger+    , servant-swagger-ui-core+    , string-conv+    , swagger2+    , text+    , time+    , uuid++  default-language:   Haskell2010++executable hercules-gen-swagger+  main-is:            Main.hs+  hs-source-dirs:     hercules-gen-swagger+  default-extensions:+    NoImplicitPrelude+    DeriveGeneric+    DeriveTraversable+    DisambiguateRecordFields+    FlexibleContexts+    InstanceSigs+    LambdaCase+    MultiParamTypeClasses+    OverloadedStrings+    RankNTypes+    TupleSections+    TypeApplications+    TypeOperators++  ghc-options:+    -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures+    -fwarn-name-shadowing -fwarn-incomplete-patterns -threaded -rtsopts+    -with-rtsopts=-N++  build-depends:+      aeson+    , base+    , bytestring+    , containers+    , cookie+    , exceptions+    , hashable+    , hercules-ci-api+    , http-api-data+    , http-media+    , lens+    , memory+    , network-uri+    , profunctors+    , servant+    , servant-auth+    , servant-auth-swagger+    , servant-swagger+    , servant-swagger-ui-core+    , string-conv+    , swagger2+    , text+    , time+    , uuid++  default-language:   Haskell2010
+ hercules-gen-swagger/Main.hs view
@@ -0,0 +1,12 @@+module Main+  ( main,+  )+where++import Data.Aeson (encode)+import Data.String.Conv (toS)+import Hercules.API (swagger)+import Prelude++main :: IO ()+main = putStrLn $ toS $ encode swagger
+ src/Hercules/API.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Hercules.API+  ( api,+    servantApi,+    servantClientApi,+    swagger,+    useApi,+    API,+    ClientAuth,+    HerculesAPI (..),+    ClientAPI (..),+    HerculesServantAPI,+    AddAPIVersion,+    Id,+    Name,+    Result (..),++    -- * Reexports+    NoContent (..),++    -- * Utilities+    noContent,+  )+where++import Control.Lens+import Control.Monad+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.Effects (EffectsAPI)+import Hercules.API.Health (HealthAPI)+import Hercules.API.Id (Id)+import Hercules.API.Name (Name)+import Hercules.API.Organizations (OrganizationsAPI)+import Hercules.API.Orphans ()+import Hercules.API.Projects (ProjectsAPI)+import Hercules.API.Repos (ReposAPI)+import Hercules.API.Result (Result (..))+import Hercules.API.State (StateAPI)+import Servant.API+import Servant.API.Generic+import Servant.Auth+import Servant.Auth.Swagger ()+import Servant.Swagger+import Servant.Swagger.UI.Core (SwaggerSchemaUI)+import Prelude++-- TODO remove health so we get clientapi+data HerculesAPI auth f = HerculesAPI+  { accounts :: f :- ToServantApi (AccountsAPI auth),+    repos :: f :- ToServantApi (ReposAPI auth),+    projects :: f :- ToServantApi (ProjectsAPI auth),+    agents :: f :- ToServantApi (AgentsAPI auth),+    build :: f :- ToServantApi (Client.BuildAPI auth),+    effects :: f :- ToServantApi (EffectsAPI auth),+    health :: f :- ToServantApi (HealthAPI auth),+    organizations :: f :- ToServantApi (OrganizationsAPI auth),+    state :: f :- ToServantApi (StateAPI auth)+  }+  deriving (Generic)++data ClientAPI auth f = ClientAPI+  { clientAccounts :: f :- ToServantApi (AccountsAPI auth),+    clientRepos :: f :- ToServantApi (ReposAPI auth),+    clientProjects :: f :- ToServantApi (ProjectsAPI auth),+    clientAgents :: f :- ToServantApi (AgentsAPI auth),+    clientBuild :: f :- ToServantApi (Client.BuildAPI auth),+    clientEffects :: f :- ToServantApi (EffectsAPI auth),+    clientOrganizations :: f :- ToServantApi (OrganizationsAPI auth),+    clientState :: f :- ToServantApi (StateAPI auth)+  }+  deriving (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 = Proxy++servantClientApi :: Proxy (ClientServantAPI auth)+servantClientApi = Proxy++type API auth =+  (HerculesServantAPI auth)+    :<|> "api"+    :> SwaggerSchemaUI "v1" "swagger.json"++api :: Proxy (API auth)+api = Proxy++swagger :: Swagger+swagger =+  toSwagger (servantClientApi @(Auth '[JWT] ()))+    & info+      . title+    .~ "Hercules CI API"+    & info+      . version+    .~ "v1"+    & info+      . description+    ?~ "You have reached the Hercules Continuous Integration Application Programming Interface. This user interface provides human friendly access to the various endpoints. To get started with Hercules CI, see hercules-ci.com. Happy building! —the Hercules team"++-- | Postcomposes 'Servant.API.Generic.fromServant' to an accessor,+-- preserving the mode parameter, because otherwise the mode parameter+-- can not be inferred.+--+-- Ideally, this functionality would be built into a new combinator.+useApi ::+  (GenericServant f mode, GenericServant g mode) =>+  (f mode -> ToServant g mode) ->+  f mode ->+  g mode+useApi = (Servant.API.Generic.fromServant .)++-- | 'Control.Monad.void' specialised to 'NoContent' to soothe the+-- compiler that rightfully warns about throwing away a do notation+-- result. By specialising, we make sure that we still get warnings+-- if the result type changes in the future. (We'll get an error)+noContent :: Functor m => m Servant.API.NoContent -> m ()+noContent = void
+ src/Hercules/API/Accounts.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Accounts where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Accounts.AccountSettings (AccountSettings)+import Hercules.API.Accounts.AccountSettingsPatch (AccountSettingsPatch)+import Hercules.API.Accounts.CLIAuthorizationRequest (CLIAuthorizationRequest)+import Hercules.API.Accounts.CLIAuthorizationRequestCreate (CLIAuthorizationRequestCreate)+import Hercules.API.Accounts.CLIAuthorizationRequestCreateResponse (CLIAuthorizationRequestCreateResponse)+import Hercules.API.Accounts.CLIAuthorizationRequestStatus (CLIAuthorizationRequestStatus)+import Hercules.API.Prelude+import Hercules.API.SourceHostingSite.SourceHostingSite+  ( SourceHostingSite,+  )+import Servant.API+import Servant.API.Generic+import Servant.Auth ()++data AccountsAPI auth f = AccountsAPI+  { myAccount ::+      f+        :- Summary "The account of the authenticated user."+        :> "accounts"+        :> "me"+        :> auth+        :> Get '[JSON] Account,+    findAccounts ::+      f+        :- Summary "Accounts that the authenticated user owns, admins or collaborates with."+        :> "accounts"+        :> QueryParam "site" (Name SourceHostingSite)+        :> QueryParam "name" (Name Account)+        :> auth+        :> Get '[JSON] [Account],+    getAccountSettings ::+      f :- Summary "Retrieve the account settings"+        :> "accounts"+        :> Capture "accountId" (Id Account)+        :> "settings"+        :> auth+        :> Get '[JSON] AccountSettings,+    patchAccountSettings ::+      f :- Summary "Update the account settings"+        :> "accounts"+        :> Capture "accountId" (Id Account)+        :> "settings"+        :> ReqBody '[JSON] AccountSettingsPatch+        :> auth+        :> Patch '[JSON] AccountSettings,+    postCLIAuthorizationRequest ::+      f :- Summary "Create a request to authorize the CLI."+        :> "auth"+        :> "cli"+        :> "authorization"+        :> "request"+        :> ReqBody '[JSON] CLIAuthorizationRequestCreate+        :> Post '[JSON] CLIAuthorizationRequestCreateResponse,+    getCLIAuthorizationRequestStatus ::+      f :- Summary "Check the request status"+        :> "auth"+        :> "cli"+        :> "authorization"+        :> "request"+        :> "status"+        :> Capture "temporaryToken" Text+        :> Get '[JSON] CLIAuthorizationRequestStatus,+    getCLIAuthorizationRequest ::+      f :- Summary "Retrieve the request"+        :> "auth"+        :> "cli"+        :> "authorization"+        :> "request"+        :> Capture "browserToken" Text+        :> auth+        :> Get '[JSON] CLIAuthorizationRequest,+    confirmCLIAuthorizationRequest ::+      f :- Summary "Retrieve the request"+        :> "auth"+        :> "cli"+        :> "authorization"+        :> "request"+        :> Capture "browserToken" Text+        :> "confirm"+        :> auth+        :> Post '[JSON] NoContent,+    postDisableAllProjects ::+      f :- Summary "Disable all projects in the account."+        :> "accounts"+        :> Capture "accountId" (Id Account)+        :> "disable-all-projects"+        :> auth+        :> Post '[JSON] Int+  }+  deriving (Generic)
+ src/Hercules/API/Accounts/Account.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Accounts.Account where++import qualified Hercules.API.Organizations.Organization as Organization+import Hercules.API.Prelude+import Hercules.API.SourceHostingSite.SourceHostingSite (SourceHostingSite)++data AccountType = User | Organization+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data MembershipRole = Member | Admin+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data Account = Account+  { id :: Id Account,+    sourceHostingSiteSlug :: Text,+    slug :: Text,+    typ :: AccountType,+    displayName :: Text,+    imageURL :: Text,+    organization :: Maybe Organization.Organization,+    -- | Whether Hercules CI is installed on this account as an App.+    --+    -- An account that does not have an installation can not be+    -- properly accessed by Hercules, but may be visible nonetheless+    -- at times because of OAuth scopes.+    --+    -- As an example, non-installed accounts show up when a GitHub+    -- user signs in for the first time via OAuth, until they decide+    -- to install it on their GitHub user. Another example is GitHub+    -- organizations that don't have an installation yet.+    isInstalled :: Bool,+    -- | Whether the current user has permission in the to installing+    -- Hercules CI on this account.+    isInstallable :: Bool,+    membershipRole :: Maybe MembershipRole,+    sourceHostingSites :: Maybe (Map Text SourceHostingSite)+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Accounts/AccountSettings.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Accounts.AccountSettings where++import Hercules.API.Prelude++data AccountSettings = AccountSettings+  { -- | When a new repo is created/installed, enable building it?+    enableNewRepos :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Accounts/AccountSettingsPatch.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Accounts.AccountSettingsPatch where++import Hercules.API.Prelude++data AccountSettingsPatch = AccountSettingsPatch+  { enableNewRepos :: Maybe Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Accounts/CLIAuthorizationRequest.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Accounts.CLIAuthorizationRequest where++import Hercules.API.Prelude++data CLIAuthorizationRequest = CLIAuthorizationRequest+  { description :: Text,+    creationTime :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Accounts/CLIAuthorizationRequestCreate.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Accounts.CLIAuthorizationRequestCreate where++import Hercules.API.Prelude++data CLIAuthorizationRequestCreate = CLIAuthorizationRequestCreate+  { description :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Accounts/CLIAuthorizationRequestCreateResponse.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Accounts.CLIAuthorizationRequestCreateResponse where++import Hercules.API.Prelude++data CLIAuthorizationRequestCreateResponse = CLIAuthorizationRequestCreateResponse+  { temporaryCLIToken :: Text,+    browserURL :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Accounts/CLIAuthorizationRequestStatus.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Accounts.CLIAuthorizationRequestStatus where++import Hercules.API.Prelude++data CLIAuthorization = CLIAuthorization+  { token :: Text,+    userIdentities :: [Text]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data CLIAuthorizationStatus = Pending () | Granted CLIAuthorization+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data CLIAuthorizationRequestStatus = CLIAuthorizationRequestStatus+  { status :: CLIAuthorizationStatus+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Agents.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}++module Hercules.API.Agents where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Agents.AgentSession+  ( AgentSession,+  )+import Hercules.API.Agents.ClusterJoinToken+  ( ClusterJoinToken,+  )+import Hercules.API.Agents.CreateClusterJoinToken+  ( CreateClusterJoinToken,+  )+import Hercules.API.Agents.FullClusterJoinToken+  ( FullClusterJoinToken,+  )+import Hercules.API.Prelude+import Servant.API+import Servant.API.Generic++data AgentsAPI auth f = AgentsAPI+  { clusterJoinTokensByAccount ::+      f+        :- Summary "List all cluster join tokens in an account." -- TODO rename+        :> "accounts"+        :> Capture' '[Required, Strict] "accountId" (Id Account)+        :> "clusterJoinTokens"+        :> auth+        :> Get '[JSON] [ClusterJoinToken],+    clusterJoinTokenCreate ::+      f+        :- 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,+    clusterJoinTokenDelete ::+      f+        :- 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,+    agentSessionsByAccount ::+      f+        :- Summary "Show the agents sessions owned by the account."+        :> "accounts"+        :> Capture' '[Required, Strict] "accountId" (Id Account)+        :> "agentSessions"+        :> auth+        :> Get '[JSON] [AgentSession]+  }+  deriving (Generic)
+ src/Hercules/API/Agents/AgentInfo.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agents.AgentInfo where++import Control.Applicative+import Control.Lens (at, (%~))+import qualified Data.Aeson as A+import Data.Aeson.Lens (_Object)+import Hercules.API.Prelude++data AgentInfo = AgentInfo+  { hostname :: Text,+    agentVersion :: Text,+    nixVersion :: Text,+    platforms :: [Text],+    systemFeatures :: [Text],+    cachixPushCaches :: [Text],+    substituters :: [Text],+    concurrentTasks :: Int+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, ToSchema)++instance FromJSON AgentInfo where+  parseJSON = A.genericParseJSON A.defaultOptions . fixup+    where+      fixup :: A.Value -> A.Value+      fixup = _Object . at "concurrentTasks" %~ (<|> Just (A.Number 2))
+ src/Hercules/API/Agents/AgentSession.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agents.AgentSession where++import Hercules.API.Agents.ClusterJoinToken+  ( ClusterJoinToken,+  )+import Hercules.API.Prelude++data AgentSession = AgentSession+  { id :: Id AgentSession,+    clusterJoinTokenId :: Id ClusterJoinToken,+    description :: Text,+    hostname :: Text,+    agentVersion :: Text,+    nixVersion :: Text,+    platforms :: [Text],+    systemFeatures :: [Text],+    cachixPushCaches :: [Text],+    substituters :: [Text],+    creation :: UTCTime,+    lastSeen :: Maybe UTCTime,+    available :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Agents/AgentSessionCreated.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agents.AgentSessionCreated where++import Hercules.API.Agents.AgentSession+  ( AgentSession,+  )+import Hercules.API.Agents.ClusterJoinToken+  ( ClusterJoinToken,+  )+import Hercules.API.Prelude++data AgentSessionCreated = AgentSessionCreated+  { hostname :: Text,+    id :: Id AgentSession,+    tokenId :: Id ClusterJoinToken,+    description :: Text,+    agentVersion :: Text,+    nixVersion :: Text,+    architectures :: [Text],+    creation :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Agents/ClusterJoinToken.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agents.ClusterJoinToken where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude++data ClusterJoinToken = ClusterJoinToken+  { id :: Id ClusterJoinToken,+    ownerId :: Id Account,+    creationTime :: UTCTime,+    -- TODO lastAccessTime :: Maybe UTCTime+    description :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Agents/CreateClusterJoinToken.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agents.CreateClusterJoinToken where++import Hercules.API.Prelude++-- The owner account that the token applies to is in the path.+data CreateClusterJoinToken = CreateClusterJoinToken+  { description :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Agents/FullClusterJoinToken.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agents.FullClusterJoinToken where++import Hercules.API.Agents.ClusterJoinToken+  ( ClusterJoinToken,+  )+import Hercules.API.Prelude++data FullClusterJoinToken = FullClusterJoinToken+  { metadata :: ClusterJoinToken,+    token :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Attribute.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}++module Hercules.API.Attribute where++import Control.Applicative (Alternative ((<|>)))+import Control.Lens (at, (%~))+import qualified Data.Aeson as A+import Data.Aeson.Lens+import Data.Proxy (Proxy (Proxy))+import Data.Swagger (ToParamSchema (..))+import qualified Data.Text as T+import Hercules.API.Prelude+import Servant.API (FromHttpApiData (..), ToHttpApiData (..))+import Prelude ()++data AttributeType+  = Regular+  | MustFail+  | MayFail+  | DependenciesOnly+  | Effect+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++-- | An arbitrary ordering+deriving instance Ord AttributeType++data Attribute a = Attribute+  { path :: [Text],+    value :: a,+    typ :: AttributeType+  }+  deriving (Generic, Show, Eq, NFData, ToJSON)++instance FromJSON a => FromJSON (Attribute a) where+  parseJSON v = A.parseJSON (fixup v)+    where+      fixup :: A.Value -> A.Value+      fixup = _Object . at "typ" %~ (<|> Just (A.String "Regular"))++deriving instance ToSchema a => ToSchema (Attribute a)++deriving instance Functor Attribute++deriving instance Foldable Attribute++deriving instance Traversable Attribute++newtype AttributePath = AttributePath {fromAttributePath :: [Text]}+  deriving (Generic, Eq, NFData)++instance FromHttpApiData AttributePath where+  -- TODO parse properly+  parseUrlPiece = Right . AttributePath . T.split (== '.')++  parseQueryParam = parseUrlPiece++instance ToParamSchema AttributePath where+  toParamSchema _ = toParamSchema (Proxy :: Proxy Text)++instance ToHttpApiData AttributePath where+  toUrlPiece = toUrlPiece . T.intercalate "." . fromAttributePath
+ src/Hercules/API/Auth.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Auth where++import Hercules.API.Prelude+import Hercules.API.Servant.Status+import Servant.API+import Servant.API.Generic++-- | Endpoints for authentication+data AuthAPI f = AuthAPI+  { initiateGitHubLogin ::+      f+        :- "api"+        :> "auth"+        :> "github"+        :> QueryParam' '[Optional, Strict] "redirect" Text+        :> Get302 '[PlainText, JSON] '[]+  }+  deriving (Generic)
+ src/Hercules/API/BillingStatus.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.BillingStatus+  ( BillingStatus (..),+    toText,+    fromText,+  )+where++import Data.Swagger+import Hercules.API.Prelude++data BillingStatus+  = Community -- Free plan+  | Trial+  | Active+  | Cancelled+  | External+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++toText :: BillingStatus -> Text+toText Community = "Community"+toText Trial = "Trial"+toText Active = "Active"+toText Cancelled = "Cancelled"+toText External = "External"++fromText :: Text -> Maybe BillingStatus+fromText "Community" = Just Community+fromText "Cancelled" = Just Cancelled+fromText "Trial" = Just Trial+fromText "Active" = Just Active+fromText "External" = Just External+fromText _ = Nothing
+ src/Hercules/API/Build.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Build where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Build.DerivationInfo (DerivationInfo)+import Hercules.API.Build.Log (Log)+import Hercules.API.Prelude+import Hercules.API.Projects.Job (Job)+import Servant.API+import Servant.API.Generic++data BuildAPI auth f = BuildAPI+  { restartDerivation ::+      f+        :- Summary "Restart a failed derivation"+        :> "accounts"+        :> Capture "accountId" (Id Account)+        :> "derivations"+        :> Capture "derivationPath" Text+        :> "retry"+        :> auth+        :> Post '[PlainText, JSON] NoContent,+    readDerivationLogText ::+      f+        :- 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, -- NB: We use JSON only to be able to generate elm api+        -- FIXME: bytes?+    getLog ::+      f :- 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,+    getDerivationInfo ::+      f :- 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+  }+  deriving (Generic)
+ src/Hercules/API/Build/AgentRequirements.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.AgentRequirements where++import Hercules.API.Prelude++data AgentRequirements = AgentRequirements+  { platform :: Text,+    requiredSystemFeatures :: [Text]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/DerivationEvent.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Hercules.API.Build.DerivationEvent where++import Data.Aeson.Types (FromJSON (..), ToJSON (..), genericParseJSON, genericToEncoding, genericToJSON)+import Hercules.API.Build.DerivationEvent.BuiltOutput+import Hercules.API.Prelude+import Hercules.API.Projects.SimpleJob (SimpleJob)++data DerivationEvent+  = Queued DerivationEventQueued+  | DependencyFailed DerivationEventDependencyFailed+  | Started DerivationEventStarted+  | Reset DerivationEventReset+  | Failed DerivationEventFailed+  | Succeeded DerivationEventSucceeded+  | Cancelled DerivationEventCancelled+  | Built DerivationEventBuilt+  deriving (Generic, Show, Eq, NFData, ToSchema)++instance FromJSON DerivationEvent where+  parseJSON = genericParseJSON schemaCompatibleOptions++instance ToJSON DerivationEvent where+  toJSON = genericToJSON schemaCompatibleOptions++  toEncoding = genericToEncoding schemaCompatibleOptions++eventTime :: DerivationEvent -> UTCTime+eventTime (Queued (DerivationEventQueued {time = t})) = t+eventTime (DependencyFailed (DerivationEventDependencyFailed {time = t})) = t+eventTime (Started (DerivationEventStarted {time = t})) = t+eventTime (Reset (DerivationEventReset {time = t})) = t+eventTime (Failed (DerivationEventFailed {time = t})) = t+eventTime (Succeeded (DerivationEventSucceeded {time = t})) = t+eventTime (Cancelled (DerivationEventCancelled {time = t})) = t+eventTime (Built (DerivationEventBuilt {time = t})) = t++data DerivationEventQueued = DerivationEventQueued+  { time :: UTCTime,+    requeuedForEvalOfJob :: Maybe SimpleJob,+    requeuedForAgent :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationEventDependencyFailed = DerivationEventDependencyFailed+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationEventStarted = DerivationEventStarted+  { time :: UTCTime,+    logId :: Id "log",+    agentHostname :: Maybe Text,+    streamable :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationEventReset = DerivationEventReset+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationEventFailed = DerivationEventFailed+  { time :: UTCTime,+    technicalError :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationEventSucceeded = DerivationEventSucceeded+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationEventCancelled = DerivationEventCancelled+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationEventBuilt = DerivationEventBuilt+  { time :: UTCTime,+    outputs :: [BuiltOutput]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/DerivationEvent/BuiltOutput.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.DerivationEvent.BuiltOutput where++import Hercules.API.Prelude++data BuiltOutput = BuiltOutput+  { outputName :: Text,+    outputPath :: Text,+    hash :: Text,+    size :: Int64+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/DerivationInfo.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.DerivationInfo where++import Hercules.API.Build.DerivationEvent (DerivationEvent)+import Hercules.API.Build.DerivationInfo.DerivationInput (DerivationInput)+import Hercules.API.Build.DerivationInfo.DerivationOutput (DerivationOutput)+import Hercules.API.Derivation (DerivationStatus)+import Hercules.API.Prelude+import Hercules.API.Projects.Job (Job)+import Hercules.API.Projects.Project (Project)++data DerivationInfo = DerivationInfo+  { status :: DerivationStatus,+    viaJob :: Maybe Job,+    viaProject :: Maybe Project,+    platform :: Text,+    requiredSystemFeatures :: [Text],+    inputDerivations :: [DerivationInput],+    outputs :: [DerivationOutput],+    usedInProjects :: [Project],+    events :: [[DerivationEvent]],+    mayRestart :: Bool,+    dummy :: Maybe DerivationEvent -- TODO: remove and update/fix codegen+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/DerivationInfo/DerivationInput.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.DerivationInfo.DerivationInput where++import Hercules.API.Derivation (DerivationStatus)+import Hercules.API.Prelude++data DerivationInput = DerivationInput+  { derivationStatus :: DerivationStatus,+    derivationPath :: Text,+    outputName :: Text,+    outputPath :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/DerivationInfo/DerivationOutput.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.DerivationInfo.DerivationOutput where++import Hercules.API.Prelude++data DerivationOutput = DerivationOutput+  { outputName :: Text,+    outputPath :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/EvaluationDependency.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.EvaluationDependency where++import Hercules.API.Derivation (Derivation)+import Hercules.API.Prelude++data EvaluationDependency = EvaluationDependency+  { index :: Int,+    derivation :: Derivation,+    outputName :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/EvaluationDetail.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.EvaluationDetail where++import Hercules.API.Attribute (Attribute)+import Hercules.API.Build.AgentRequirements (AgentRequirements)+import Hercules.API.Build.EvaluationDependency+  ( EvaluationDependency,+  )+import Hercules.API.Derivation (Derivation, DerivationStatus)+import Hercules.API.Evaluation.AttributeError+  ( AttributeError,+  )+import Hercules.API.Evaluation.Evaluation+  ( Evaluation,+  )+import Hercules.API.Message (Message)+import Hercules.API.Prelude+import Hercules.API.Result (Result)++data EvaluationDetail = EvaluationDetail+  { id :: Id Evaluation,+    agentHostname :: Text,+    agentVersion :: Text,+    messages :: [Message],+    attributes :: [Attribute (Result AttributeError Derivation)],+    evaluationDependencies :: [EvaluationDependency],+    evaluationLog :: Maybe (Id "log"),+    -- | A set of (path, derivationstatus) that is relevant to the evaluation+    derivations :: Map Text DerivationStatus,+    derivationsWaitingCount :: Int,+    derivationsBuildingCount :: Int,+    derivationsBuildFailureCount :: Int,+    derivationsDependencyFailureCount :: Int,+    derivationsBuildSuccessCount :: Int,+    derivationsCancelledCount :: Int,+    unmetAgentRequirements :: [AgentRequirements]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/FailureGraph.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.FailureGraph where++import Hercules.API.Derivation (Derivation)+import Hercules.API.Prelude++-- | A graph where each node is a failed (directly/indirectly) derivation+--   and edges represent a dependencies on other directly or indirectly failed+--   derivations.+data Graph = Graph+  { nodes :: [Node]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++-- | A derivation and any dependencies that caused it to fail, if applicable.+data Node = Node+  { derivation :: Derivation,+    -- | Dependency paths to failed dependencies that, if present, have caused a+    --   DependencyFailure for this derivation.+    failedDependencies :: [Text]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/Log.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.Log where++import Hercules.API.Build.LogLine+import Hercules.API.Prelude++data Log = Log+  { id :: Id "log",+    lines :: [LogLine],+    done :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Build/LogLine.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Build.LogLine where++import Data.Word+import Hercules.API.Prelude++data LogLine = LogLine {i :: !Word64, ms :: !Word64, t :: !Text}+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Derivation.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Derivation where++import Hercules.API.Prelude hiding (either)++data DerivationPath = DerivationPath+  { drvPath :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data Derivation = Derivation+  { status :: DerivationStatus,+    derivationPath :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data DerivationStatus+  = Waiting+  | Building+  | BuildFailure+  | DependencyFailure+  | BuildSuccess+  | Cancelled+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Effects.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Effects where++import Hercules.API.Attribute+import Hercules.API.Build.Log (Log)+import Hercules.API.Effects.EffectInfo+import Hercules.API.Prelude+import Hercules.API.Projects.Job (Job)+import Servant.API (Capture, Get, JSON, NoContent, Optional, Post, QueryParam', Required, Summary, (:>))+import Servant.API.Generic (GenericMode ((:-)))++data EffectsAPI auth f = EffectsAPI+  { getEffect ::+      f :- Summary "Read effect events"+        :> "jobs"+        :> Capture "jobId" (Id Job)+        :> "effects"+        :> Capture "attribute" AttributePath+        :> auth+        :> Get '[JSON] EffectInfo,+    getEffectLog ::+      f :- 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,+    cancelEffect ::+      f :- 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+  }+  deriving (Generic)
+ src/Hercules/API/Effects/EffectEvent.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Hercules.API.Effects.EffectEvent where++import Data.Aeson.Types (FromJSON (..), ToJSON (..), genericParseJSON, genericToEncoding, genericToJSON)+import Hercules.API.Prelude++data EffectEvent+  = Queued EffectEventQueued+  | DependencyFailed EffectEventDependencyFailed+  | Started EffectEventStarted+  | Failed EffectEventFailed+  | Succeeded EffectEventSucceeded+  | Cancelled EffectEventCancelled+  deriving (Generic, Show, Eq, NFData, ToSchema)++instance FromJSON EffectEvent where+  parseJSON = genericParseJSON schemaCompatibleOptions++instance ToJSON EffectEvent where+  toJSON = genericToJSON schemaCompatibleOptions++  toEncoding = genericToEncoding schemaCompatibleOptions++eventTime :: EffectEvent -> UTCTime+eventTime (Queued (EffectEventQueued {time = t})) = t+eventTime (DependencyFailed (EffectEventDependencyFailed {time = t})) = t+eventTime (Started (EffectEventStarted {time = t})) = t+eventTime (Failed (EffectEventFailed {time = t})) = t+eventTime (Succeeded (EffectEventSucceeded {time = t})) = t+eventTime (Cancelled (EffectEventCancelled {time = t})) = t++data EffectEventQueued = EffectEventQueued+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data EffectEventDependencyFailed = EffectEventDependencyFailed+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data EffectEventStarted = EffectEventStarted+  { time :: UTCTime,+    logId :: Id "log",+    agentHostname :: Text,+    agentVersion :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data EffectEventReset = EffectEventReset+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data EffectEventFailed = EffectEventFailed+  { time :: UTCTime,+    technicalError :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data EffectEventSucceeded = EffectEventSucceeded+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data EffectEventCancelled = EffectEventCancelled+  { time :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Effects/EffectInfo.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Effects.EffectInfo where++import Hercules.API.Build.DerivationInfo.DerivationInput (DerivationInput)+import Hercules.API.Effects.EffectEvent (EffectEvent)+import Hercules.API.Prelude+import Hercules.API.Projects.Job (Job)+import Hercules.API.Projects.Project (Project)++data EffectStatus+  = Waiting+  | Running+  | Failed+  | DependencyFailed+  | Successful+  | Cancelled+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data EffectInfo = EffectInfo+  { status :: EffectStatus,+    jobId :: Id Job,+    projectId :: Id Project,+    platform :: Text,+    requiredSystemFeatures :: [Text],+    inputDerivations :: [DerivationInput],+    events :: [[EffectEvent]],+    mayCancel :: Bool,+    dummy :: Maybe EffectEvent -- TODO: remove and update/fix codegen+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Evaluation/AttributeError.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Evaluation.AttributeError where++import Hercules.API.Prelude++data AttributeError = AttributeError+  { errorMessage :: Text,+    -- | Not intended to be displayed to the user. This is+    --   @Just "BuildException"@ for evaluation time build failures.+    errorType :: Maybe Text,+    errorDerivation :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Evaluation/Evaluation.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Evaluation.Evaluation where++import Hercules.API.Prelude++data Evaluation = Evaluation+  { id :: Id Evaluation+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Health.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Health where++import Servant.API+import Servant.API.Generic++data HealthAPI auth f = HealthAPI+  { db ::+      f+        :- Summary "Health check for the database"+        :> "health"+        :> "db"+        :> Get '[JSON] NoContent,+    queue ::+      f+        :- Summary "Health check for the queue"+        :> "health"+        :> "queue"+        :> Get '[JSON] NoContent,+    github ::+      f+        :- Summary "Health check for the github"+        :> "health"+        :> "github"+        :> Get '[JSON] NoContent+  }+  deriving (Generic)
+ src/Hercules/API/Message.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Message where++import Hercules.API.Prelude++data Message = Message+  { index :: Int,+    typ :: Type,+    message :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data Type+  = -- | Something went wrong, inform user about possible+    -- cause. Examples: source could not be fetched, could not+    -- find a nix expression file to call.+    Error+  | -- | The nix expression contained a @builtins.trace@+    -- call. Ideally we should keep track of during which+    -- attribute it was encountered. It is not an attribute+    -- property because we can not reasonably know which+    -- attributes (plural) trigger the evaluation of+    -- @trace@. Indeed side effecting evaluation breaks the+    -- abstraction.+    Trace+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Organizations.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Hercules.API.Organizations+  ( OrganizationsAPI (..),+  )+where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Organizations.BillingInfo (BillingInfo)+import Hercules.API.Organizations.CreateOrganization (CreateOrganization)+import Hercules.API.Organizations.Organization (Organization)+import Hercules.API.Organizations.PaymentLink (PaymentLink)+import Hercules.API.Prelude+import Servant.API+import Servant.API.Generic++data OrganizationsAPI auth f = OrganizationsAPI+  { findOrganizations ::+      f+        :- Summary "Get all organizations user has admin access to"+        :> auth+        :> "api"+        :> "organizations"+        :> Get '[JSON] [Organization],+    createOrganization ::+      f+        :- Summary "Create a new organization"+        :> auth+        :> "api"+        :> "organizations"+        :> ReqBody '[JSON] CreateOrganization+        :> Post '[JSON] Organization,+    connectAccountToOrganization ::+      f+        :- Summary "Connect an account to an organization"+        :> auth+        :> "api"+        :> "organizations"+        :> Capture "organizationId" (Id Organization)+        :> "accounts"+        :> Capture "accountId" (Id Account)+        :> Post '[JSON] NoContent,+    paymentLinkForOrganization ::+      f+        :- Summary "Generate payment link for an organization"+        :> auth+        :> "api"+        :> "organizations"+        :> Capture "organizationId" (Id Organization)+        :> "paymentLink"+        :> Post '[JSON] PaymentLink,+    getOrganizationActiveUsers ::+      f :- Summary "List the active users in an organization's accounts."+        :> auth+        :> "api"+        :> "organizations"+        :> Capture "organizationId" (Id Organization)+        :> "billing"+        :> Get '[JSON] BillingInfo+  }+  deriving (Generic)
+ src/Hercules/API/Organizations/BillingInfo.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Organizations.BillingInfo where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude++data BillingInfo = BillingInfo+  { nextPayment :: Maybe UTCTime,+    activeUsers :: [Account]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Organizations/CreateOrganization.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Organizations.CreateOrganization where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude++data CreateOrganization = CreateOrganization+  { displayName :: Text,+    primaryAccountId :: Id Account+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Organizations/Organization.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Organizations.Organization where++import qualified Hercules.API.BillingStatus as BillingStatus+import Hercules.API.Prelude++data Organization = Organization+  { id :: Id Organization,+    displayName :: Text,+    billingStatus :: BillingStatus.BillingStatus,+    trialStartedOn :: Maybe UTCTime,+    subscriptionStartedOn :: Maybe UTCTime,+    subscriptionCancelledOn :: Maybe UTCTime,+    subscriptionCancelUrl :: Maybe Text,+    subscriptionUpdateUrl :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Organizations/PaymentLink.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Organizations.PaymentLink where++import Hercules.API.Prelude++data PaymentLink = PaymentLink+  { url :: Text,+    productId :: Integer+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Orphans.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Hercules.API.Orphans where++import Data.Proxy+import Data.Swagger+import Servant.API++-- | Ignores Headers.+--+-- FIXME: don't ignore headers+instance forall a hs. ToSchema a => ToSchema (Headers hs a) where+  declareNamedSchema _ = declareNamedSchema (Proxy @a)
+ src/Hercules/API/Projects.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Projects where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Build.EvaluationDetail+  ( EvaluationDetail,+  )+import qualified Hercules.API.Build.FailureGraph as FailureGraph+import Hercules.API.Build.Log (Log)+import Hercules.API.Prelude+import Hercules.API.Projects.CreateProject+  ( CreateProject,+  )+import Hercules.API.Projects.CreateUserEffectTokenResponse (CreateUserEffectTokenResponse)+import Hercules.API.Projects.Job+  ( Job,+    ProjectAndJobs,+  )+import Hercules.API.Projects.PatchProject+  ( PatchProject,+  )+import Hercules.API.Projects.Project (Project)+import Hercules.API.SourceHostingSite.SourceHostingSite+  ( SourceHostingSite,+  )+import Servant.API+import Servant.API.Generic++data ProjectsAPI auth f = ProjectsAPI+  { projectsByOwner ::+      f+        :- Summary "List all projects owned by an account."+        :> "accounts"+        :> Capture' '[Required, Strict] "accountId" (Id Account)+        :> "projects"+        :> auth+        :> Get '[JSON] [Project],+    findProjects ::+      f+        :- Summary "Find projects"+        :> "projects"+        :> QueryParam' '[Optional] "site" (Name SourceHostingSite)+        :> QueryParam' '[Optional] "account" (Name Account)+        :> QueryParam' '[Optional] "project" (Name Project)+        :> auth+        :> Get '[JSON] [Project],+    createProject ::+      f+        :- Summary "Create a new project."+        :> "projects"+        :> auth+        :> ReqBody '[JSON] CreateProject+        :> Post '[JSON] (Id Project),+    patchProject ::+      f+        :- Summary "Modify a project"+        :> "projects"+        :> Capture' '[Required, Strict] "projectId" (Id Project)+        :> ReqBody '[JSON] PatchProject+        :> auth+        :> Patch '[JSON] Project,+    createUserEffectToken ::+      f+        :- Summary "Create a token for local effect execution"+        :> "projects"+        :> Capture' '[Required, Strict] "projectId" (Id Project)+        :> auth+        :> "create-user-effect-token"+        :> Post '[JSON] CreateUserEffectTokenResponse,+    projectJobs ::+      f+        :- Summary "List all jobs in a project"+        :> Description "A list of a project's revisions and their details and status."+        :> "projects"+        :> Capture' '[Required, Strict] "project" (Id Project)+        :> "jobs"+        :> auth+        :> Get '[JSON] [Job],+    findJobs ::+      f+        :- Summary "Find jobs"+        :> "jobs"+        :> QueryParam' '[Optional, Description "Currently only \"github\" or omit entirely"] "site" (Name SourceHostingSite)+        :> 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],+    projectJobEvaluation ::+      f+        :- 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+        :> Get '[JSON] EvaluationDetail,+    jobDerivationFailureGraph ::+      f+        :- 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] FailureGraph.Graph,+    jobRerun ::+      f :- 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,+    jobCancel ::+      f :- 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,+    getEvaluationLog ::+      f :- 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+  }+  deriving (Generic)
+ src/Hercules/API/Projects/CreateProject.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Projects.CreateProject where++import Hercules.API.Prelude+import Hercules.API.Repos.Repo (Repo)++data CreateProject = CreateProject+  { primaryRepoId :: Id Repo,+    enabled :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Projects/CreateUserEffectTokenResponse.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Projects.CreateUserEffectTokenResponse where++import Hercules.API.Prelude++data CreateUserEffectTokenResponse = CreateUserEffectTokenResponse+  { token :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Projects/Job.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Projects.Job where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Evaluation.Evaluation+  ( Evaluation,+  )+import Hercules.API.Prelude+import Hercules.API.Projects.Project (Project)+import Hercules.API.Repos.Repo (Repo)++data Job = Job+  { id :: Id Job,+    projectId :: Id Project,+    index :: Int64,+    repoId :: Id Repo,+    startTime :: UTCTime,+    endTime :: Maybe UTCTime,+    jobPhase :: JobPhase,+    isCancelled :: Bool,+    jobStatus :: JobStatus,+    evaluationStatus :: JobStatus,+    derivationStatus :: JobStatus,+    effectsStatus :: JobStatus,+    evaluationId :: Id Evaluation,+    source :: GitCommitSource,+    rerunOf :: Maybe (Id Job),+    rerunOfIndex :: Maybe Int,+    startedBy :: Maybe (Id Account),+    cancelledBy :: Maybe (Id Account),+    mayCancel :: Bool,+    mayRerun :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data GitCommitSource = GitCommitSource+  { revision :: Text,+    ref :: Text,+    message :: Text,+    gitCommitterName :: Text,+    committer :: Maybe Account,+    link :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data JobPhase+  = Queued+  | Evaluating+  | Building+  | Effects+  | Done+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++data JobStatus+  = Pending+  | Failure+  | Success+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)++-- | Whichever is "worse": 'Failure' wins out, otherwise 'Pending' wins out, otherwise all are 'Success'.+instance Semigroup JobStatus where+  Failure <> _ = Failure+  _ <> Failure = Failure+  Pending <> _ = Pending+  _ <> Pending = Pending+  Success <> Success = Success++-- | @mappend@: Whichever is "worse": 'Failure' wins out, otherwise 'Pending' wins out, otherwise all are 'Success'.+--+-- @mempty@: 'Success'+instance Monoid JobStatus where+  mappend = (<>)++  mempty = Success++data ProjectAndJobs = ProjectAndJobs+  { project :: Project,+    jobs :: [Job]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Projects/PatchProject.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Projects.PatchProject where++import Hercules.API.Prelude++-- | Changes to a Project. 'Nothing' represents no change in a field.+data PatchProject = PatchProject+  { enabled :: Maybe Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Projects/Project.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Projects.Project where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude+import Hercules.API.Repos.Repo (Repo)+import Hercules.API.SourceHostingSite.SourceHostingSite+  ( SourceHostingSite,+  )++data Project = Project+  { id :: Id Project,+    ownerId :: Id Account,+    repoId :: Id Repo,+    enabled :: Bool,+    siteSlug :: Name SourceHostingSite,+    slug :: Name Project,+    displayName :: Text,+    imageURL :: Maybe Text,+    -- | True if no authorization is required for retrieving basic+    --   information about a project, such as its existence, name,+    --   job statuses etc.+    isPublic :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Projects/SimpleJob.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Projects.SimpleJob where++import Hercules.API.Prelude+import Hercules.API.Projects.Job (Job)+import Hercules.API.Projects.Project (Project)++data SimpleJob = SimpleJob+  { id :: Id Job,+    project :: Project,+    index :: Int64+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Repos.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Repos where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude+import Hercules.API.Repos.Repo (Repo)+import Hercules.API.Repos.RepoKey (RepoKey)+import Servant.API+import Servant.API.Generic++data ReposAPI auth f = ReposAPI+  { reposByOwner ::+      f+        :- Summary "Repositories that the account owns or has explicit access to."+        :> "accounts"+        :> Capture' '[Required, Strict] "accountId" (Id Account)+        :> "repos"+        :> auth+        :> Get '[JSON] [Repo],+    parseGitURL ::+      f+        :- 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+  }+  deriving (Generic)
+ src/Hercules/API/Repos/Repo.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Repos.Repo where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude++-- | Information about a repository on a connected repository site such as github.+data Repo = Repo+  { id :: Id Repo,+    ownerId :: Id Account,+    siteSlug :: Text,+    slug :: Text,+    displayName :: Text,+    imageURL :: Maybe Text,+    isPublic :: Bool,+    -- | An installed repo is one that Hercules has permission to.+    --+    -- A non-installed repo is one that is only visible because of the+    -- authenticated user's credentials.+    isInstalled :: Bool,+    -- | Whether the authenticated user can grant permission to this+    --   repository+    isInstallable :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Repos/RepoKey.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Repos.RepoKey where++import Hercules.API.Prelude+import Hercules.API.Projects.Project (Project)++data RepoKey = RepoKey+  { siteName :: Text,+    ownerName :: Text,+    repoName :: Text,+    projectId :: Maybe (Id Project)+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/Result.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE StandaloneDeriving #-}++module Hercules.API.Result+  ( Result (..),+    toEither,+    fromEither,+    either,+  )+where++import Data.Aeson+  ( FromJSON (..),+    ToJSON (..),+    genericParseJSON,+    genericToEncoding,+    genericToJSON,+  )+import Data.Profunctor+  ( Profunctor,+    dimap,+  )+import Hercules.API.Prelude hiding (either)+import Prelude ()++data Result e a+  = Ok a+  | Error e+  deriving (Generic, Show, Read, Eq, Ord, NFData, Functor, Foldable, Traversable)++deriving instance (ToSchema e, ToSchema a) => ToSchema (Result e a)++-- many more typeclasses can be implemented+instance (FromJSON e, FromJSON a) => FromJSON (Result e a) where+  parseJSON = genericParseJSON schemaCompatibleOptions++instance (ToJSON e, ToJSON a) => ToJSON (Result e a) where+  toJSON = genericToJSON schemaCompatibleOptions++  toEncoding = genericToEncoding schemaCompatibleOptions++either :: Iso (Result e a) (Result e' a') (Either e a) (Either e' a')+either = iso toEither fromEither++toEither :: Result e a -> Either e a+toEither (Ok a) = Right a+toEither (Error e) = Left e++fromEither :: Either e a -> Result e a+fromEither (Right a) = Ok a+fromEither (Left e) = Error e++-- | See @lens@ package.+type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)++iso :: (s -> a) -> (b -> t) -> Iso s t a b+iso sa bt = dimap sa (fmap bt)
+ src/Hercules/API/Servant/Status.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}++module Hercules.API.Servant.Status where++import Data.Text (Text)+import Servant.API++type Get302 (cts :: [*]) (hs :: [*]) = Verb 'GET 302 cts (Headers (Header "Location" Text ': hs) NoContent)++type Post302 (cts :: [*]) (hs :: [*]) = Verb 'POST 302 cts (Headers (Header "Location" Text ': hs) NoContent)
+ src/Hercules/API/SourceHostingSite/SourceHostingSite.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.SourceHostingSite.SourceHostingSite where++import Hercules.API.Prelude++-- | A source hosting site (example github for github.com) used for+-- source code, permissions, CI statuses, ...+data SourceHostingSite = SourceHostingSite+  { id :: Id SourceHostingSite,+    slug :: Name SourceHostingSite,+    displayName :: Text,+    newInstallationURL :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/State.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Hercules.API.State where++import Data.ByteString (ByteString)+import Data.Swagger (NamedSchema (NamedSchema), binarySchema)+import Data.Swagger.Schema (ToSchema (..))+import Hercules.API.Prelude+import Hercules.API.Projects.Project (Project)+import Hercules.API.State.ProjectState (ProjectState)+import Servant.API+import Servant.API.Generic++-- | A newtype wrapper for servant-swagger+newtype RawBytes = RawBytes {fromRawBytes :: ByteString}+  deriving newtype (MimeUnrender OctetStream, MimeRender OctetStream)++instance ToSchema RawBytes where+  declareNamedSchema _ = pure $ NamedSchema (Just "RawBytes") binarySchema++type ContentLength = Header "Content-Length" Integer++type ContentDisposition = Header "Content-Disposition" Text++data StateAPI auth f = StateAPI+  { putProjectStateData ::+      f+        :- Summary "Upload a state file"+        :> "projects"+        :> Capture' '[Required, Strict] "projectId" (Id Project)+        :> "state"+        :> Capture' '[Required, Strict] "stateName" Text+        :> "data"+        :> StreamBody NoFraming OctetStream (SourceIO RawBytes)+        :> auth+        :> Put '[JSON] NoContent,+    getProjectStates ::+      f+        :- Summary "List all state files"+        :> "projects"+        :> Capture' '[Required, Strict] "projectId" (Id Project)+        :> "states"+        :> auth+        :> Get '[JSON] ProjectState,+    getProjectStateData ::+      f+        :- Summary "Download a state file"+        :> "projects"+        :> Capture' '[Required, Strict] "projectId" (Id Project)+        :> "state"+        :> Capture' '[Required, Strict] "stateName" Text+        :> "data"+        :> auth+        :> StreamGet NoFraming OctetStream (Headers '[ContentLength, ContentDisposition] (SourceIO RawBytes))+  }+  deriving (Generic)
+ src/Hercules/API/State/ProjectState.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.State.ProjectState where++import Hercules.API.Prelude+import Hercules.API.Projects.Project (Project)+import Hercules.API.State.StateFile (StateFile)++data ProjectState = ProjectState+  { projectId :: Id Project,+    stateFiles :: Map Text StateFile+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/State/StateFile.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.State.StateFile where++import Hercules.API.Prelude+import Hercules.API.Projects.Project (Project)+import Hercules.API.State.StateVersion (StateVersion)++data StateFile = StateFile+  { projectId :: Id Project,+    name :: Text,+    versions :: [StateVersion]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/API/State/StateVersion.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.State.StateVersion where++import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude+import Hercules.API.Projects.Job (Job)+import Hercules.API.Projects.Project (Project)++data StateVersion = StateVersion+  { projectId :: Id Project,+    name :: Text,+    version :: Int,+    creationTime :: UTCTime,+    -- jobId :: Maybe (Id Job),+    job :: Maybe Job,+    -- effectEventId :: Maybe (Id "EffectEvent"),+    --  agentId :: Maybe (Id AgentSession),+    uploader :: Maybe Account,+    sha256 :: Maybe Text,+    size :: Maybe Int+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)
+ src/Hercules/Frontend.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE DataKinds #-}++module Hercules.Frontend where++import qualified Data.Text as T+import Hercules.API.Accounts.Account (Account)+import Hercules.API.Prelude+import Hercules.API.Projects.Project (Project)+import Hercules.API.SourceHostingSite.SourceHostingSite+  ( SourceHostingSite,+  )+import Network.URI+import Servant.API+import Servant.API.Generic+import Servant.Links++-- | URL routes for the web interface.+--+-- Typically the base URL for this is https://hercules-ci.com+data FrontendRoutes view f = FrontendRoutes+  { home ::+      f+        :- view,+    account ::+      f+        :- Capture' [Required, Strict] "site" (Name SourceHostingSite)+        :> Capture' [Required, Strict] "account" (Name Account)+        :> view,+    cliAuthorize ::+      f :- "settings" :> "cli" :> "authorize"+        :> QueryParam' [Required, Strict] "token" Text+        :> view,+    project ::+      f+        :- Capture' [Required, Strict] "site" (Name SourceHostingSite)+        :> Capture' [Required, Strict] "account" (Name Account)+        :> Capture' [Required, Strict] "project" (Name Project)+        :> view,+    job ::+      f+        :- Capture' [Required, Strict] "site" (Name SourceHostingSite)+        :> Capture' [Required, Strict] "account" (Name Account)+        :> Capture' [Required, Strict] "project" (Name Project)+        :> "jobs"+        :> Capture' [Required, Strict] "jobIndex" Int+        :> view+  }+  deriving (Generic)++mkLinks :: URI -> FrontendRoutes Raw (AsLink Text)+mkLinks base = allFieldLinks' $+  \link -> shows2Text $ uriToString id $ linkURI link `relativeTo` base+  where+    shows2Text :: ShowS -> Text+    shows2Text = T.pack . ($ "")++herculesLinks :: FrontendRoutes Raw (AsLink Text)+herculesLinks = mkLinks base+  where+    base :: URI+    base =+      URI+        { uriPath = "",+          uriQuery = "",+          uriFragment = "",+          uriScheme = "https:",+          uriAuthority =+            Just+              URIAuth+                { uriUserInfo = "",+                  uriRegName = "hercules-ci.com",+                  uriPort = ""+                }+        }