hercules-ci-api-agent 0.2.2.0 → 0.3.0.0

raw patch · 46 files changed

+590/−467 lines, 46 filesdep +deepseqdep +quickcheck-classesdep −servant-auth-swaggerdep −servant-swaggerdep −servant-swagger-ui-coredep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, quickcheck-classes

Dependencies removed: servant-auth-swagger, servant-swagger, servant-swagger-ui-core

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• hercules-ci-api-agent.cabal +9/−8
• src/Hercules/API/Agent.hs +10/−7
• src/Hercules/API/Agent/Build.hs +27/−29
• src/Hercules/API/Agent/Build/BuildEvent.hs +1/−1
• src/Hercules/API/Agent/Build/BuildEvent/OutputInfo.hs +13/−14
• src/Hercules/API/Agent/Build/BuildEvent/Pushed.hs +4/−5
• src/Hercules/API/Agent/Build/BuildTask.hs +8/−17
• src/Hercules/API/Agent/Effect/EffectTask.hs +15/−0
• src/Hercules/API/Agent/Evaluate.hs +31/−32
• src/Hercules/API/Agent/Evaluate/DerivationStatus.hs +1/−1
• src/Hercules/API/Agent/Evaluate/EvaluateEvent.hs +1/−1
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/AttributeErrorEvent.hs +7/−9
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/AttributeEvent.hs +26/−7
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/BuildRequest.hs +6/−7
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/BuildRequired.hs +6/−7
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/DerivationInfo.hs +14/−16
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/Message.hs +8/−16
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/PushedAll.hs +4/−5
• src/Hercules/API/Agent/Evaluate/EvaluateTask.hs +23/−37
• src/Hercules/API/Agent/LifeCycle.hs +45/−46
• src/Hercules/API/Agent/LifeCycle/AgentInfo.hs +13/−14
• src/Hercules/API/Agent/LifeCycle/CreateAgentSession.hs +7/−8
• src/Hercules/API/Agent/LifeCycle/CreateAgentSession_V2.hs +4/−5
• src/Hercules/API/Agent/LifeCycle/ServiceInfo.hs +6/−7
• src/Hercules/API/Agent/LifeCycle/StartInfo.hs +12/−14
• src/Hercules/API/Agent/Socket/AgentPayload.hs +3/−3
• src/Hercules/API/Agent/Socket/Frame.hs +1/−1
• src/Hercules/API/Agent/Socket/ServicePayload.hs +4/−2
• src/Hercules/API/Agent/State.hs +32/−0
• src/Hercules/API/Agent/Tasks.hs +21/−22
• src/Hercules/API/Logs.hs +10/−11
• src/Hercules/API/Logs/LogEntry.hs +5/−5
• src/Hercules/API/Logs/LogMessage.hs +1/−1
• src/Hercules/API/Task.hs +6/−15
• src/Hercules/API/TaskStatus.hs +2/−9
• src/Hercules/Formats/CachixCache.hs +6/−9
• src/Hercules/Formats/Common.hs +3/−4
• src/Hercules/Formats/NixCache.hs +12/−11
• src/Hercules/Formats/Secret.hs +34/−0
• test/AesonSupport.hs +15/−15
• test/Hercules/API/Agent/Evaluate/EvaluateEvent/DerivationInfoSpec.hs +0/−2
• test/Hercules/API/Agent/LifeCycle/AgentInfoSpec.hs +44/−43
• test/Hercules/Formats/CachixCacheSpec.hs +1/−1
• test/Hercules/Formats/SecretSpec.hs +72/−0
• test/Spec.hs +3/−0

