hercules-ci-api-agent 0.4.1.2 → 0.4.2.0

raw patch · 15 files changed

+273/−44 lines, 15 filesdep +unordered-containersdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unordered-containers

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• hercules-ci-api-agent.cabal +9/−3
• src/Hercules/API/Agent/Effect/EffectTask.hs +6/−1
• src/Hercules/API/Agent/Evaluate/EvaluateEvent.hs +11/−21
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/InputDeclaration.hs +17/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/JobConfig.hs +11/−0
• src/Hercules/API/Agent/Evaluate/EvaluateEvent/OnPushHandlerEvent.hs +13/−0
• src/Hercules/API/Agent/Evaluate/EvaluateTask.hs +23/−2
• src/Hercules/API/Agent/Evaluate/ImmutableGitInput.hs +13/−0
• src/Hercules/API/Agent/Evaluate/ImmutableInput.hs +18/−0
• src/Hercules/API/Agent/Socket/Frame.hs +1/−1
• src/Hercules/Formats/Secret.hs +104/−6
• test/Hercules/API/Agent/Evaluate/EvaluateEvent/DerivationInfoSpec.hs +1/−1
• test/Hercules/Formats/SecretSpec.hs +27/−3
• test/Spec.hs +7/−6

@@ -5,6 +5,18 @@  The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/). +## 0.4.2.0 - 2022-03-15++### Added++ - "Selectors" to distinguish `OnPush`, `IsConfig` event, etc+ - Evaluation task: `ciSystems` parameter, `OnPush` selector, `extraGitCredentials`+ - Secrets: `condition` parameter++### Updated++ - aeson: 1 -> 2+ ## 0.4.1.2 - 2022-03-09  ### Added

@@ -1,14 +1,14 @@ cabal-version: 1.12  name:           hercules-ci-api-agent-version:        0.4.1.2+version:        0.4.2.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 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+copyright:      2018-2021 Hercules CI license:        Apache-2.0 build-type:     Simple extra-source-files:@@ -34,9 +34,14 @@       Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequest       Hercules.API.Agent.Evaluate.EvaluateEvent.BuildRequired       Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo+      Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration+      Hercules.API.Agent.Evaluate.EvaluateEvent.JobConfig       Hercules.API.Agent.Evaluate.EvaluateEvent.Message+      Hercules.API.Agent.Evaluate.EvaluateEvent.OnPushHandlerEvent       Hercules.API.Agent.Evaluate.EvaluateEvent.PushedAll       Hercules.API.Agent.Evaluate.EvaluateTask+      Hercules.API.Agent.Evaluate.ImmutableInput+      Hercules.API.Agent.Evaluate.ImmutableGitInput       Hercules.API.Agent.LifeCycle       Hercules.API.Agent.LifeCycle.AgentInfo       Hercules.API.Agent.LifeCycle.CreateAgentSession@@ -64,7 +69,7 @@   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+      aeson >= 2     , base >=4.7 && <5     , bytestring     , base64-bytestring-type@@ -85,6 +90,7 @@     , swagger2     , text     , time+    , unordered-containers     , uuid     , vector   default-language: Haskell2010

@@ -13,6 +13,11 @@     inputDerivationOutputPaths :: [Text],     token :: Text,     projectId :: Id "project",-    projectPath :: Text+    projectPath :: Text,+    siteName :: Text,+    ownerName :: Text,+    repoName :: Text,+    ref :: Text,+    isDefaultBranch :: Bool   }   deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -2,27 +2,15 @@  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.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.JobConfig (JobConfig)+import Hercules.API.Agent.Evaluate.EvaluateEvent.Message (Message)+import Hercules.API.Agent.Evaluate.EvaluateEvent.OnPushHandlerEvent (OnPushHandlerEvent)+import Hercules.API.Agent.Evaluate.EvaluateEvent.PushedAll (PushedAll) import Hercules.API.Prelude  data EvaluateEvent@@ -33,4 +21,6 @@   | PushedAll PushedAll   | BuildRequired BuildRequired   | BuildRequest BuildRequest+  | JobConfig JobConfig+  | OnPushHandlerEvent OnPushHandlerEvent   deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration where++import Hercules.API.Prelude++data InputDeclaration+  = SiblingInput SiblingInput+  | -- | Only exists to ensure correct serialization format. Will be replaced by a real second constructor.+    BogusInput Text+  deriving (Generic, Show, Eq, NFData, FromJSON, ToJSON)++data SiblingInput = MkSiblingInput+  { project :: Text,+    ref :: Maybe Text+  }+  deriving (Generic, Show, Eq, NFData, FromJSON, ToJSON)

