hercules-ci-api-agent (empty) → 0.2.1.0

raw patch · 43 files changed

+1447/−0 lines, 43 filesdep +QuickCheckdep +aesondep +base

Dependencies added: QuickCheck, aeson, base, base64-bytestring-type, bytestring, containers, cookie, exceptions, hashable, hercules-ci-api-agent, hercules-ci-api-core, hspec, 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, vector

Files

• CHANGELOG.md +16/−0
• hercules-ci-api-agent.cabal +130/−0
• src/Hercules/API/Agent.hs +46/−0
• src/Hercules/API/Agent/Build.hs +44/−0
• src/Hercules/API/Agent/Build/BuildEvent.hs +18/−0
• src/Hercules/API/Agent/Build/BuildEvent/OutputInfo.hs +20/−0
• src/Hercules/API/Agent/Build/BuildEvent/Pushed.hs +11/−0
• src/Hercules/API/Agent/Build/BuildTask.hs +23/−0
• src/Hercules/API/Agent/Evaluate.hs +50/−0
• src/Hercules/API/Agent/Evaluate/DerivationStatus.hs +14/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent.hs +36/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/AttributeErrorEvent.hs +30/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/AttributeEvent.hs +14/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/BuildRequest.hs +23/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/BuildRequired.hs +14/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/DerivationInfo.hs +40/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/Message.hs +35/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/PushedAll.hs +12/−0
• src/Hercules/API/Agent/Evaluate/EvaluateTask.hs +48/−0
• src/Hercules/API/Agent/LifeCycle.hs +65/−0
• src/Hercules/API/Agent/LifeCycle/AgentInfo.hs +33/−0
• src/Hercules/API/Agent/LifeCycle/CreateAgentSession.hs +16/−0
• src/Hercules/API/Agent/LifeCycle/CreateAgentSession_V2.hs +12/−0
• src/Hercules/API/Agent/LifeCycle/ServiceInfo.hs +16/−0
• src/Hercules/API/Agent/LifeCycle/StartInfo.hs +32/−0
• src/Hercules/API/Agent/Socket/AgentPayload.hs +21/−0
• src/Hercules/API/Agent/Socket/Frame.hs +32/−0
• src/Hercules/API/Agent/Socket/ServicePayload.hs +19/−0
• src/Hercules/API/Agent/Tasks.hs +34/−0
• src/Hercules/API/Logs.hs +26/−0
• src/Hercules/API/Logs/LogEntry.hs +67/−0
• src/Hercules/API/Logs/LogMessage.hs +13/−0
• src/Hercules/API/Task.hs +39/−0
• src/Hercules/API/TaskStatus.hs +24/−0
• src/Hercules/Formats/CachixCache.hs +52/−0
• src/Hercules/Formats/Common.hs +59/−0
• src/Hercules/Formats/NixCache.hs +48/−0
• test/AesonSupport.hs +31/−0
• test/Hercules/API/Agent/Evaluate/EvaluateEvent/DerivationInfoSpec.hs +31/−0
• test/Hercules/API/Agent/LifeCycle/AgentInfoSpec.hs +67/−0
• test/Hercules/Formats/CachixCacheSpec.hs +60/−0
• test/Main.hs +10/−0
• test/Spec.hs +16/−0

@@ -0,0 +1,16 @@++# Changelog++All notable changes to this package will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).++## 0.2.1.0 - 2020-06-17++### Added++ - Add a `NixCache` format for generic binary cache support using Nix's generic "URI"-based store API.++## 0.2.0.0++Start of changelog

@@ -0,0 +1,130 @@+cabal-version: 1.12++name:           hercules-ci-api-agent+version:        0.2.1.0+synopsis:       API definition for Hercules CI Agent to talk to hercules-ci.com or Hercules CI Enterprise+category:       API, CI, Testing, DevOps+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-2020 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.Agent.Build+      Hercules.API.Agent.Build.BuildEvent+      Hercules.API.Agent.Build.BuildEvent.Pushed+      Hercules.API.Agent.Build.BuildEvent.OutputInfo+      Hercules.API.Agent.Build.BuildTask+      Hercules.API.Agent.Evaluate+      Hercules.API.Agent.Evaluate.DerivationStatus+      Hercules.API.Agent.Evaluate.EvaluateEvent+      Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeErrorEvent+      Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeEvent+      Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequest+      Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequired+      Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo+      Hercules.API.Agent.Evaluate.EvaluateEvent.Message+      Hercules.API.Agent.Evaluate.EvaluateEvent.PushedAll+      Hercules.API.Agent.Evaluate.EvaluateTask+      Hercules.API.Agent.LifeCycle+      Hercules.API.Agent.LifeCycle.AgentInfo+      Hercules.API.Agent.LifeCycle.CreateAgentSession+      Hercules.API.Agent.LifeCycle.CreateAgentSession_V2+      Hercules.API.Agent.LifeCycle.ServiceInfo+      Hercules.API.Agent.LifeCycle.StartInfo+      Hercules.API.Agent.Socket.Frame+      Hercules.API.Agent.Socket.AgentPayload+      Hercules.API.Agent.Socket.ServicePayload+      Hercules.API.Agent.Tasks+      Hercules.API.Agent+      Hercules.API.Logs+      Hercules.API.Logs.LogEntry+      Hercules.API.Logs.LogMessage+      Hercules.API.TaskStatus+      Hercules.API.Task+      Hercules.Formats.CachixCache+      Hercules.Formats.Common+      Hercules.Formats.NixCache+  hs-source-dirs:+      src+  default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude 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+    , base64-bytestring-type+    , containers+    , cookie+    , exceptions+    , hashable+    , hercules-ci-api-core+    , http-api-data+    , http-media+    , lens+    , lens-aeson+    , memory+    , servant >=0.14.1+    , servant-auth+    , servant-auth-swagger+    , servant-swagger+    , servant-swagger-ui-core+    , string-conv+    , swagger2+    , text+    , time+    , uuid+    , vector+  default-language: Haskell2010++test-suite hercules-api-agent-unit-tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Spec+      AesonSupport+      Hercules.API.Agent.LifeCycle.AgentInfoSpec+      Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec+      Hercules.Formats.CachixCacheSpec+  hs-source-dirs:+      test+  default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude 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 >=4.7 && <5+    , bytestring+    , containers+    , cookie+    , exceptions+    , hashable+    , hercules-ci-api-agent+    , hspec+    , http-api-data+    , http-media+    , lens+    , memory+    , network-uri+    , QuickCheck+    , 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

