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
  deriving (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
$cto :: forall x. Rep Condition x -> Condition
$cfrom :: forall x. Condition -> Rep Condition x
Generic, Condition -> Condition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq, ReadPrec [Condition]
ReadPrec Condition
Int -> ReadS Condition
ReadS [Condition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Condition]
$creadListPrec :: ReadPrec [Condition]
readPrec :: ReadPrec Condition
$creadPrec :: ReadPrec Condition
readList :: ReadS [Condition]
$creadList :: ReadS [Condition]
readsPrec :: Int -> ReadS Condition
$creadsPrec :: Int -> ReadS Condition
Read, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show)

instance ToJSON Condition where
  toJSON :: Condition -> Value
toJSON (Or [Condition]
a) = [Pair] -> Value
object [Key
"or" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Condition]
a]
  toJSON (And [Condition]
a) = [Pair] -> Value
object [Key
"and" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
a]
  toJSON (IsRepo Text
a) = [Pair] -> Value
object [Key
"isRepo" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
a]
  toJSON (IsOwner Text
a) = [Pair] -> Value
object [Key
"isOwner" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
a]

instance FromJSON Condition where
  parseJSON :: Value -> Parser Condition
parseJSON (String Text
"isTag") = forall (f :: * -> *) a. Applicative f => a -> f a
pure Condition
IsTag
  parseJSON (String Text
"isDefaultBranch") = forall (f :: * -> *) a. Applicative f => a -> f a
pure Condition
IsDefaultBranch
  parseJSON (Object Object
o) =
    case forall v. KeyMap v -> [(Key, v)]
AM.toList Object
o of
      [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The empty object does not represent a Condition."
      [(Key
k, Value
v)] -> case 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 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"The field name in a Condition object must be one of " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (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]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"A Condition object must contain a single field."
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected Object or String."

taggedConditionParsers :: HM.HashMap Text (Value -> A.Parser Condition)
taggedConditionParsers :: HashMap Text (Value -> Parser Condition)
taggedConditionParsers =
  forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
    [ ( Text
"or",
        \Value
v -> do
          [Value]
params <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          [Condition] -> Condition
Or forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
params
      ),
      ( Text
"and",
        \Value
v -> do
          [Value]
params <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          [Condition] -> Condition
And forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Parser a
parseJSON [Value]
params
      ),
      (Text
"isBranch", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Condition
IsBranch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON),
      (Text
"isRepo", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Condition
IsRepo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON),
      (Text
"isOwner", forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Condition
IsOwner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
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
  { 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Secret", Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Secret -> Map Text Value
data_ Secret
a] forall a. [a] -> [a] -> [a]
++ [Key
"condition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Condition
x | Condition
x <- 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Secret" forall a. Semigroup a => a -> a -> a
<> Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Secret -> Map Text Value
data_ Secret
a forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Key
"condition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Secret -> Maybe Condition
condition Secret
a))

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