@@ -0,0 +1,11 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.JobConfig where++import Hercules.API.Prelude++data JobConfig = JobConfig+  { sourceCaches :: Maybe [Text],+    binaryCaches :: Maybe [Text]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)

@@ -0,0 +1,13 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.EvaluateEvent.OnPushHandlerEvent where++import Hercules.API.Agent.Evaluate.EvaluateEvent.InputDeclaration (InputDeclaration)+import Hercules.API.Prelude++data OnPushHandlerEvent = OnPushHandlerEvent+  { handlerName :: Text,+    handlerExtraInputs :: Map Text InputDeclaration+  }+  deriving (Generic, Show, Eq, NFData, FromJSON, ToJSON)

@@ -1,9 +1,9 @@ {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE StandaloneDeriving #-}  module Hercules.API.Agent.Evaluate.EvaluateTask where  import Data.Aeson (Value)+import Hercules.API.Agent.Evaluate.ImmutableInput (ImmutableInput) import Hercules.API.Prelude import Hercules.API.Task (Task) @@ -14,7 +14,28 @@     inputMetadata :: Map Identifier (Map Text Value),     autoArguments :: Map Text (SubPathOf Identifier), -- argument name -> identifier     nixPath :: [NixPathElement (SubPathOf Identifier)], -- NIX_PATH element -> identifier-    logToken :: Text+    logToken :: Text,+    selector :: Selector,+    ciSystems :: Maybe (Map Text ()),+    extraGitCredentials :: Maybe [Credential]+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)++data Credential = Credential+  { url :: Text,+    username :: Text,+    password :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)++data Selector+  = ConfigOrLegacy+  | OnPush OnPush+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON)++data OnPush = MkOnPush+  { name :: Text,+    inputs :: Map Text ImmutableInput   }   deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON) 

@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.ImmutableGitInput where++import Hercules.API.Prelude++data ImmutableGitInput = ImmutableGitInput+  { rev :: Text,+    ref :: Text,+    sshURL :: Text,+    httpURL :: Text+  }+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)

