module Hercules.Formats.Secret where

import Data.Aeson
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,
  )

data Condition
  = Or [Condition]
  | And [Condition]
  | IsDefaultBranch
  | IsBranch Text
  | IsTag
  | IsRepo Text
  | IsOwner Text
  | Const Bool
  deriving ((forall x. Condition -> Rep Condition x)
-> (forall x. Rep Condition x -> Condition) -> Generic Condition
forall x. Rep Condition x -> Condition
forall x. Condition -> Rep Condition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Condition -> Rep Condition x
from :: forall x. Condition -> Rep Condition x
$cto :: forall x. Rep Condition x -> Condition
to :: forall x. Rep Condition x -> Condition
Generic, Condition -> Condition -> Bool
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
/= :: Condition -> Condition -> Bool
Eq, ReadPrec [Condition]
ReadPrec Condition
Int -> ReadS Condition
ReadS [Condition]
(Int -> ReadS Condition)
-> ReadS [Condition]
-> ReadPrec Condition
-> ReadPrec [Condition]
-> Read Condition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Condition
readsPrec :: Int -> ReadS Condition
$creadList :: ReadS [Condition]
readList :: ReadS [Condition]
$creadPrec :: ReadPrec Condition
readPrec :: ReadPrec Condition
$creadListPrec :: ReadPrec [Condition]
readListPrec :: ReadPrec [Condition]
Read, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Condition -> ShowS
showsPrec :: Int -> Condition -> ShowS
$cshow :: Condition -> String
show :: Condition -> String
$cshowList :: [Condition] -> ShowS
showList :: [Condition] -> ShowS
Show)

instance ToJSON Condition where
  toJSON :: Condition -> Value
toJSON (Or [Condition]
a) = [Pair] -> Value
object [Key
"or" Key -> [Condition] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Condition]
a]
  toJSON (And [Condition]
a) = [Pair] -> Value
object [Key
"and" Key -> [Condition] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Condition]
a]
  toJSON Condition
IsDefaultBranch = Text -> Value
String Text
"isDefaultBranch"
  toJSON Condition
IsTag = Text -> Value
String Text
"isTag"
  toJSON (IsBranch Text
a) = [Pair] -> Value
object [Key
"isBranch" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
a]
  toJSON (IsRepo Text
a) = [Pair] -> Value
object [Key
"isRepo" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
a]
  toJSON (IsOwner Text
a) = [Pair] -> Value
object [Key
"isOwner" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
a]
  toJSON (Const Bool
b) = Bool -> Value
Bool Bool
b

instance FromJSON Condition where
  parseJSON :: Value -> Parser Condition
parseJSON (String Text
"isTag") = Condition -> Parser Condition
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Condition
IsTag
  parseJSON (String Text
"isDefaultBranch") = Condition -> Parser Condition
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Condition
IsDefaultBranch
  parseJSON (Object Object
o) =
    case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
AM.toList Object
o of
      [] -> String -> Parser Condition
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The empty object does not represent a Condition."
      [(Key
k, Value
v)] -> case Text
-> HashMap Text (Value -> Parser Condition)
-> Maybe (Value -> Parser Condition)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Key -> Text
AK.toText Key
k) HashMap Text (Value -> Parser Condition)
taggedConditionParsers of
        Maybe (Value -> Parser Condition)
Nothing -> String -> Parser Condition
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Condition) -> String -> Parser Condition
forall a b. (a -> b) -> a -> b
$ String
"The field name in a Condition object must be one of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show (((Text, Value -> Parser Condition) -> Text)
-> [(Text, Value -> Parser Condition)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value -> Parser Condition) -> Text
forall a b. (a, b) -> a
fst (HashMap Text (Value -> Parser Condition)
-> [(Text, Value -> Parser Condition)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text (Value -> Parser Condition)
taggedConditionParsers))
        Just Value -> Parser Condition
p -> Value -> Parser Condition
p Value
v
      [Pair]
_ -> String -> Parser Condition
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"A Condition object must contain a single field."
  parseJSON (Bool Bool
b) = Condition -> Parser Condition
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Condition
Const Bool
b)
  parseJSON Value