@@ -5,6 +5,20 @@  The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). +## 0.3.0.0 - 2020-03-07++### Added++ - Input source metadata field for src.ref, src.rev+ - Effects tasks+ - A non-API type for the secrets in secrets.json+ - State file API+ - Attribute types, including MustFail, DependenciesOnly, Effect++### Removed++ - `ToSchema` instances+ ## 0.2.2.0 - 2020-07-18  ### Added

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           hercules-ci-api-agent-version:        0.2.2.0+version:        0.3.0.0 synopsis:       API definition for Hercules CI Agent to talk to hercules-ci.com or Hercules CI Enterprise category:       API, CI, Testing, DevOps, Nix homepage:       https://github.com/hercules-ci/hercules-ci-agent#readme@@ -25,6 +25,7 @@       Hercules.API.Agent.Build.BuildEvent.Pushed       Hercules.API.Agent.Build.BuildEvent.OutputInfo       Hercules.API.Agent.Build.BuildTask+      Hercules.API.Agent.Effect.EffectTask       Hercules.API.Agent.Evaluate       Hercules.API.Agent.Evaluate.DerivationStatus       Hercules.API.Agent.Evaluate.EvaluateEvent@@ -45,6 +46,7 @@       Hercules.API.Agent.Socket.Frame       Hercules.API.Agent.Socket.AgentPayload       Hercules.API.Agent.Socket.ServicePayload+      Hercules.API.Agent.State       Hercules.API.Agent.Tasks       Hercules.API.Agent       Hercules.API.Logs@@ -55,6 +57,7 @@       Hercules.Formats.CachixCache       Hercules.Formats.Common       Hercules.Formats.NixCache+      Hercules.Formats.Secret   hs-source-dirs:       src   default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators@@ -66,6 +69,7 @@     , base64-bytestring-type     , containers     , cookie+    , deepseq     , exceptions     , hashable     , hercules-ci-api-core@@ -76,9 +80,6 @@     , memory     , servant >=0.14.1     , servant-auth-    , servant-auth-swagger-    , servant-swagger-    , servant-swagger-ui-core     , string-conv     , swagger2     , text@@ -96,13 +97,14 @@       Hercules.API.Agent.LifeCycle.AgentInfoSpec       Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec       Hercules.Formats.CachixCacheSpec+      Hercules.Formats.SecretSpec   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+    , base     , bytestring     , containers     , cookie@@ -116,15 +118,14 @@     , memory     , network-uri     , QuickCheck+    , quickcheck-classes     , profunctors     , 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

@@ -12,6 +12,9 @@ import Hercules.API.Agent.LifeCycle   ( LifeCycleAPI,   )+import Hercules.API.Agent.State+  ( StateAPI,+  ) import Hercules.API.Agent.Tasks   ( TasksAPI,   )@@ -20,13 +23,13 @@ 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)-      }+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),+    state :: f :- ToServantApi (StateAPI auth)+  }   deriving (Generic)  -- TODO check that we don't have overlapping endpoints and remove cookie

@@ -9,36 +9,34 @@ 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-      }+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" #-}

@@ -15,4 +15,4 @@   | Pushed Pushed   | -- | legacy     Done Bool-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -4,17 +4,16 @@  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)+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, NFData, ToJSON, FromJSON)

@@ -4,8 +4,7 @@  import Hercules.API.Prelude -data Pushed-  = Pushed-      { cache :: Text-      }-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+data Pushed = Pushed+  { cache :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -2,22 +2,13 @@  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.Prelude 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)+data BuildTask = BuildTask+  { id :: Id (Task BuildTask),+    derivationPath :: Text,+    logToken :: Text,+    inputDerivationOutputPaths :: [Text]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -0,0 +1,15 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Effect.EffectTask where++import Hercules.API.Prelude+import Hercules.API.Task (Task)++data EffectTask = EffectTask+  { id :: Id (Task EffectTask),+    derivationPath :: Text,+    logToken :: Text,+    inputDerivationOutputPaths :: [Text],+    token :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -15,36 +15,35 @@ 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))-      }+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)

@@ -11,4 +11,4 @@   | BuildFailure   | DependencyFailure   | BuildSuccess-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -33,4 +33,4 @@   | PushedAll PushedAll   | BuildRequired BuildRequired   | BuildRequest BuildRequest-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -5,17 +5,15 @@ 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)+data AttributeErrorEvent = AttributeErrorEvent+  { expressionPath :: [Text],+    errorMessage :: Text,+    errorDerivation :: Maybe Text,+    errorType :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData)  instance ToJSON AttributeErrorEvent where-   toJSON = genericToJSON aesonOptions    toEncoding = genericToEncoding aesonOptions

