{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Agent.Evaluate.EvaluateEvent.AttributeEffectEvent where

import Hercules.API.Prelude

data AttributeEffectEvent = AttributeEffectEvent
  { AttributeEffectEvent -> [Text]
expressionPath :: [Text],
    AttributeEffectEvent -> Text
derivationPath :: Text,
    AttributeEffectEvent -> Map Text SecretRef
secretsToUse :: Map Text SecretRef
  }
  deriving ((forall x. AttributeEffectEvent -> Rep AttributeEffectEvent x)
-> (forall x. Rep AttributeEffectEvent x -> AttributeEffectEvent)
-> Generic AttributeEffectEvent
forall x. Rep AttributeEffectEvent x -> AttributeEffectEvent
forall x. AttributeEffectEvent -> Rep AttributeEffectEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeEffectEvent x -> AttributeEffectEvent
$cfrom :: forall x. AttributeEffectEvent -> Rep AttributeEffectEvent x
Generic, Int -> AttributeEffectEvent -> ShowS
[AttributeEffectEvent] -> ShowS
AttributeEffectEvent -> String
(Int -> AttributeEffectEvent -> ShowS)
-> (AttributeEffectEvent -> String)
-> ([AttributeEffectEvent] -> ShowS)
-> Show AttributeEffectEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeEffectEvent] -> ShowS
$cshowList :: [AttributeEffectEvent] -> ShowS
show :: AttributeEffectEvent -> String
$cshow :: AttributeEffectEvent -> String
showsPrec :: Int -> AttributeEffectEvent -> ShowS
$cshowsPrec :: Int -> AttributeEffectEvent -> ShowS
Show, AttributeEffectEvent -> AttributeEffectEvent -> Bool
(AttributeEffectEvent -> AttributeEffectEvent -> Bool)
-> (AttributeEffectEvent -> AttributeEffectEvent -> Bool)
-> Eq AttributeEffectEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeEffectEvent -> AttributeEffectEvent -> Bool
$c/= :: AttributeEffectEvent -> AttributeEffectEvent -> Bool
== :: AttributeEffectEvent -> AttributeEffectEvent -> Bool
$c== :: AttributeEffectEvent -> AttributeEffectEvent -> Bool
Eq, AttributeEffectEvent -> ()
(AttributeEffectEvent -> ()) -> NFData AttributeEffectEvent
forall a. (a -> ()) -> NFData a
rnf :: AttributeEffectEvent -> ()
$crnf :: AttributeEffectEvent -> ()
NFData, [AttributeEffectEvent] -> Encoding
[AttributeEffectEvent] -> Value
AttributeEffectEvent -> Encoding
AttributeEffectEvent -> Value
(AttributeEffectEvent -> Value)
-> (AttributeEffectEvent -> Encoding)
-> ([AttributeEffectEvent] -> Value)
-> ([AttributeEffectEvent] -> Encoding)
-> ToJSON AttributeEffectEvent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AttributeEffectEvent] -> Encoding
$ctoEncodingList :: [AttributeEffectEvent] -> Encoding
toJSONList :: [AttributeEffectEvent] -> Value
$ctoJSONList :: [AttributeEffectEvent] -> Value
toEncoding :: AttributeEffectEvent -> Encoding
$ctoEncoding :: AttributeEffectEvent -> Encoding
toJSON :: AttributeEffectEvent -> Value
$ctoJSON :: AttributeEffectEvent -> Value
ToJSON, Value -> Parser [AttributeEffectEvent]
Value -> Parser AttributeEffectEvent
(Value -> Parser AttributeEffectEvent)
-> (Value -> Parser [AttributeEffectEvent])
-> FromJSON AttributeEffectEvent
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AttributeEffectEvent]
$cparseJSONList :: Value -> Parser [AttributeEffectEvent]
parseJSON :: Value -> Parser AttributeEffectEvent
$cparseJSON :: Value -> Parser AttributeEffectEvent
FromJSON)