@@ -0,0 +1,46 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Agent where++import Data.Proxy+import Hercules.API.Agent.Build+  ( BuildAPI,+  )+import Hercules.API.Agent.Evaluate+  ( EvalAPI,+  )+import Hercules.API.Agent.LifeCycle+  ( LifeCycleAPI,+  )+import Hercules.API.Agent.Tasks+  ( TasksAPI,+  )+import Hercules.API.Prelude+import Servant.API+import Servant.API.Generic+import Servant.Auth++data AgentAPI auth f+  = AgentAPI+      { tasks :: f :- ToServantApi (TasksAPI auth),+        eval :: f :- ToServantApi (EvalAPI auth),+        build :: f :- ToServantApi (BuildAPI auth),+        lifeCycle :: f :- ToServantApi (LifeCycleAPI auth)+      }+  deriving (Generic)++-- TODO check that we don't have overlapping endpoints and remove cookie+type ClientAuth = Auth '[JWT, Cookie] ()++type AgentServantAPI auth = AddAPIVersion (ToServantApi (AgentAPI auth))++type AddAPIVersion api = "api" :> "v1" :> api++servantApi :: Proxy (AgentServantAPI auth)+servantApi = Proxy++type API auth =+  AgentServantAPI auth++api :: Proxy (API auth)+api = Proxy