@@ -3,12 +3,31 @@  module Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeEvent where +import Control.Applicative (Alternative ((<|>)))+import Control.Lens ((%~))+import Control.Lens.At (At (at))+import qualified Data.Aeson as A+import Data.Aeson.Lens (_Object) import Hercules.API.Prelude -data AttributeEvent-  = AttributeEvent-      { expressionPath :: [Text],-        derivationPath :: Text-        -- TODO: meta attributes-      }-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+data AttributeType+  = Regular+  | MustFail+  | MayFail+  | DependenciesOnly+  | Effect+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)++data AttributeEvent = AttributeEvent+  { expressionPath :: [Text],+    derivationPath :: Text,+    typ :: AttributeType+    -- TODO: meta attributes+  }+  deriving (Generic, Show, Eq, NFData, ToJSON)++instance FromJSON AttributeEvent where+  parseJSON v = A.genericParseJSON A.defaultOptions (fixup v)+    where+      fixup :: A.Value -> A.Value+      fixup = _Object . at "typ" %~ (<|> Just (A.String "Regular"))

@@ -4,17 +4,16 @@ module Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequest where  import Control.Applicative-import Control.Lens ((%~), at)+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)+data BuildRequest = BuildRequest+  { derivationPath :: Text,+    forceRebuild :: Bool -- FIXME: API compatibility+  }+  deriving (Generic, Show, Eq, NFData, ToJSON)  instance FromJSON BuildRequest where   parseJSON = A.genericParseJSON A.defaultOptions . fixup

@@ -5,10 +5,9 @@  import Hercules.API.Prelude -data BuildRequired-  = BuildRequired-      { index :: Int,-        derivationPath :: Text,-        outputName :: Text-      }-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+data BuildRequired = BuildRequired+  { index :: Int,+    derivationPath :: Text,+    outputName :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -15,16 +15,15 @@ -- | 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)+data DerivationInfo = DerivationInfo+  { derivationPath :: DerivationPathText,+    platform :: Text,+    requiredSystemFeatures :: [Text],+    inputDerivations :: Map DerivationPathText [OutputNameText],+    inputSources :: [DerivationPathText],+    outputs :: Map OutputNameText OutputInfo+  }+  deriving (Generic, Show, Eq, NFData, ToJSON)  instance FromJSON DerivationInfo where   parseJSON = A.genericParseJSON A.defaultOptions . fixup@@ -32,9 +31,8 @@       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)+data OutputInfo = OutputInfo+  { path :: Text,+    isFixed :: Bool+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -2,22 +2,14 @@  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+import Hercules.API.Prelude -data Message-  = Message-      { index :: Int,-        typ :: Type,-        message :: Text-      }-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+data Message = Message+  { index :: Int,+    typ :: Type,+    message :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)  data Type   = -- | Something went wrong, inform user about possible@@ -32,4 +24,4 @@     -- @trace@. Indeed side effecting evaluation breaks the     -- abstraction.     Trace-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -5,8 +5,7 @@ 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)+data PushedAll = PushedAll+  { cache :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -3,47 +3,33 @@  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 Data.Aeson (Value)+import Hercules.API.Prelude 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-        logToken :: Text-      }-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+data EvaluateTask = EvaluateTask+  { id :: Id (Task EvaluateTask),+    primaryInput :: Text, -- Obsolete since >= 0.8+    otherInputs :: Map Identifier Text, -- identifier -> HTTP URL+    inputMetadata :: Map Identifier (Map Text Value),+    autoArguments :: Map Text (SubPathOf Identifier), -- argument name -> identifier+    nixPath :: [NixPathElement (SubPathOf Identifier)], -- NIX_PATH element -> identifier+    logToken :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)  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)+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, NFData, ToJSON, FromJSON, Functor, Foldable, Traversable)  -- | 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)+data SubPathOf a = SubPathOf+  { path :: a,+    subPath :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, Functor, Foldable, Traversable)