-- | The right hand side of the @secretsToUse@; how to get the secret.
data SecretRef
  = -- | Retrieve a secret from @secrets.json@.
    SimpleSecret SimpleSecret
  | -- | Retrieve a token for the current repository.
    GitToken GitToken
  deriving ((forall x. SecretRef -> Rep SecretRef x)
-> (forall x. Rep SecretRef x -> SecretRef) -> Generic SecretRef
forall x. Rep SecretRef x -> SecretRef
forall x. SecretRef -> Rep SecretRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SecretRef x -> SecretRef
$cfrom :: forall x. SecretRef -> Rep SecretRef x
Generic, Int -> SecretRef -> ShowS
[SecretRef] -> ShowS
SecretRef -> String
(Int -> SecretRef -> ShowS)
-> (SecretRef -> String)
-> ([SecretRef] -> ShowS)
-> Show SecretRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretRef] -> ShowS
$cshowList :: [SecretRef] -> ShowS
show :: SecretRef -> String
$cshow :: SecretRef -> String
showsPrec :: Int -> SecretRef -> ShowS
$cshowsPrec :: Int -> SecretRef -> ShowS
Show, SecretRef -> SecretRef -> Bool
(SecretRef -> SecretRef -> Bool)
-> (SecretRef -> SecretRef -> Bool) -> Eq SecretRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretRef -> SecretRef -> Bool
$c/= :: SecretRef -> SecretRef -> Bool
== :: SecretRef -> SecretRef -> Bool
$c== :: SecretRef -> SecretRef -> Bool
Eq, SecretRef -> ()
(SecretRef -> ()) -> NFData SecretRef
forall a. (a -> ()) -> NFData a
rnf :: SecretRef -> ()
$crnf :: SecretRef -> ()
NFData, [SecretRef] -> Encoding
[SecretRef] -> Value
SecretRef -> Encoding
SecretRef -> Value
(SecretRef -> Value)
-> (SecretRef -> Encoding)
-> ([SecretRef] -> Value)
-> ([SecretRef] -> Encoding)
-> ToJSON SecretRef
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SecretRef] -> Encoding
$ctoEncodingList :: [SecretRef] -> Encoding
toJSONList :: [SecretRef] -> Value
$ctoJSONList :: [SecretRef] -> Value
toEncoding :: SecretRef -> Encoding
$ctoEncoding :: SecretRef -> Encoding
toJSON :: SecretRef -> Value
$ctoJSON :: SecretRef -> Value
ToJSON, Value -> Parser [SecretRef]
Value -> Parser SecretRef
(Value -> Parser SecretRef)
-> (Value -> Parser [SecretRef]) -> FromJSON SecretRef
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SecretRef]
$cparseJSONList :: Value -> Parser [SecretRef]
parseJSON :: Value -> Parser SecretRef
$cparseJSON :: Value -> Parser SecretRef
FromJSON)