@@ -0,0 +1,18 @@+{-# LANGUAGE DeriveAnyClass #-}++module Hercules.API.Agent.Evaluate.ImmutableInput where++import Hercules.API.Agent.Evaluate.ImmutableGitInput (ImmutableGitInput)+import Hercules.API.Prelude++-- | A location+data ImmutableInput+  = -- | A de facto immutable URL. Do not use with URLs locating mutable contents!+    --+    -- Translates to @builtins.fetchTarball@+    ArchiveUrl Text+  | -- | A git commit below a ref.+    --+    -- Translates to @builtins.fetchGit@+    Git ImmutableGitInput+  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)

@@ -28,5 +28,5 @@ 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 Oob {} = empty removeOob (Exception e) = pure $ Exception e

@@ -1,28 +1,125 @@ module Hercules.Formats.Secret where  import Data.Aeson-import Data.Map (Map)-import Data.Text (Text)+import qualified Data.Aeson.Key as AK+import qualified Data.Aeson.KeyMap as AM+import qualified Data.Aeson.Types as A+import Data.Foldable (toList)+import qualified Data.HashMap.Strict as HM+import Hercules.API.Prelude import Hercules.Formats.Common   ( noVersion,     withKind,     withVersions,   )-import Prelude +data Condition+  = Or [Condition]+  | And [Condition]+  | IsDefaultBranch+  | IsBranch Text+  | IsTag+  | IsRepo Text+  | IsOwner Text+  deriving (Generic, Eq, Read, Show)++instance ToJSON Condition where+  toJSON (Or a) = object ["or" .= a]+  toJSON (And a) = object ["and" .= a]+  toJSON IsDefaultBranch = String "isDefaultBranch"+  toJSON IsTag = String "isTag"+  toJSON (IsBranch a) = object ["isBranch" .= a]+  toJSON (IsRepo a) = object ["isRepo" .= a]+  toJSON (IsOwner a) = object ["isOwner" .= a]++instance FromJSON Condition where+  parseJSON (String "isTag") = pure IsTag+  parseJSON (String "isDefaultBranch") = pure IsDefaultBranch+  parseJSON (Object o) =+    case AM.toList o of+      [] -> fail "The empty object does not represent a Condition."+      [(k, v)] -> case HM.lookup (AK.toText k) taggedConditionParsers of+        Nothing -> fail $ "The field name in a Condition object must be one of " <> show (map fst (HM.toList taggedConditionParsers))+        Just p -> p v+      _ -> fail "A Condition object must contain a single field."+  parseJSON _ = fail "Expected Object or String."++taggedConditionParsers :: HM.HashMap Text (Value -> A.Parser Condition)+taggedConditionParsers =+  HM.fromList+    [ ( "or",+        \v -> do+          params <- parseJSON v+          Or <$> traverse parseJSON params+      ),+      ( "and",+        \v -> do+          params <- parseJSON v+          And <$> traverse parseJSON params+      ),+      ("isBranch", fmap IsBranch . parseJSON),+      ("isRepo", fmap IsRepo . parseJSON),+      ("isOwner", fmap IsOwner . parseJSON)+    ]++{-++This was awful:++instance FromJSON Condition where+  parseJSON (String "isTag") = pure IsTag+  parseJSON (String "isDefaultBranch") = pure IsDefaultBranch+  parseJSON j = do+    l <- parseJSON j+    case l of+      [] -> fail "The empty list does not represent a Condition."+      (jTag : args) -> do+        tag <- parseJSON jTag+        case tag :: Text of+          "or" -> do+            Or <$> traverse parseJSON args+          "and" -> do+            And <$> traverse parseJSON args+          "isDefaultBranch" -> do+            IsDefaultBranch <$ noParams tag args+          "isTag" -> do+            IsTag <$ noParams tag args+          "isBranch" -> do+            IsBranch <$> traverse parseJSON args+          "isRepo" -> do+            IsRepo <$> traverse parseJSON args+          "isOwner" -> do+            IsOwner <$> traverse parseJSON args+          t -> do+            fail $ "Unknown tag " <> show t <> " in Condition."+    where+      noParams _ [] = pure ()+      noParams tag _ = fail $ "Condition with tag " <> show tag <> " does not take any parameters."++instance ToJSON Condition where+  toJSON (Or a) = toJSON (String "or" : map toJSON a)+  toJSON (And a) = toJSON (String "and" : map toJSON a)+  toJSON IsDefaultBranch = String "isDefaultBranch"+  toJSON IsTag = String "isTag"+  toJSON (IsBranch a) = toJSON (String "isBranch" : map toJSON a)+  toJSON (IsRepo a) = toJSON (String "isRepo" : map toJSON a)+  toJSON (IsOwner a) = toJSON (String "isOwner" : map toJSON a)+-}+ -- | Arbitrary secret like keys, tokens, passwords etc. data Secret = Secret-  { data_ :: Map Text Value+  { data_ :: Map Text Value,+    condition :: Maybe Condition   }  instance ToJSON Secret where   toJSON a =     object-      ["kind" .= String "Secret", "data" .= data_ a]+      (["kind" .= String "Secret", "data" .= data_ a] ++ ["condition" .= x | x <- toList (condition a)])    toEncoding a =     pairs-      ("kind" .= String "Secret" <> "data" .= data_ a)+      ("kind" .= String "Secret" <> "data" .= data_ a <> foldMap ("condition" .=) (condition a))  instance FromJSON Secret where   parseJSON =@@ -31,4 +128,5 @@         [ noVersion $ \o ->             Secret               <$> o .: "data"+              <*> o .:? "condition"         ]

@@ -26,7 +26,7 @@         eitherDecode jsonV2 `shouldBe` Right objectV2     describe "ToJSON" $ do       it "encodes v2 correctly" $ do-        json (encode objectV2) `shouldBe` json (jsonV2)+        json (encode objectV2) `shouldBe` json jsonV2  json :: BL.ByteString -> Value json lbs =

@@ -30,14 +30,24 @@ spec :: Spec spec = describe "Secret" $ do   Aeson.checkLaws genSecret-  it "Decodes example" $+  it "Decodes example 1" $     eitherDecode       "{\"kind\":\"Secret\",\"data\":{\"key\": \"s3cr3t\"}}"       `shouldBe` Right         ( Secret-            { data_ = M.singleton "key" "s3cr3t"+            { data_ = M.singleton "key" "s3cr3t",+              condition = Nothing             }         )+  it "Decodes example 2" $ do+    eitherDecode+      "{\"kind\":\"Secret\",\"data\":{\"key\": \"s3cr3t\"},\"condition\":{\"or\": [\"isDefaultBranch\", {\"isBranch\": \"master\"}, {\"isBranch\": \"production\"}]}}"+      `shouldBe` Right+        ( Secret+            { data_ = M.singleton "key" "s3cr3t",+              condition = Just $ Or [IsDefaultBranch, IsBranch "master", IsBranch "production"]+            }+        )   it "Does not decode unknown versions" $     let r :: Either [Char] Secret         r =@@ -52,7 +62,21 @@ genSecret =   resize     6-    (Secret <$> liftArbitraryMap text (resize 100 genValue))+    ( Secret <$> liftArbitraryMap text (resize 100 genValue)+        <*> frequency [(1, pure Nothing), (19, Just <$> genCondition)]+    )++genCondition :: Gen Condition+genCondition =+  frequency+    [ (1, Or <$> resize 3 (listOf genCondition)),+      (1, And <$> resize 3 (listOf genCondition)),+      (1, pure IsDefaultBranch),+      (1, pure IsTag),+      (1, IsBranch <$> text),+      (1, IsRepo <$> text),+      (1, IsOwner <$> text)+    ]  text :: Gen Text text = TE.decodeUtf8 . TE.encodeUtf8 . T.pack <$> resize 4 arbitrary

@@ -1,3 +1,5 @@+{-# LANGUAGE BlockArguments #-}+ module Spec where  import qualified Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec@@ -5,15 +7,14 @@ import qualified Hercules.Formats.CachixCacheSpec import qualified Hercules.Formats.SecretSpec import Test.Hspec-import Prelude  spec :: Spec-spec = describe "hercules-ci-api" $ do-  describe "Hercules.API.Agent.LifeCycle.AgentInfo" $+spec = describe "hercules-ci-api" do+  describe "Hercules.API.Agent.LifeCycle.AgentInfo" do     Hercules.API.Agent.LifeCycle.AgentInfoSpec.spec-  describe "Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo" $+  describe "Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfo" do     Hercules.API.Agent.Evaluate.EvaluateEvent.DerivationInfoSpec.spec-  describe "Hercules.Formats.CachixCache" $+  describe "Hercules.Formats.CachixCache" do     Hercules.Formats.CachixCacheSpec.spec-  describe "Hercules.Formats.Secret" $+  describe "Hercules.Formats.Secret" do     Hercules.Formats.SecretSpec.spec