@@ -0,0 +1,44 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Agent.Build where++import Data.ByteString (ByteString)+import qualified Hercules.API.Agent.Build.BuildEvent as BuildEvent+import qualified Hercules.API.Agent.Build.BuildTask as BuildTask+import Hercules.API.Prelude+import qualified Hercules.API.Task as Task+import Servant.API+import Servant.API.Generic+import Servant.Auth.Swagger ()++data BuildAPI auth f+  = BuildAPI+      { getBuild ::+          f+            :- "tasks"+            :> Capture "taskId" (Id (Task.Task BuildTask.BuildTask))+            :> "build"+            :> auth+            :> Get '[JSON] BuildTask.BuildTask,+        updateBuild ::+          f+            :- "tasks"+            :> Capture "taskId" (Id (Task.Task BuildTask.BuildTask))+            :> "build"+            :> ReqBody '[JSON] [BuildEvent.BuildEvent]+            :> auth+            :> Post '[JSON] NoContent,+        writeBuildLog ::+          f+            :- Summary "DEPRECATED"+            :> "tasks"+            :> Capture "taskId" (Id (Task.Task BuildTask.BuildTask))+            :> "build"+            :> "_log"+            :> ReqBody '[OctetStream] ByteString+            :> auth+            :> Post '[JSON] NoContent+      }+  deriving (Generic)++{-# DEPRECATED writeBuildLog "Use 'Hercules.API.Logs.writeLog' instead" #-}

@@ -0,0 +1,18 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Build.BuildEvent where++import Hercules.API.Agent.Build.BuildEvent.OutputInfo+  ( OutputInfo,+  )+import Hercules.API.Agent.Build.BuildEvent.Pushed+  ( Pushed,+  )+import Hercules.API.Prelude++data BuildEvent+  = OutputInfo OutputInfo+  | Pushed Pushed+  | -- | legacy+    Done Bool+  deriving (Generic, Show, Eq, ToJSON, FromJSON)

@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Build.BuildEvent.OutputInfo where++import Hercules.API.Prelude++data OutputInfo+  = OutputInfo+      { -- | store path ending in .drv+        deriver :: Text,+        -- | e.g. out, dev+        name :: Text,+        -- | store path+        path :: Text,+        -- | typically sha256:...+        hash :: Text,+        -- | nar size in bytes+        size :: Integer+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Build.BuildEvent.Pushed where++import Hercules.API.Prelude++data Pushed+  = Pushed+      { cache :: Text+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Build.BuildTask where++import Data.Aeson+  ( FromJSON,+    ToJSON,+  )+import Data.Swagger (ToSchema)+import Data.Text (Text)+import GHC.Generics (Generic)+import Hercules.API.Id+import Hercules.API.Task (Task)+import Prelude++data BuildTask+  = BuildTask+      { id :: Id (Task BuildTask),+        derivationPath :: Text,+        logToken :: Text,+        inputDerivationOutputPaths :: [Text]+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,50 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Agent.Evaluate where++import Data.UUID+import Hercules.API.Agent.Evaluate.DerivationStatus (DerivationStatus)+import Hercules.API.Agent.Evaluate.EvaluateEvent+  ( EvaluateEvent,+  )+import Hercules.API.Agent.Evaluate.EvaluateTask+  ( EvaluateTask,+  )+import Hercules.API.Prelude+import Hercules.API.Task (Task)+import Servant.API+import Servant.API.Generic++data EvalAPI auth f+  = EvalAPI+      { tasksGetEvaluation ::+          f+            :- "tasks"+            :> Capture "taskId" (Id (Task EvaluateTask))+            :> "eval"+            :> auth+            :> Get '[JSON] EvaluateTask,+        tasksUpdateEvaluation ::+          f+            :- "tasks"+            :> Capture "taskId" (Id (Task EvaluateTask))+            :> "eval"+            :> ReqBody '[JSON] [EvaluateEvent]+            :> auth+            :> Post '[JSON] NoContent,+        getDerivationStatus ::+          f+            :- "agent"+            :> "build"+            :> Capture "derivationPath" Text+            :> auth+            :> Get '[JSON] (Maybe DerivationStatus),+        getDerivationStatus2 ::+          f+            :- "agent"+            :> "eval-build"+            :> Capture "derivationPath" Text+            :> auth+            :> Get '[JSON] (Maybe (UUID, DerivationStatus))+      }+  deriving (Generic)

@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.DerivationStatus where++import Hercules.API.Prelude++-- TODO simplify+data DerivationStatus+  = Waiting+  | Building+  | BuildFailure+  | DependencyFailure+  | BuildSuccess+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,36 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent where++import Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeErrorEvent+  ( AttributeErrorEvent,+  )+import Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeEvent+  ( AttributeEvent,+  )+import Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequest+  ( BuildRequest,+  )+import Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequired+  ( BuildRequired,+  )+import Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo+  ( DerivationInfo,+  )+import Hercules.API.Agent.Evaluate.EvaluateEvent.Message+  ( Message,+  )+import Hercules.API.Agent.Evaluate.EvaluateEvent.PushedAll+  ( PushedAll,+  )+import Hercules.API.Prelude++data EvaluateEvent+  = Attribute AttributeEvent+  | AttributeError AttributeErrorEvent+  | Message Message+  | DerivationInfo DerivationInfo+  | PushedAll PushedAll+  | BuildRequired BuildRequired+  | BuildRequest BuildRequest+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeErrorEvent where++import Data.Aeson.Types+import Hercules.API.Prelude++data AttributeErrorEvent+  = AttributeErrorEvent+      { expressionPath :: [Text],+        errorMessage :: Text,+        errorDerivation :: Maybe Text,+        errorType :: Maybe Text+      }+  deriving (Generic, Show, Eq, ToSchema)++instance ToJSON AttributeErrorEvent where++  toJSON = genericToJSON aesonOptions++  toEncoding = genericToEncoding aesonOptions++instance FromJSON AttributeErrorEvent where+  parseJSON = genericParseJSON aesonOptions++aesonOptions :: Options+aesonOptions =+  defaultOptions+    { omitNothingFields = True+    }

@@ -0,0 +1,14 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeEvent where++import Hercules.API.Prelude++data AttributeEvent+  = AttributeEvent+      { expressionPath :: [Text],+        derivationPath :: Text+        -- TODO: meta attributes+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,23 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequest where++import Control.Applicative+import Control.Lens ((%~), at)+import qualified Data.Aeson as A+import Data.Aeson.Lens (_Object)+import Hercules.API.Prelude++data BuildRequest+  = BuildRequest+      { derivationPath :: Text,+        forceRebuild :: Bool -- FIXME: API compatibility+      }+  deriving (Generic, Show, Eq, ToJSON, ToSchema)++instance FromJSON BuildRequest where+  parseJSON = A.genericParseJSON A.defaultOptions . fixup+    where+      fixup :: A.Value -> A.Value+      fixup = _Object . at "forceRebuild" %~ (<|> Just (A.Bool False))

@@ -0,0 +1,14 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequired where++import Hercules.API.Prelude++data BuildRequired+  = BuildRequired+      { index :: Int,+        derivationPath :: Text,+        outputName :: Text+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo where++import Control.Applicative+import Control.Lens+import qualified Data.Aeson as A+import Data.Aeson.Lens+import Hercules.API.Prelude++type OutputNameText = Text++type DerivationPathText = Text++-- | Derivation fields that are relevant to CI, notably excluding the details+-- that make it buildable and may be sensitive such as the builder script or+-- output hashes.+data DerivationInfo+  = DerivationInfo+      { derivationPath :: DerivationPathText,+        platform :: Text,+        requiredSystemFeatures :: [Text],+        inputDerivations :: Map DerivationPathText [OutputNameText],+        inputSources :: [DerivationPathText],+        outputs :: Map OutputNameText OutputInfo+      }+  deriving (Generic, Show, Eq, ToJSON, ToSchema)++instance FromJSON DerivationInfo where+  parseJSON = A.genericParseJSON A.defaultOptions . fixup+    where+      fixup :: A.Value -> A.Value+      fixup = _Object . at "requiredSystemFeatures" %~ (<|> Just (A.Array mempty))++data OutputInfo+  = OutputInfo+      { path :: Text,+        isFixed :: Bool+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.Message where++import Data.Aeson+  ( FromJSON,+    ToJSON,+  )+import Data.Swagger (ToSchema)+import Data.Text (Text)+import GHC.Generics (Generic)+import Prelude++data Message+  = Message+      { index :: Int,+        typ :: Type,+        message :: Text+      }+  deriving (Generic, Show, Eq, 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, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,12 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.PushedAll where++import Hercules.API.Prelude++-- | Indicates that all derivations have been pushed to a cache.+data PushedAll+  = PushedAll+      { cache :: Text+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,48 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE StandaloneDeriving #-}++module Hercules.API.Agent.Evaluate.EvaluateTask where++import Data.Aeson+  ( FromJSON,+    ToJSON,+  )+import Data.Map (Map)+import Data.Swagger (ToSchema)+import Data.Text (Text)+import GHC.Generics (Generic)+import Hercules.API.Id+import Hercules.API.Task (Task)+import Prelude++data EvaluateTask+  = EvaluateTask+      { id :: Id (Task EvaluateTask),+        primaryInput :: Text, -- HTTP URL+        otherInputs :: Map Identifier Text, -- identifier -> HTTP URL+        autoArguments :: Map Text (SubPathOf Identifier), -- argument name -> identifier+        nixPath :: [NixPathElement (SubPathOf Identifier)] -- NIX_PATH element -> identifier+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)++type Identifier = Text++data NixPathElement a+  = NixPathElement+      { -- | for example @/home/user/nixpkgs@ in @/home/user/nixpkgs:/etc/nixos/foo@+        prefix :: Maybe Text,+        value :: a+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, Functor, Foldable, Traversable)++deriving instance ToSchema a => ToSchema (NixPathElement a)++-- | For using a path inside a source+data SubPathOf a+  = SubPathOf+      { path :: a,+        subPath :: Maybe Text+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, Functor, Foldable, Traversable)++deriving instance ToSchema a => ToSchema (SubPathOf a)

@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}++module Hercules.API.Agent.LifeCycle where++import Hercules.API.Agent.LifeCycle.CreateAgentSession_V2 as CreateAgentSession_V2+  ( CreateAgentSession,+  )+import Hercules.API.Agent.LifeCycle.ServiceInfo+import Hercules.API.Agent.LifeCycle.StartInfo+  ( Hello,+    StartInfo,+  )+import Hercules.API.Prelude+import Servant.API+import Servant.API.Generic++-- | Agent session and "connection" endpoints+data LifeCycleAPI auth f+  = LifeCycleAPI+      { -- | This is also available in the client API as 'Hercules.API.Agents.agentSessionCreateV2'+        agentSessionCreate ::+          f+            :- Summary "Create a new agent session."+            :> Description "Authenticated using the cluster join token acquired through POST /accounts/:accountId/clusterJoinTokens"+            :> "agent"+            :> "session"+            :> ReqBody '[JSON] CreateAgentSession_V2.CreateAgentSession+            :> auth+            :> Post '[JSON] Text,+        hello ::+          f+            :- Summary "Update an agent session wrt features, versions, capabilities etc."+            :> Description "Authenticated using the agent session token acquired through agentSessionCreate."+            :> "agent"+            :> "hello"+            :> ReqBody '[JSON] Hello+            :> auth+            :> Post '[JSON] NoContent,+        heartbeat ::+          f+            :- Summary "Update an agent session to indicate liveness."+            :> Description "Authenticated using the agent session token acquired through agentSessionCreate."+            :> "agent"+            :> "heartbeat"+            :> ReqBody '[JSON] StartInfo+            :> auth+            :> Post '[JSON] NoContent,+        goodbye ::+          f+            :- Summary "Report that an agent has stopped."+            :> Description "Authenticated using the agent session token acquired through agentSessionCreate."+            :> "agent"+            :> "goodbye"+            :> ReqBody '[JSON] StartInfo+            :> auth+            :> Post '[JSON] NoContent,+        getServiceInfo ::+          f+            :- Summary "Service version and configuration."+            :> "agent"+            :> "service-info"+            :> Get '[JSON] ServiceInfo+      }+  deriving (Generic)

@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.LifeCycle.AgentInfo where++import Control.Applicative+import Control.Lens ((%~), at)+import qualified Data.Aeson as A+import Data.Aeson.Lens (_Object)+import Data.Function+import Hercules.API.Prelude++data AgentInfo+  = AgentInfo+      { hostname :: Text,+        agentVersion :: Text,+        nixVersion :: Text,+        platforms :: [Text],+        systemFeatures :: [Text],+        cachixPushCaches :: [Text],+        pushCaches :: [Text],+        substituters :: [Text],+        concurrentTasks :: Int+      }+  deriving (Generic, Show, Eq, ToJSON, ToSchema)++instance FromJSON AgentInfo where+  parseJSON = A.genericParseJSON A.defaultOptions . fixup+    where+      fixup :: A.Value -> A.Value+      fixup v =+        v+          & _Object . at "concurrentTasks" %~ (<|> Just (A.Number 2))+          & _Object . at "pushCaches" %~ (<|> Just (A.Array mempty))

@@ -0,0 +1,16 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.LifeCycle.CreateAgentSession where++import Hercules.API.Prelude++{-# DEPRECATED CreateAgentSession "Use Hercules.API.Agents.CreateAgentSession_V2.CreateAgentSession" #-}++data CreateAgentSession+  = CreateAgentSession+      { hostname :: Text,+        agentVersion :: Text,+        nixVersion :: Text,+        architectures :: [Text]+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,12 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.LifeCycle.CreateAgentSession_V2 where++import Hercules.API.Agent.LifeCycle.AgentInfo+import Hercules.API.Prelude++data CreateAgentSession+  = CreateAgentSession+      { agentInfo :: AgentInfo+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,16 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.LifeCycle.ServiceInfo+  ( ServiceInfo (..),+  )+where++import Hercules.API.Prelude++data ServiceInfo+  = ServiceInfo+      { version :: (Int, Int),+        agentSocketBaseURL :: Text,+        bulkSocketBaseURL :: Text+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON)

@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.LifeCycle.StartInfo where++import Control.Applicative+import Control.Lens ((%~), at)+import qualified Data.Aeson as A+import Data.Aeson.Lens (_Object)+import Hercules.API.Agent.LifeCycle.AgentInfo (AgentInfo)+import Hercules.API.Prelude+import Hercules.API.Task++data Hello+  = Hello+      { agentInfo :: AgentInfo,+        startInfo :: StartInfo,+        tasksInProgress :: [Id (Task Any)]+      }+  deriving (Generic, Show, Eq, ToJSON, ToSchema)++instance FromJSON Hello where+  parseJSON = A.genericParseJSON A.defaultOptions . fixup+    where+      fixup :: A.Value -> A.Value+      fixup = _Object . at "tasksInProgress" %~ (<|> Just (A.Array mempty))++data StartInfo+  = StartInfo+      { id :: Id StartInfo,+        startTime :: UTCTime+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Hercules.API.Agent.Socket.AgentPayload where++import Hercules.API.Agent.LifeCycle.StartInfo (Hello)+import Hercules.API.Prelude+import Hercules.API.Task as Task++data AgentPayload+  = Hello Hello+  | Ping+  | Started Started+  | Cancelled Cancelled+  deriving (Generic, Show, Eq, ToJSON, FromJSON)++data Started = MkStarted {taskId :: Id (Task Task.Any)}+  deriving (Generic, Show, Eq, ToJSON, FromJSON)++data Cancelled = MkCancelled {taskId :: Id (Task Task.Any)}+  deriving (Generic, Show, Eq, ToJSON, FromJSON)

@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Socket.Frame where++import Control.Applicative+import Data.Void (Void)+import Hercules.API.Prelude++-- | Adds serial number 'n' to payloads 'p' and allows acknowledgement for+-- a related stream that travels in the opposite direction.+data Frame o a+  = -- | Message+    Msg {n :: Integer, p :: a}+  | -- | Out of band message: not redelivered, not acknowledged.+    Oob {o :: o}+  | -- | Acknowledgement+    Ack {n :: Integer}+  | -- | Exception+    Exception {message :: Text}+  deriving (Generic, Show, Eq, ToJSON, FromJSON)++mapOob :: (a -> b) -> Frame a c -> Frame b c+mapOob f (Oob a) = Oob (f a)+mapOob _ (Msg a b) = Msg a b+mapOob _ (Ack a) = Ack a+mapOob _ (Exception e) = Exception e++removeOob :: Alternative f => Frame o a -> f (Frame Void a)+removeOob (Msg a b) = pure $ Msg a b+removeOob (Ack a) = pure $ Ack a+removeOob (Oob {}) = empty+removeOob (Exception e) = pure $ Exception e

@@ -0,0 +1,19 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Socket.ServicePayload where++import Hercules.API.Agent.Build.BuildTask (BuildTask)+import Hercules.API.Agent.Evaluate.EvaluateTask (EvaluateTask)+import Hercules.API.Agent.LifeCycle.ServiceInfo (ServiceInfo)+import Hercules.API.Prelude+import Hercules.API.Task++data Cancel = MkCancel {taskId :: Id (Task Any)}+  deriving (Generic, Show, Eq, ToJSON, FromJSON)++data ServicePayload+  = ServiceInfo ServiceInfo+  | StartEvaluation EvaluateTask+  | StartBuild BuildTask+  | Cancel Cancel+  deriving (Generic, Show, Eq, ToJSON, FromJSON)

@@ -0,0 +1,34 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Agent.Tasks where++import Data.Aeson (Object)+import Hercules.API.Prelude+import qualified Hercules.API.Task as Task+import Hercules.API.TaskStatus+import Servant.API+import Servant.API.Generic++data TasksAPI auth f+  = TasksAPI+      { tasksReady ::+          f+            :- "tasks"+            :> auth+            :> Post '[JSON] (Maybe (Task.Task Task.Any)),+        tasksSetStatus ::+          f+            :- "tasks"+            :> Capture "taskId" (Id (Task.Task Task.Any))+            :> ReqBody '[JSON] TaskStatus+            :> auth+            :> Post '[JSON] NoContent,+        postLog ::+          f+            :- "tasks"+            :> "log"+            :> ReqBody '[JSON] [Object]+            :> auth+            :> Post '[JSON] NoContent+      }+  deriving (Generic)

@@ -0,0 +1,26 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Hercules.API.Logs+  ( LogsAPI (..),+  )+where++import Data.ByteString (ByteString)+import Hercules.API.Prelude+import Servant.API+import Servant.API.Generic+import Servant.Auth++data LogsAPI logJWT f+  = LogsAPI+      { writeLog ::+          f+            :- Summary "Write to a log"+            :> Description "Writes an entire log in a single request. Provide a log-specific token for authentication."+            :> "log"+            :> Auth '[JWT] logJWT+            :> ReqBody '[OctetStream] ByteString+            :> Post '[JSON] NoContent+      }+  deriving (Generic)

@@ -0,0 +1,67 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms #-}++module Hercules.API.Logs.LogEntry where++import Control.Applicative+import qualified Data.Aeson.Types as A+import Data.Vector (Vector)+import Data.Word (Word64)+import Hercules.API.Prelude++newtype ActivityId = ActivityId Word64+  deriving newtype (ToJSON, FromJSON, Show, Eq)++newtype ActivityType = ActivityType Word64+  deriving newtype (ToJSON, FromJSON, Show, Eq)++newtype ResultType = ResultType Word64+  deriving newtype (ToJSON, FromJSON, Show, Eq)++pattern ResultTypeProgress :: ResultType+pattern ResultTypeProgress = ResultType 105++data Field = Int !Word64 | String !Text+  deriving (Eq, Show)++instance ToJSON Field where+  toJSON (Int int) = A.toJSON int+  toJSON (String s) = A.toJSON s++instance FromJSON Field where+  parseJSON v =+    Int <$> A.parseJSON v+      <|> String <$> A.parseJSON v++data LogEntry+  = Msg+      { i :: !Word64,+        ms :: !Word64,+        level :: !Int,+        msg :: !Text+      }+  | Start+      { i :: !Word64,+        ms :: !Word64,+        act :: !ActivityId,+        level :: !Int,+        typ :: !ActivityType,+        text :: !Text,+        fields :: !(Vector Field),+        parent :: !ActivityId+      }+  | Stop+      { i :: !Word64,+        ms :: !Word64,+        act :: !ActivityId+      }+  | Result+      { i :: !Word64,+        ms :: !Word64,+        act :: !ActivityId,+        rtype :: !ResultType,+        fields :: !(Vector Field)+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON)

@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Logs.LogMessage where++import Data.Vector+import Data.Word (Word64)+import Hercules.API.Logs.LogEntry+import Hercules.API.Prelude++data LogMessage+  = LogEntries (Vector LogEntry)+  | End {i :: !Word64, ms :: !Word64}+  deriving (Generic, Show, Eq, ToJSON, FromJSON)

@@ -0,0 +1,39 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Task where++import Data.Aeson+  ( FromJSON,+    ToJSON,+  )+import Data.Swagger (ToSchema)+import Data.Text (Text)+import GHC.Generics (Generic)+import Hercules.API.Id (Id)+import qualified Hercules.API.Id as Id+import Prelude hiding (id)++-- | A task, typically performed by the agent.+--+-- The phantom represents the type of task. See 'AnyTask'.+data Task a+  = Task+      { typ :: Text,+        id :: Id (Task a)+      }+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)++-- | @'Task' 'Any' represents tasks whose type has not yet been+-- read.+data Any++-- | Safe type cast.+upcast :: Task a -> Task Any+upcast = uncheckedCast++-- | Safe type cast.+upcastId :: Id (Task a) -> Id (Task Any)+upcastId = Id.uncheckedCast++uncheckedCast :: Task a -> Task b+uncheckedCast a = a {id = Id.uncheckedCast (id a)}

@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.TaskStatus where++import Data.Aeson+  ( FromJSON,+    ToJSON,+  )+import Data.Swagger (ToSchema)+import Data.Text (Text)+import GHC.Generics (Generic)+import Prelude++-- | Similar to a process exit code.+--+-- User feedback in case of an error must be communicated out of band+data TaskStatus+  = -- | Everything was ok.+    Successful ()+  | -- | We did what we could but dependents can not continue.+    Terminated ()+  | -- | Some assumption in the software failed.+    Exceptional Text+  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,52 @@+module Hercules.Formats.CachixCache where++import Data.Aeson+import Data.Foldable+import Data.Text (Text)+import Hercules.Formats.Common+  ( noVersion,+    withKind,+    withVersions,+  )+import Prelude++-- | Credentials and keys for a cache.+data CachixCache+  = CachixCache+      { signingKeys :: [Text],+        authToken :: Maybe Text,+        publicKeys :: [Text]+      }++instance ToJSON CachixCache where++  toJSON a =+    object $+      ["kind" .= String "CachixCache", "signingKeys" .= signingKeys a]+        <> foldMap (pure . ("authToken" .=)) (toList $ authToken a)+        <> ["publicKeys" .= publicKeys a]++  toEncoding a =+    pairs+      ( "kind"+          .= String "CachixCache"+          <> "signingKeys"+          .= signingKeys a+          <> foldMap ("authToken" .=) (authToken a)+          <> "publicKeys"+          .= publicKeys a+      )++instance FromJSON CachixCache where+  parseJSON =+    withKind "CachixCache" $+      withVersions+        [ noVersion $ \o ->+            CachixCache+              <$> o+              .: "signingKeys"+              <*> o+              .:? "authToken"+              <*> o+              .: "publicKeys"+        ]

@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Hercules.Formats.Common where++import Control.Monad+import Data.Aeson+  ( (.:),+    (.:?),+  )+import Data.Aeson.Types+  ( Object,+    Parser,+    Value,+    withObject,+  )+import Data.Coerce (coerce)+import qualified Data.List+import Data.Text (Text)+import qualified Data.Text as T+import Prelude++withKind :: Text -> (Object -> Parser a) -> Value -> Parser a+withKind k f = withObject (T.unpack k) $ \o -> do+  k' <- o .: "kind"+  when (k' /= k) $ fail $ "kind field must be " <> show k <> ", not " <> show k'+  f o++newtype VersionParser a+  = VersionParser+      { fromVersionParser :: (Maybe Text, Object -> Parser a)+      }+  deriving (Functor)++noVersion :: (Object -> Parser a) -> VersionParser a+noVersion = VersionParser . (Nothing,)++version :: Text -> (Object -> Parser a) -> VersionParser a+version t p = VersionParser (Just t, p)++withVersions :: forall a. [VersionParser a] -> Object -> Parser a+withVersions vps' o = do+  let vps = coerce vps' :: [(Maybe Text, Object -> Parser a)]+  v <- o .:? "apiVersion"+  case Data.List.lookup v vps of+    Just p -> p o+    Nothing ->+      let vs = map fst vps+       in case vs of+            [Nothing] -> fail "Unexpected apiVersion field. "+            _ ->+              fail $+                "Expected apiVersion to be one of "+                  <> unwords+                    (map showVersion vs)+              where+                showVersion Nothing = "<no version field>"+                showVersion (Just t) = show t

@@ -0,0 +1,48 @@+module Hercules.Formats.NixCache where++import Data.Aeson+import Data.Text (Text)+import Hercules.Formats.Common+  ( noVersion,+    withKind,+    withVersions,+  )+import Prelude++-- | Credentials and keys for a cache.+data NixCache+  = NixCache+      { storeURI :: Text,+        signingKeys :: [Text],+        publicKeys :: [Text]+      }++instance ToJSON NixCache where++  toJSON a =+    object $+      [ "kind" .= String "NixCache",+        "storeURI" .= storeURI a,+        "signingKeys" .= signingKeys a,+        "publicKeys" .= publicKeys a+      ]++  toEncoding a =+    pairs+      ( "kind"+          .= String "NixCache"+          <> "storeURI" .= storeURI a+          <> "signingKeys" .= signingKeys a+          <> "publicKeys" .= publicKeys a+      )++instance FromJSON NixCache where+  parseJSON =+    withKind "NixCache" $+      withVersions+        [ noVersion $ \o ->+            NixCache+              <$> o .: "storeURI"+              <*> o .: "signingKeys"+              <*> o .: "publicKeys"+        ]

@@ -0,0 +1,31 @@+{-# LANGUAGE ScopedTypeVariables #-}++module AesonSupport where++import Data.Aeson+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Test.Hspec+import Test.QuickCheck+import Prelude++checkLaws :: forall a. (ToJSON a, FromJSON a, Eq a) => Gen a -> Spec+checkLaws gen =+  describe "ToJSON/FromJSON laws" $ do+    it "obey partial isomorphism"+      $ property+      $ do+        a <- gen+        pure $ counterexample (T.unpack . T.decodeUtf8 . BL.toStrict . encode $ a) (fromJSON (toJSON a) == Data.Aeson.Success a)+    it "obey toJSON/toEncoding equivalence"+      $ property+      $ do+        a <- gen+        pure $+          counterexample+            (T.unpack . T.decodeUtf8 . BL.toStrict . encode $ a)+            ( Right (toJSON a)+                == eitherDecode (BB.toLazyByteString (fromEncoding (toEncoding a)))+            )

@@ -0,0 +1,31 @@+module Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec where++import Data.Aeson (eitherDecode, encode)+import qualified Data.ByteString.Lazy as BL+import Data.Map (fromList)+import Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo+import Test.Hspec+import Prelude++objectV1, objectV2 :: DerivationInfo++jsonV1, jsonV2 :: BL.ByteString+jsonV1 = "{\"inputDerivations\":{\"/nix/store/1kircip4wskspsqqzxbmh6ss73iqh9ah-bash-4.4-p23.drv\":[\"out\"],\"/nix/store/0si75icim8ajxcsp25d9c52m42kqg1xj-stdenv-linux.drv\":[\"out\"],\"/nix/store/5kpp7mly0qad7l451xhr60k0wbv6vivi-jquery-1.11.3.drv\":[\"out\"],\"/nix/store/kyxayhm3r6gpzbg1d57fwb8m7gkmpwcy-nixos-test-driver-agent-test.drv\":[\"out\"],\"/nix/store/qzvim3ca1s5zxbbvpzzipizfnfpdf5r2-libxslt-1.1.33.drv\":[\"dev\"],\"/nix/store/id49f28qvggmzpmlxp511v6yhc070lkf-jquery-ui-1.11.4.drv\":[\"out\"]},\"platform\":\"x86_64-linux\",\"inputSources\":[\"/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh\",\"/nix/store/fs6a6m9s5n367dslsvsl9lg89h3ns3ya-logfile.css\",\"/nix/store/jjh6h82n5rhw45badlpbj1yv7y6m48h2-log2html.xsl\",\"/nix/store/kdangwwh47ngwxk859ibbvkj4vmm9rzr-treebits.js\"],\"outputs\":{\"out\":{\"path\":\"/nix/store/7vg7ij5933dhg6dh22fvs90bbzmzg8kj-vm-test-run-agent-test\",\"isFixed\":false}},\"derivationPath\":\"testdata/vm-test-run-agent-test.drv\"}"++objectV1 = DerivationInfo {derivationPath = "testdata/vm-test-run-agent-test.drv", platform = "x86_64-linux", requiredSystemFeatures = [], inputDerivations = fromList [("/nix/store/0si75icim8ajxcsp25d9c52m42kqg1xj-stdenv-linux.drv", ["out"]), ("/nix/store/1kircip4wskspsqqzxbmh6ss73iqh9ah-bash-4.4-p23.drv", ["out"]), ("/nix/store/5kpp7mly0qad7l451xhr60k0wbv6vivi-jquery-1.11.3.drv", ["out"]), ("/nix/store/id49f28qvggmzpmlxp511v6yhc070lkf-jquery-ui-1.11.4.drv", ["out"]), ("/nix/store/kyxayhm3r6gpzbg1d57fwb8m7gkmpwcy-nixos-test-driver-agent-test.drv", ["out"]), ("/nix/store/qzvim3ca1s5zxbbvpzzipizfnfpdf5r2-libxslt-1.1.33.drv", ["dev"])], inputSources = ["/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh", "/nix/store/fs6a6m9s5n367dslsvsl9lg89h3ns3ya-logfile.css", "/nix/store/jjh6h82n5rhw45badlpbj1yv7y6m48h2-log2html.xsl", "/nix/store/kdangwwh47ngwxk859ibbvkj4vmm9rzr-treebits.js"], outputs = fromList [("out", OutputInfo {path = "/nix/store/7vg7ij5933dhg6dh22fvs90bbzmzg8kj-vm-test-run-agent-test", isFixed = False})]}++jsonV2 = "{\"inputDerivations\":{\"/nix/store/1kircip4wskspsqqzxbmh6ss73iqh9ah-bash-4.4-p23.drv\":[\"out\"],\"/nix/store/0si75icim8ajxcsp25d9c52m42kqg1xj-stdenv-linux.drv\":[\"out\"],\"/nix/store/5kpp7mly0qad7l451xhr60k0wbv6vivi-jquery-1.11.3.drv\":[\"out\"],\"/nix/store/kyxayhm3r6gpzbg1d57fwb8m7gkmpwcy-nixos-test-driver-agent-test.drv\":[\"out\"],\"/nix/store/qzvim3ca1s5zxbbvpzzipizfnfpdf5r2-libxslt-1.1.33.drv\":[\"dev\"],\"/nix/store/id49f28qvggmzpmlxp511v6yhc070lkf-jquery-ui-1.11.4.drv\":[\"out\"]},\"platform\":\"x86_64-linux\",\"inputSources\":[\"/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh\",\"/nix/store/fs6a6m9s5n367dslsvsl9lg89h3ns3ya-logfile.css\",\"/nix/store/jjh6h82n5rhw45badlpbj1yv7y6m48h2-log2html.xsl\",\"/nix/store/kdangwwh47ngwxk859ibbvkj4vmm9rzr-treebits.js\"],\"outputs\":{\"out\":{\"path\":\"/nix/store/7vg7ij5933dhg6dh22fvs90bbzmzg8kj-vm-test-run-agent-test\",\"isFixed\":false}},\"derivationPath\":\"testdata/vm-test-run-agent-test.drv\",\"requiredSystemFeatures\":[\"kvm\",\"nixos-test\"]}"++objectV2 = DerivationInfo {derivationPath = "testdata/vm-test-run-agent-test.drv", platform = "x86_64-linux", requiredSystemFeatures = ["kvm", "nixos-test"], inputDerivations = fromList [("/nix/store/0si75icim8ajxcsp25d9c52m42kqg1xj-stdenv-linux.drv", ["out"]), ("/nix/store/1kircip4wskspsqqzxbmh6ss73iqh9ah-bash-4.4-p23.drv", ["out"]), ("/nix/store/5kpp7mly0qad7l451xhr60k0wbv6vivi-jquery-1.11.3.drv", ["out"]), ("/nix/store/id49f28qvggmzpmlxp511v6yhc070lkf-jquery-ui-1.11.4.drv", ["out"]), ("/nix/store/kyxayhm3r6gpzbg1d57fwb8m7gkmpwcy-nixos-test-driver-agent-test.drv", ["out"]), ("/nix/store/qzvim3ca1s5zxbbvpzzipizfnfpdf5r2-libxslt-1.1.33.drv", ["dev"])], inputSources = ["/nix/store/9krlzvny65gdc8s7kpb6lkx8cd02c25b-default-builder.sh", "/nix/store/fs6a6m9s5n367dslsvsl9lg89h3ns3ya-logfile.css", "/nix/store/jjh6h82n5rhw45badlpbj1yv7y6m48h2-log2html.xsl", "/nix/store/kdangwwh47ngwxk859ibbvkj4vmm9rzr-treebits.js"], outputs = fromList [("out", OutputInfo {path = "/nix/store/7vg7ij5933dhg6dh22fvs90bbzmzg8kj-vm-test-run-agent-test", isFixed = False})]}++spec :: Spec+spec = do+  describe "DerivationInfo" $ do+    describe "FromJSON" $ do+      it "parses v1 correctly" $ do+        eitherDecode jsonV1 `shouldBe` Right objectV1+      it "parses v2 correctly" $ do+        eitherDecode jsonV2 `shouldBe` Right objectV2+    describe "ToJSON" $ do+      it "encodes v2 correctly" $ do+        encode objectV2 `shouldBe` jsonV2

@@ -0,0 +1,67 @@+module Hercules.API.Agent.LifeCycle.AgentInfoSpec where++import Data.Aeson (eitherDecode, encode)+import qualified Data.ByteString.Lazy as BL+import Hercules.API.Agent.LifeCycle.AgentInfo+import Test.Hspec+import Prelude++objectV1, objectV2, objectV3 :: AgentInfo++jsonV1, jsonV2, jsonV3 :: BL.ByteString+jsonV1 = "{\"platforms\":[\"riscv-sel4\"],\"hostname\":\"a\",\"nixVersion\":\"nv\",\"agentVersion\":\"v\",\"cachixPushCaches\":[\"c1\",\"c2\"],\"systemFeatures\":[\"f1\",\"f2\"],\"substituters\":[\"s1\",\"s2\"]}"++objectV1 = AgentInfo+  { hostname = "a",+    agentVersion = "v",+    nixVersion = "nv",+    platforms = ["riscv-sel4"],+    systemFeatures = ["f1", "f2"],+    cachixPushCaches = ["c1", "c2"],+    pushCaches = [],+    substituters = ["s1", "s2"],+    concurrentTasks = 2 -- the hardcoded default+  }++jsonV2 = "{\"platforms\":[\"riscv-sel4\"],\"hostname\":\"a\",\"nixVersion\":\"nv\",\"agentVersion\":\"v\",\"cachixPushCaches\":[\"c1\",\"c2\"],\"systemFeatures\":[\"f1\",\"f2\"],\"substituters\":[\"s1\",\"s2\"], \"concurrentTasks\": 19}"++objectV2 = AgentInfo+  { hostname = "a",+    agentVersion = "v",+    nixVersion = "nv",+    platforms = ["riscv-sel4"],+    systemFeatures = ["f1", "f2"],+    cachixPushCaches = ["c1", "c2"],+    pushCaches = [],+    substituters = ["s1", "s2"],+    concurrentTasks = 19 -- something else+  }++jsonV3 = "{\"platforms\":[\"riscv-sel4\"],\"hostname\":\"a\",\"nixVersion\":\"nv\",\"agentVersion\":\"v\",\"cachixPushCaches\":[\"c1\",\"c2\"],\"pushCaches\":[\"pc1\",\"pc2\"],\"systemFeatures\":[\"f1\",\"f2\"],\"substituters\":[\"s1\",\"s2\"], \"concurrentTasks\": 19}"++objectV3 = AgentInfo+  { hostname = "a",+    agentVersion = "v",+    nixVersion = "nv",+    platforms = ["riscv-sel4"],+    systemFeatures = ["f1", "f2"],+    cachixPushCaches = ["c1", "c2"],+    pushCaches = ["pc1", "pc2"],+    substituters = ["s1", "s2"],+    concurrentTasks = 19 -- something else+  }++spec :: Spec+spec = describe "AgentInfo" $ do+  describe "FromJSON" $ do+    it "parses v1 correctly" $ eitherDecode jsonV1 `shouldBe` Right objectV1+    it "parses v2 correctly" $ eitherDecode jsonV2 `shouldBe` Right objectV2+    it "parses v3 correctly" $ eitherDecode jsonV3 `shouldBe` Right objectV3+  describe "ToJSON"+    $ it "encodes v2 correctly"+    $ eitherDecode (encode objectV2)+      `shouldBe` Right objectV2+  describe "ToJSON"+    $ it "encodes v3 correctly"+    $ eitherDecode (encode objectV3)+      `shouldBe` Right objectV3

@@ -0,0 +1,60 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Hercules.Formats.CachixCacheSpec where++import qualified AesonSupport as Aeson+import Data.Aeson (eitherDecode)+import Data.Either (isLeft)+import qualified Data.Text as T+import Data.Text (Text)+import Hercules.Formats.CachixCache+import Test.Hspec+import Test.QuickCheck+import Prelude++deriving instance Eq CachixCache++deriving instance Show CachixCache++spec :: Spec+spec = describe "CachixCache" $ do+  Aeson.checkLaws genKeys+  it "Decodes example 'full'" $+    eitherDecode+      "{\"kind\":\"CachixCache\",\"publicKeys\":[\"hello:world\"],\"signingKeys\":[\"DEADBEEF==\"],\"authToken\":\"eyHowdyadoin\"}"+      `shouldBe` Right+        ( CachixCache+            { signingKeys = ["DEADBEEF=="],+              authToken = Just "eyHowdyadoin",+              publicKeys = ["hello:world"]+            }+        )+  it "Decodes example 'no authToken'" $+    eitherDecode+      "{\"kind\":\"CachixCache\",\"publicKeys\":[\"hello:world\"],\"signingKeys\":[\"DEADBEEF==\"]}"+      `shouldBe` Right+        ( CachixCache+            { signingKeys = ["DEADBEEF=="],+              authToken = Nothing,+              publicKeys = ["hello:world"]+            }+        )+  it "Does not decode unknown versions" $+    let r :: Either [Char] CachixCache+        r =+          eitherDecode+            "{\"kind\":\"CachixCache\",\"apiVersion\":\"0.99\",\"publicKeys\":[\"hello:world\"],\"signingKeys\":[\"DEADBEEF==\"]}"+        Left e = r+     in do+          isLeft r `shouldBe` True+          e `shouldContain` "Unexpected apiVersion field."++genKeys :: Gen CachixCache+genKeys =+  resize+    6+    (CachixCache <$> liftArbitrary text <*> liftArbitrary text <*> liftArbitrary text)++text :: Gen Text+text = T.pack <$> resize 4 arbitrary

@@ -0,0 +1,10 @@+module Main where++import qualified Spec+import Test.Hspec.Runner+import Prelude++main :: IO ()+main = hspecWith config Spec.spec+  where+    config = defaultConfig {configColorMode = ColorAlways}

@@ -0,0 +1,16 @@+module Spec where++import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec+import qualified Hercules.API.Agent.LifeCycle.AgentInfoSpec+import qualified Hercules.Formats.CachixCacheSpec+import Test.Hspec+import Prelude++spec :: Spec+spec = describe "hercules-ci-api" $ do+  describe "Hercules.API.Agent.LifeCycle.AgentInfo" $+    Hercules.API.Agent.LifeCycle.AgentInfoSpec.spec+  describe "Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo" $+    Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec.spec+  describe "Hercules.Formats.CachixCache" $+    Hercules.Formats.CachixCacheSpec.spec