@@ -16,50 +16,49 @@ 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-      }+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)

@@ -3,25 +3,24 @@ module Hercules.API.Agent.LifeCycle.AgentInfo where  import Control.Applicative-import Control.Lens ((%~), at)+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)+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, NFData, ToJSON)  instance FromJSON AgentInfo where   parseJSON = A.genericParseJSON A.defaultOptions . fixup

@@ -6,11 +6,10 @@  {-# 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)+data CreateAgentSession = CreateAgentSession+  { hostname :: Text,+    agentVersion :: Text,+    nixVersion :: Text,+    architectures :: [Text]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -5,8 +5,7 @@ import Hercules.API.Agent.LifeCycle.AgentInfo import Hercules.API.Prelude -data CreateAgentSession-  = CreateAgentSession-      { agentInfo :: AgentInfo-      }-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+data CreateAgentSession = CreateAgentSession+  { agentInfo :: AgentInfo+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -7,10 +7,9 @@  import Hercules.API.Prelude -data ServiceInfo-  = ServiceInfo-      { version :: (Int, Int),-        agentSocketBaseURL :: Text,-        bulkSocketBaseURL :: Text-      }-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+data ServiceInfo = ServiceInfo+  { version :: (Int, Int),+    agentSocketBaseURL :: Text,+    bulkSocketBaseURL :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -3,20 +3,19 @@ module Hercules.API.Agent.LifeCycle.StartInfo where  import Control.Applicative-import Control.Lens ((%~), at)+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)+data Hello = Hello+  { agentInfo :: AgentInfo,+    startInfo :: StartInfo,+    tasksInProgress :: [Id (Task Any)]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON)  instance FromJSON Hello where   parseJSON = A.genericParseJSON A.defaultOptions . fixup@@ -24,9 +23,8 @@       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)+data StartInfo = StartInfo+  { id :: Id StartInfo,+    startTime :: UTCTime+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -12,10 +12,10 @@   | Ping   | Started Started   | Cancelled Cancelled-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)  data Started = MkStarted {taskId :: Id (Task Task.Any)}-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)  data Cancelled = MkCancelled {taskId :: Id (Task Task.Any)}-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -17,7 +17,7 @@     Ack {n :: Integer}   | -- | Exception     Exception {message :: Text}-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)  mapOob :: (a -> b) -> Frame a c -> Frame b c mapOob f (Oob a) = Oob (f a)

@@ -3,17 +3,19 @@ module Hercules.API.Agent.Socket.ServicePayload where  import Hercules.API.Agent.Build.BuildTask (BuildTask)+import Hercules.API.Agent.Effect.EffectTask (EffectTask) 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)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)  data ServicePayload   = ServiceInfo ServiceInfo   | StartEvaluation EvaluateTask   | StartBuild BuildTask+  | StartEffect EffectTask   | Cancel Cancel-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds #-}++module Hercules.API.Agent.State where++import Data.ByteString (ByteString)+import Hercules.API.Prelude+import Servant.API+import Servant.API.Generic++type ContentLength = Header "Content-Length" Integer++data StateAPI auth f = StateAPI+  { getState ::+      f+        :- "current-task"+        :> "state"+        :> Capture' '[Required] "name" Text+        :> "data"+        :> auth+        :> StreamGet NoFraming OctetStream (Headers '[ContentLength] (SourceIO ByteString)),+    putState ::+      f+        :- "current-task"+        :> "state"+        :> Capture' '[Required] "name" Text+        :> "data"+        :> StreamBody NoFraming OctetStream (SourceIO ByteString)+        :> ContentLength+        :> auth+        :> Put '[JSON] NoContent+  }+  deriving (Generic)

@@ -9,26 +9,25 @@ 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-      }+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)

@@ -12,15 +12,14 @@ 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-      }+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)