_ = String -> Parser Condition
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected Object, String or true."

taggedConditionParsers :: HM.HashMap Text (Value -> A.Parser Condition)
taggedConditionParsers :: HashMap Text (Value -> Parser Condition)
taggedConditionParsers =
  [(Text, Value -> Parser Condition)]
-> HashMap Text (Value -> Parser Condition)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
    [ ( Text
"or",
        \Value
v -> do
          [Value]
params <- Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          [Condition] -> Condition
Or ([Condition] -> Condition)
-> Parser [Condition] -> Parser Condition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Condition) -> [Value] -> Parser [Condition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> Parser Condition
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
params
      ),
      ( Text
"and",
        \Value
v -> do
          [Value]
params <- Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          [Condition] -> Condition
And ([Condition] -> Condition)
-> Parser [Condition] -> Parser Condition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Condition) -> [Value] -> Parser [Condition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> Parser Condition
forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
params
      ),
      (Text
"isBranch", (Text -> Condition) -> Parser Text -> Parser Condition
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Condition
IsBranch (Parser Text -> Parser Condition)
-> (Value -> Parser Text) -> Value -> Parser Condition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON),
      (Text
"isRepo", (Text -> Condition) -> Parser Text -> Parser Condition
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Condition
IsRepo (Parser Text -> Parser Condition)
-> (Value -> Parser Text) -> Value -> Parser Condition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON),
      (Text
"isOwner", (Text -> Condition) -> Parser Text -> Parser Condition
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Condition
IsOwner (Parser Text -> Parser Condition)
-> (Value -> Parser Text) -> Value -> Parser Condition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON)
    ]

-- | Arbitrary secret like keys, tokens, passwords etc.
data Secret = Secret
  { Secret -> Map Text Value
data_ :: Map Text Value,
    Secret -> Maybe Condition
condition :: Maybe Condition
  }

instance ToJSON Secret where
  toJSON :: Secret -> Value
toJSON Secret
a =
    [Pair] -> Value
object
      ([Key
"kind" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"Secret", Key
"data" Key -> Map Text Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Secret -> Map Text Value
data_ Secret
a] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"condition" Key -> Condition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Condition
x | Condition
x <- Maybe Condition -> [Condition]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Secret -> Maybe Condition
condition Secret
a)])

  toEncoding :: Secret -> Encoding
toEncoding Secret
a =
    Series -> Encoding
pairs
      (Key
"kind" Key -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= Text -> Value
String Text
"Secret" Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"data" Key -> Map Text Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= Secret -> Map Text Value
data_ Secret
a Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (Condition -> Series) -> Maybe Condition -> Series
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Key
"condition" Key -> Condition -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.=) (Secret -> Maybe Condition
condition Secret
a))

instance FromJSON Secret where
  parseJSON :: Value -> Parser Secret
parseJSON =
    Text -> (Object -> Parser Secret) -> Value -> Parser Secret
forall a. Text -> (Object -> Parser a) -> Value -> Parser a
withKind Text
"Secret"
      ((Object -> Parser Secret) -> Value -> Parser Secret)
-> (Object -> Parser Secret) -> Value -> Parser Secret
forall a b. (a -> b) -> a -> b
$ [VersionParser Secret] -> Object -> Parser Secret
forall a. [VersionParser a] -> Object -> Parser a
withVersions
        [ (Object -> Parser Secret) -> VersionParser Secret
forall a. (Object -> Parser a) -> VersionParser a
noVersion ((Object -> Parser Secret) -> VersionParser Secret)
-> (Object -> Parser Secret) -> VersionParser Secret
forall a b. (a -> b) -> a -> b
$ \Object
o ->
            Map Text Value -> Maybe Condition -> Secret
Secret
              (Map Text Value -> Maybe Condition -> Secret)
-> Parser (Map Text Value) -> Parser (Maybe Condition -> Secret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
              Object -> Key -> Parser (Map Text Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
              Parser (Maybe Condition -> Secret)
-> Parser (Maybe Condition) -> Parser Secret
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
              Object -> Key -> Parser (Maybe Condition)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"condition"
        ]