{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}

module Hercules.Agent.WorkerProtocol.Command.Effect where

import qualified Data.Aeson as A
import Data.Binary
import Hercules.API.Id (Id)
import Hercules.Agent.Sensitive
import Hercules.Agent.WorkerProtocol.LogSettings
import Hercules.Agent.WorkerProtocol.Orphans ()
import Hercules.Agent.WorkerProtocol.ViaJSON (ViaJSON)
import Hercules.Secrets (SecretContext)
import Protolude

data Effect = Effect
  { Effect -> Text
drvPath :: Text,
    Effect -> Text
apiBaseURL :: Text,
    Effect -> LogSettings
logSettings :: LogSettings,
    Effect -> [ByteString]
inputDerivationOutputPaths :: [ByteString],
    Effect -> Bool
materializeDerivation :: Bool,
    Effect -> FilePath
secretsPath :: FilePath,
    Effect -> Sensitive (ViaJSON (Map Text (Map Text Value)))
serverSecrets :: Sensitive (ViaJSON (Map Text (Map Text A.Value))),
    Effect -> Sensitive Text
token :: Sensitive Text,
    Effect -> Id "project"
projectId :: Id "project",
    Effect -> Text
projectPath :: Text,
    Effect -> SecretContext
secretContext :: SecretContext
  }
  deriving (forall x. Rep Effect x -> Effect
forall x. Effect -> Rep Effect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Effect x -> Effect
$cfrom :: forall x. Effect -> Rep Effect x
Generic, Get Effect
[Effect] -> Put
Effect -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Effect] -> Put
$cputList :: [Effect] -> Put
get :: Get Effect
$cget :: Get Effect
put :: Effect -> Put
$cput :: Effect -> Put
Binary, Int -> Effect -> ShowS
[Effect] -> ShowS
Effect -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Effect] -> ShowS
$cshowList :: [Effect] -> ShowS
show :: Effect -> FilePath
$cshow :: Effect -> FilePath
showsPrec :: Int -> Effect -> ShowS
$cshowsPrec :: Int -> Effect -> ShowS
Show, Effect -> Effect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Effect -> Effect -> Bool
$c/= :: Effect -> Effect -> Bool
== :: Effect -> Effect -> Bool
$c== :: Effect -> Effect -> Bool
Eq)