@@ -12,19 +12,19 @@ import Hercules.API.Prelude  newtype ActivityId = ActivityId Word64-  deriving newtype (ToJSON, FromJSON, Show, Eq)+  deriving newtype (ToJSON, FromJSON, Show, Eq, NFData)  newtype ActivityType = ActivityType Word64-  deriving newtype (ToJSON, FromJSON, Show, Eq)+  deriving newtype (ToJSON, FromJSON, Show, Eq, NFData)  newtype ResultType = ResultType Word64-  deriving newtype (ToJSON, FromJSON, Show, Eq)+  deriving newtype (ToJSON, FromJSON, Show, Eq, NFData)  pattern ResultTypeProgress :: ResultType pattern ResultTypeProgress = ResultType 105  data Field = Int !Word64 | String !Text-  deriving (Eq, Show)+  deriving (Eq, Show, Generic, NFData)  instance ToJSON Field where   toJSON (Int int) = A.toJSON int@@ -64,4 +64,4 @@         rtype :: !ResultType,         fields :: !(Vector Field)       }-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -10,4 +10,4 @@ data LogMessage   = LogEntries (Vector LogEntry)   | End {i :: !Word64, ms :: !Word64}-  deriving (Generic, Show, Eq, ToJSON, FromJSON)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -2,26 +2,17 @@  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)+import Hercules.API.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)+data Task a = Task+  { typ :: Text,+    id :: Id (Task a)+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)  -- | @'Task' 'Any' represents tasks whose type has not yet been -- read.

@@ -2,14 +2,7 @@  module Hercules.API.TaskStatus where -import Data.Aeson-  ( FromJSON,-    ToJSON,-  )-import Data.Swagger (ToSchema)-import Data.Text (Text)-import GHC.Generics (Generic)-import Prelude+import Hercules.API.Prelude  -- | Similar to a process exit code. --@@ -21,4 +14,4 @@     Terminated ()   | -- | Some assumption in the software failed.     Exceptional Text-  deriving (Generic, Show, Eq, ToJSON, FromJSON, ToSchema)+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -11,15 +11,13 @@ import Prelude  -- | Credentials and keys for a cache.-data CachixCache-  = CachixCache-      { signingKeys :: [Text],-        authToken :: Maybe Text,-        publicKeys :: [Text]-      }+data CachixCache = CachixCache+  { signingKeys :: [Text],+    authToken :: Maybe Text,+    publicKeys :: [Text]+  }  instance ToJSON CachixCache where-   toJSON a =     object $       ["kind" .= String "CachixCache", "signingKeys" .= signingKeys a]@@ -43,8 +41,7 @@       withVersions         [ noVersion $ \o ->             CachixCache-              <$> o-              .: "signingKeys"+              <$> (fold <$> o .:? "signingKeys")               <*> o               .:? "authToken"               <*> o

@@ -27,10 +27,9 @@   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)-      }+newtype VersionParser a = VersionParser+  { fromVersionParser :: (Maybe Text, Object -> Parser a)+  }   deriving (Functor)  noVersion :: (Object -> Parser a) -> VersionParser a

@@ -10,17 +10,15 @@ import Prelude  -- | Credentials and keys for a cache.-data NixCache-  = NixCache-      { storeURI :: Text,-        signingKeys :: [Text],-        publicKeys :: [Text]-      }+data NixCache = NixCache+  { storeURI :: Text,+    signingKeys :: [Text],+    publicKeys :: [Text]+  }  instance ToJSON NixCache where-   toJSON a =-    object $+    object       [ "kind" .= String "NixCache",         "storeURI" .= storeURI a,         "signingKeys" .= signingKeys a,@@ -31,9 +29,12 @@     pairs       ( "kind"           .= String "NixCache"-          <> "storeURI" .= storeURI a-          <> "signingKeys" .= signingKeys a-          <> "publicKeys" .= publicKeys a+          <> "storeURI"+          .= storeURI a+          <> "signingKeys"+          .= signingKeys a+          <> "publicKeys"+          .= publicKeys a       )  instance FromJSON NixCache where

@@ -0,0 +1,34 @@+module Hercules.Formats.Secret where++import Data.Aeson+import Data.Map (Map)+import Data.Text (Text)+import Hercules.Formats.Common+  ( noVersion,+    withKind,+    withVersions,+  )+import Prelude++-- | Arbitrary secret like keys, tokens, passwords etc.+data Secret = Secret+  { data_ :: Map Text Value+  }++instance ToJSON Secret where+  toJSON a =+    object+      ["kind" .= String "Secret", "data" .= data_ a]++  toEncoding a =+    pairs+      ("kind" .= String "Secret" <> "data" .= data_ a)++instance FromJSON Secret where+  parseJSON =+    withKind "Secret" $+      withVersions+        [ noVersion $ \o ->+            Secret+              <$> o .: "data"+        ]

@@ -14,18 +14,18 @@ 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)))-            )+    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)))+              )