data SimpleSecret = MkSimpleSecret {SimpleSecret -> Text
name :: Text}
  deriving ((forall x. SimpleSecret -> Rep SimpleSecret x)
-> (forall x. Rep SimpleSecret x -> SimpleSecret)
-> Generic SimpleSecret
forall x. Rep SimpleSecret x -> SimpleSecret
forall x. SimpleSecret -> Rep SimpleSecret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleSecret x -> SimpleSecret
$cfrom :: forall x. SimpleSecret -> Rep SimpleSecret x
Generic, Int -> SimpleSecret -> ShowS
[SimpleSecret] -> ShowS
SimpleSecret -> String
(Int -> SimpleSecret -> ShowS)
-> (SimpleSecret -> String)
-> ([SimpleSecret] -> ShowS)
-> Show SimpleSecret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleSecret] -> ShowS
$cshowList :: [SimpleSecret] -> ShowS
show :: SimpleSecret -> String
$cshow :: SimpleSecret -> String
showsPrec :: Int -> SimpleSecret -> ShowS
$cshowsPrec :: Int -> SimpleSecret -> ShowS
Show, SimpleSecret -> SimpleSecret -> Bool
(SimpleSecret -> SimpleSecret -> Bool)
-> (SimpleSecret -> SimpleSecret -> Bool) -> Eq SimpleSecret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleSecret -> SimpleSecret -> Bool
$c/= :: SimpleSecret -> SimpleSecret -> Bool
== :: SimpleSecret -> SimpleSecret -> Bool
$c== :: SimpleSecret -> SimpleSecret -> Bool
Eq, SimpleSecret -> ()
(SimpleSecret -> ()) -> NFData SimpleSecret
forall a. (a -> ()) -> NFData a
rnf :: SimpleSecret -> ()
$crnf :: SimpleSecret -> ()
NFData, [SimpleSecret] -> Encoding
[SimpleSecret] -> Value
SimpleSecret -> Encoding
SimpleSecret -> Value
(SimpleSecret -> Value)
-> (SimpleSecret -> Encoding)
-> ([SimpleSecret] -> Value)
-> ([SimpleSecret] -> Encoding)
-> ToJSON SimpleSecret
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SimpleSecret] -> Encoding
$ctoEncodingList :: [SimpleSecret] -> Encoding
toJSONList :: [SimpleSecret] -> Value
$ctoJSONList :: [SimpleSecret] -> Value
toEncoding :: SimpleSecret -> Encoding
$ctoEncoding :: SimpleSecret -> Encoding
toJSON :: SimpleSecret -> Value
$ctoJSON :: SimpleSecret -> Value
ToJSON, Value -> Parser [SimpleSecret]
Value -> Parser SimpleSecret
(Value -> Parser SimpleSecret)
-> (Value -> Parser [SimpleSecret]) -> FromJSON SimpleSecret
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SimpleSecret]
$cparseJSONList :: Value -> Parser [SimpleSecret]
parseJSON :: Value -> Parser SimpleSecret
$cparseJSON :: Value -> Parser SimpleSecret
FromJSON)

data GitToken = MkGitToken {}
  deriving ((forall x. GitToken -> Rep GitToken x)
-> (forall x. Rep GitToken x -> GitToken) -> Generic GitToken
forall x. Rep GitToken x -> GitToken
forall x. GitToken -> Rep GitToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GitToken x -> GitToken
$cfrom :: forall x. GitToken -> Rep GitToken x
Generic, Int -> GitToken -> ShowS
[GitToken] -> ShowS
GitToken -> String
(Int -> GitToken -> ShowS)
-> (GitToken -> String) -> ([GitToken] -> ShowS) -> Show GitToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitToken] -> ShowS
$cshowList :: [GitToken] -> ShowS
show :: GitToken -> String
$cshow :: GitToken -> String
showsPrec :: Int -> GitToken -> ShowS
$cshowsPrec :: Int -> GitToken -> ShowS
Show, GitToken -> GitToken -> Bool
(GitToken -> GitToken -> Bool)
-> (GitToken -> GitToken -> Bool) -> Eq GitToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitToken -> GitToken -> Bool
$c/= :: GitToken -> GitToken -> Bool
== :: GitToken -> GitToken -> Bool
$c== :: GitToken -> GitToken -> Bool
Eq, GitToken -> ()
(GitToken -> ()) -> NFData GitToken
forall a. (a -> ()) -> NFData a
rnf :: GitToken -> ()
$crnf :: GitToken -> ()
NFData, [GitToken] -> Encoding
[GitToken] -> Value
GitToken -> Encoding
GitToken -> Value
(GitToken -> Value)
-> (GitToken -> Encoding)
-> ([GitToken] -> Value)
-> ([GitToken] -> Encoding)
-> ToJSON GitToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GitToken] -> Encoding
$ctoEncodingList :: [GitToken] -> Encoding
toJSONList :: [GitToken] -> Value
$ctoJSONList :: [GitToken] -> Value
toEncoding :: GitToken -> Encoding
$ctoEncoding :: GitToken -> Encoding
toJSON :: GitToken -> Value
$ctoJSON :: GitToken -> Value
ToJSON, Value -> Parser [GitToken]
Value -> Parser GitToken
(Value -> Parser GitToken)
-> (Value -> Parser [GitToken]) -> FromJSON GitToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GitToken]
$cparseJSONList :: Value -> Parser [GitToken]
parseJSON :: Value -> Parser GitToken
$cparseJSON :: Value -> Parser GitToken
FromJSON)