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

module Hercules.Agent.WorkerProtocol.Command.Effect where

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

data Effect = Effect
  { Effect -> Text
drvPath :: Text,
    Effect -> Text
apiBaseURL :: Text,
    Effect -> [ByteString]
inputDerivationOutputPaths :: [ByteString],
    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,
    Effect -> Sensitive (ViaJSON (Map Text Mountable))
configuredMountables :: Sensitive (ViaJSON (Map Text (Mountable)))
  }
  deriving ((forall x. Effect -> Rep Effect x)
-> (forall x. Rep Effect x -> Effect) -> Generic Effect
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
$cfrom :: forall x. Effect -> Rep Effect x
from :: forall x. Effect -> Rep Effect x
$cto :: forall x. Rep Effect x -> Effect
to :: forall x. Rep Effect x -> Effect
Generic, Get Effect
[Effect] -> Put
Effect -> Put
(Effect -> Put) -> Get Effect -> ([Effect] -> Put) -> Binary Effect
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Effect -> Put
put :: Effect -> Put
$cget :: Get Effect
get :: Get Effect
$cputList :: [Effect] -> Put
putList :: [Effect] -> Put
Binary, Int -> Effect -> ShowS
[Effect] -> ShowS
Effect -> FilePath
(Int -> Effect -> ShowS)
-> (Effect -> FilePath) -> ([Effect] -> ShowS) -> Show Effect
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Effect -> ShowS
showsPrec :: Int -> Effect -> ShowS
$cshow :: Effect -> FilePath
show :: Effect -> FilePath
$cshowList :: [Effect] -> ShowS
showList :: [Effect] -> ShowS
Show, Effect -> Effect -> Bool
(Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool) -> Eq Effect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Effect -> Effect -> Bool
== :: Effect -> Effect -> Bool
$c/= :: Effect -> Effect -> Bool
/= :: Effect -> Effect -> Bool
Eq)