@@ -8,10 +8,8 @@ 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\"]}"

@@ -7,49 +7,50 @@ 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-  }+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-  }+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-  }+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@@ -57,11 +58,11 @@     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+  describe "ToJSON" $+    it "encodes v2 correctly" $+      eitherDecode (encode objectV2)+        `shouldBe` Right objectV2+  describe "ToJSON" $+    it "encodes v3 correctly" $+      eitherDecode (encode objectV3)+        `shouldBe` Right objectV3

@@ -6,8 +6,8 @@ import qualified AesonSupport as Aeson import Data.Aeson (eitherDecode) import Data.Either (isLeft)-import qualified Data.Text as T import Data.Text (Text)+import qualified Data.Text as T import Hercules.Formats.CachixCache import Test.Hspec import Test.QuickCheck

@@ -0,0 +1,72 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Hercules.Formats.SecretSpec where++import qualified AesonSupport as Aeson+import Control.Applicative+import Data.Aeson (eitherDecode)+import qualified Data.Aeson as A+import Data.Char+import Data.Either (isLeft)+import Data.Int+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Vector as V+import Hercules.Formats.Secret+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Classes ()+import Prelude++deriving instance Eq Secret++deriving instance Show Secret++spec :: Spec+spec = describe "Secret" $ do+  Aeson.checkLaws genSecret+  it "Decodes example" $+    eitherDecode+      "{\"kind\":\"Secret\",\"data\":{\"key\": \"s3cr3t\"}}"+      `shouldBe` Right+        ( Secret+            { data_ = M.singleton "key" "s3cr3t"+            }+        )+  it "Does not decode unknown versions" $+    let r :: Either [Char] Secret+        r =+          eitherDecode+            "{\"kind\":\"Secret\",\"apiVersion\":\"0.99\",\"data\":{}}"+        Left e = r+     in do+          isLeft r `shouldBe` True+          e `shouldContain` "Unexpected apiVersion field."++genSecret :: Gen Secret+genSecret =+  resize+    6+    (Secret <$> liftArbitraryMap text (resize 100 genValue))++text :: Gen Text+text = TE.decodeUtf8 . TE.encodeUtf8 . T.pack <$> resize 4 arbitrary++liftArbitraryMap :: Ord k => Gen k -> Gen a -> Gen (M.Map k a)+liftArbitraryMap k v = M.fromList <$> liftArbitrary ((,) <$> k <*> v)++genValue :: Gen A.Value+genValue = sized \m -> do+  n <- choose (0, m `div` 2)+  let n' = m `div` 4+  frequency+    [ (2, A.String <$> text),+      (2, A.Array . V.fromList <$> vectorOf n (resize n' genValue)),+      (5, A.object <$> vectorOf n ((A..=) <$> text <*> (resize n' genValue))),+      (1, A.Number . fromIntegral <$> (arbitrary :: Gen Int64)), -- no fractions :( but doesn't matter here+      (1, A.Bool <$> arbitrary)+    ]

@@ -3,6 +3,7 @@ import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec import qualified Hercules.API.Agent.LifeCycle.AgentInfoSpec import qualified Hercules.Formats.CachixCacheSpec+import qualified Hercules.Formats.SecretSpec import Test.Hspec import Prelude @@ -14,3 +15,5 @@     Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec.spec   describe "Hercules.Formats.CachixCache" $     Hercules.Formats.CachixCacheSpec.spec+  describe "Hercules.Formats.Secret" $+    Hercules.Formats.SecretSpec.spec