{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}

module Hercules.CLI.JSON where

import Data.Aeson
import Data.Aeson.Encode.Pretty (Indent (Spaces), confIndent, confTrailingNewline, defConfig, encodePretty')
import qualified Data.Aeson.Encode.Pretty
import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.KeyMap as AK
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NEL
import qualified Data.Text as T
import Hercules.UserException (UserException (UserException))
import qualified Options.Applicative as Optparse
import Protolude
import System.AtomicWrite.Writer.ByteString (atomicWriteFile)
import System.Environment (getEnvironment, lookupEnv)
import System.IO (hGetEcho, hSetEcho)

mergePaths :: [([Text], Value)] -> Either Text Value
mergePaths :: [([Text], Value)] -> Either Text Value
mergePaths = [Text] -> [([Text], Value)] -> Either Text Value
mergeLeafPaths [] ([([Text], Value)] -> Either Text Value)
-> ([([Text], Value)] -> [([Text], Value)])
-> [([Text], Value)]
-> Either Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Text], Value)] -> [([Text], Value)]
toLeafPaths

mergeLeafPaths :: [Text] -> [([Text], Value)] -> Either Text Value
mergeLeafPaths :: [Text] -> [([Text], Value)] -> Either Text Value
mergeLeafPaths [Text]
_ [([], Value
v)] = Value -> Either Text Value
forall a b. b -> Either a b
Right Value
v
mergeLeafPaths [Text]
context [([Text], Value)]
items =
  case [([Text], Value)]
-> (([Text], Value) -> Maybe (NonEmpty Text, Value))
-> Maybe [(NonEmpty Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [([Text], Value)]
items (\([Text]
k, Value
v) -> (,Value
v) (NonEmpty Text -> (NonEmpty Text, Value))
-> Maybe (NonEmpty Text) -> Maybe (NonEmpty Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [Text]
k) of
    Maybe [(NonEmpty Text, Value)]
Nothing -> Text -> Either Text Value
forall a b. a -> Either a b
Left (Text -> Either Text Value) -> Text -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Text
"Conflicting values for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
showPath [Text]
context
    Just [(NonEmpty Text, Value)]
nonRootItems ->
      [(NonEmpty Text, Value)]
nonRootItems
        [(NonEmpty Text, Value)]
-> ([(NonEmpty Text, Value)] -> [NonEmpty (NonEmpty Text, Value)])
-> [NonEmpty (NonEmpty Text, Value)]
forall a b. a -> (a -> b) -> b
& ((NonEmpty Text, Value) -> Text)
-> [(NonEmpty Text, Value)] -> [NonEmpty (NonEmpty Text, Value)]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NEL.groupAllWith (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NEL.head (NonEmpty Text -> Text)
-> ((NonEmpty Text, Value) -> NonEmpty Text)
-> (NonEmpty Text, Value)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Text, Value) -> NonEmpty Text
forall a b. (a, b) -> a
fst)
        [NonEmpty (NonEmpty Text, Value)]
-> ([NonEmpty (NonEmpty Text, Value)] -> Either Text [Pair])
-> Either Text [Pair]
forall a b. a -> (a -> b) -> b
& (NonEmpty (NonEmpty Text, Value) -> Either Text Pair)
-> [NonEmpty (NonEmpty Text, Value)] -> Either Text [Pair]
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
          ( \(groupItem :: (NonEmpty Text, Value)
groupItem@(Text
child :| [Text]
_, Value
_) :| [(NonEmpty Text, Value)]
groupItems) ->
              (Text -> Key
AK.fromText Text
child Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=)
                (Value -> Pair) -> Either Text Value -> Either Text Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [([Text], Value)] -> Either Text Value
mergeLeafPaths ([Text]
context [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
child]) (((NonEmpty Text, Value) -> ([Text], Value))
-> [(NonEmpty Text, Value)] -> [([Text], Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((NonEmpty Text -> [Text])
-> (NonEmpty Text, Value) -> ([Text], Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NEL.tail) ((NonEmpty Text, Value)
groupItem (NonEmpty Text, Value)
-> [(NonEmpty Text, Value)] -> [(NonEmpty Text, Value)]
forall a. a -> [a] -> [a]
: [(NonEmpty Text, Value)]
groupItems))
          )
        Either Text [Pair] -> ([Pair] -> Value) -> Either Text Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Pair] -> Value
object

showPath :: [Text] -> Text
showPath :: [Text] -> Text
showPath [] = Text
"the root"
showPath [Text]
x = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
x

toLeafPaths :: [([Text], Value)] -> [([Text], Value)]
toLeafPaths :: [([Text], Value)] -> [([Text], Value)]
toLeafPaths = (([Text], Value) -> [([Text], Value)])
-> [([Text], Value)] -> [([Text], Value)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \([Text]
path, Value
item) ->
  case Value
item of
    Object Object
fields ->
      Object
fields Object -> (Object -> [Pair]) -> [Pair]
forall a b. a -> (a -> b) -> b
& Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
AK.toAscList [Pair] -> ([Pair] -> [(Text, Value)]) -> [(Text, Value)]
forall a b. a -> (a -> b) -> b
& (Pair -> (Text, Value)) -> [Pair] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key -> Text) -> Pair -> (Text, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
AK.toText) [(Text, Value)]
-> ([(Text, Value)] -> [([Text], Value)]) -> [([Text], Value)]
forall a b. a -> (a -> b) -> b
& ((Text, Value) -> [([Text], Value)])
-> [(Text, Value)] -> [([Text], Value)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \(Text
subpath, Value
subitem) ->
        [([Text], Value)] -> [([Text], Value)]
toLeafPaths [([Text]
path [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
subpath], Value
subitem)]
    Value
_ -> [([Text]
path, Value
item)]

options :: Optparse.Parser (Maybe Text -> IO Value)
options :: Parser (Maybe Text -> IO Value)
options = do
  [(Text, Text)]
strings <-
    Parser (Text, Text) -> Parser [(Text, Text)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( ReadM Text
-> ReadM Text
-> Mod OptionFields (Text, Text)
-> Parser (Text, Text)
forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ( String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"string"
              Mod OptionFields (Text, Text)
-> Mod OptionFields (Text, Text) -> Mod OptionFields (Text, Text)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a string at dot-separated PATH in the secret data"
              Mod OptionFields (Text, Text)
-> Mod OptionFields (Text, Text) -> Mod OptionFields (Text, Text)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              Mod OptionFields (Text, Text)
-> Mod OptionFields (Text, Text) -> Mod OptionFields (Text, Text)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"STRING"
          )
      )
  [Text]
stringPasswords <-
    Parser Text -> Parser [Text]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( ReadM Text -> Mod OptionFields Text -> Parser Text
forall a. ReadM a -> Mod OptionFields a -> Parser a
Optparse.option
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"password"
              Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a string at dot-separated PATH in the secret data using password input on stdin"
              Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
          )
      )
  [(Text, Text)]
jsons <-
    Parser (Text, Text) -> Parser [(Text, Text)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( ReadM Text
-> ReadM Text
-> Mod OptionFields (Text, Text)
-> Parser (Text, Text)
forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ( String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"json"
              Mod OptionFields (Text, Text)
-> Mod OptionFields (Text, Text) -> Mod OptionFields (Text, Text)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a JSON value at dot-separated PATH in the secret data"
              Mod OptionFields (Text, Text)
-> Mod OptionFields (Text, Text) -> Mod OptionFields (Text, Text)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              Mod OptionFields (Text, Text)
-> Mod OptionFields (Text, Text) -> Mod OptionFields (Text, Text)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, Text)
forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"JSON"
          )
      )
  [(Text, String)]
stringFiles <-
    Parser (Text, String) -> Parser [(Text, String)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( ReadM Text
-> ReadM String
-> Mod OptionFields (Text, String)
-> Parser (Text, String)
forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ReadM String
forall s. IsString s => ReadM s
Optparse.str
          ( String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"string-file"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a string at dot-separated PATH in the secret data, by reading FILE"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"FILE"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 (String -> Completer
Optparse.bashCompleter String
"file")
          )
      )
  [(Text, String)]
jsonFiles <-
    Parser (Text, String) -> Parser [(Text, String)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( ReadM Text
-> ReadM String
-> Mod OptionFields (Text, String)
-> Parser (Text, String)
forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ReadM String
forall s. IsString s => ReadM s
Optparse.str
          ( String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"json-file"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a JSON value at dot-separated PATH in the secret data, by reading FILE"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"FILE"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 (String -> Completer
Optparse.bashCompleter String
"file")
          )
      )
  [(Text, String)]
stringEnvs <-
    Parser (Text, String) -> Parser [(Text, String)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( ReadM Text
-> ReadM String
-> Mod OptionFields (Text, String)
-> Parser (Text, String)
forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ReadM String
forall s. IsString s => ReadM s
Optparse.str
          ( String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"string-env"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a string at dot-separated PATH in the secret data, by reading environment variable ENV_NAME"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"ENV_NAME"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 Completer
envCompleter
          )
      )
  [(Text, String)]
jsonEnvs <-
    Parser (Text, String) -> Parser [(Text, String)]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( ReadM Text
-> ReadM String
-> Mod OptionFields (Text, String)
-> Parser (Text, String)
forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          ReadM Text
forall s. IsString s => ReadM s
Optparse.str
          ReadM String
forall s. IsString s => ReadM s
Optparse.str
          ( String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"json-env"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a JSON value at dot-separated PATH in the secret data, by reading environment variable ENV_NAME"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"ENV_NAME"
              Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
-> Mod OptionFields (Text, String)
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields (Text, String)
forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 Completer
envCompleter
          )
      )
  pure \Maybe Text
maybeSecretName -> do
    [(Text, Text)]
fileStrings <- [(Text, String)]
-> ((Text, String) -> IO (Text, Text)) -> IO [(Text, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Text, String)]
stringFiles (Text, String) -> IO (Text, Text)
readFileWithKey
    [(Text, Value)]
fileJsons <- [(Text, String)]
-> ((Text, String) -> IO (Text, Value)) -> IO [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Text, String)]
jsonFiles (Text, String) -> IO (Text, Value)
forall b. FromJSON b => (Text, String) -> IO (Text, b)
readJsonFileWithKey
    [(Text, Text)]
envStrings <- [(Text, String)]
-> ((Text, String) -> IO (Text, Text)) -> IO [(Text, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Text, String)]
stringEnvs (Text, String) -> IO (Text, Text)
readEnvWithKey
    [(Text, Value)]
envJsons <- [(Text, String)]
-> ((Text, String) -> IO (Text, Value)) -> IO [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Text, String)]
jsonEnvs (Text, String) -> IO (Text, Value)
readJsonEnvWithKey
    [(Text, Value)]
validJsons <-
      [(Text, Text)]
-> ((Text, Text) -> IO (Text, Value)) -> IO [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
        [(Text, Text)]
jsons
        ( \(Text
key, Text
value) ->
            case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Value)
-> ByteString -> Either String Value
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
value of
              Left String
e -> UserException -> IO (Text, Value)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO (Text, Value))
-> UserException -> IO (Text, Value)
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"Value for key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not valid JSON: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
e
              Right Value
r -> (Text, Value) -> IO (Text, Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Value
r :: Value)
        )
    [(Text, Text)]
passwordStrings <- [Text] -> (Text -> IO (Text, Text)) -> IO [(Text, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Text]
stringPasswords (Maybe Text -> Text -> IO (Text, Text)
askPasswordWithKey Maybe Text
maybeSecretName)
    let items :: [([Text], Value)]
items =
          ((Text, Value) -> ([Text], Value))
-> [(Text, Value)] -> [([Text], Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Text -> [Text]) -> (Text, Value) -> ([Text], Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> [Text]
split) ([(Text, Value)] -> [([Text], Value)])
-> [(Text, Value)] -> [([Text], Value)]
forall a b. (a -> b) -> a -> b
$
            ((Text -> Value) -> (Text, Text) -> (Text, Value)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String ((Text, Text) -> (Text, Value))
-> [(Text, Text)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
strings)
              [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> ((Text -> Value) -> (Text, Text) -> (Text, Value)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String ((Text, Text) -> (Text, Value))
-> [(Text, Text)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
envStrings)
              [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> ((Text -> Value) -> (Text, Text) -> (Text, Value)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String ((Text, Text) -> (Text, Value))
-> [(Text, Text)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
fileStrings)
              [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> ((Text -> Value) -> (Text, Text) -> (Text, Value)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String ((Text, Text) -> (Text, Value))
-> [(Text, Text)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
passwordStrings)
              [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
validJsons
              [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
envJsons
              [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
fileJsons

        split :: Text -> [Text]
split Text
"." = []
        split Text
"" = []
        split Text
p = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
p
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([([Text], Value)]
items [([Text], Value)] -> ([([Text], Value)] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& (([Text], Value) -> Bool) -> [([Text], Value)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any \([Text]
path, Value
_) -> [Text]
path [Text] -> ([Text] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"'))) do
      FatalError -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FatalError -> IO ()) -> FatalError -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> FatalError
FatalError Text
"Quotes in field names are not allowed, so proper quotation can be implemented in the future. Write the field name in the value of --json or --json-file instead."
    case [([Text], Value)] -> Either Text Value
mergePaths [([Text], Value)]
items of
      Left Text
e -> UserException -> IO Value
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO Value) -> UserException -> IO Value
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Text
e
      Right Value
r -> Value -> IO Value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
r

readJsonEnvWithKey :: (Text, [Char]) -> IO (Text, Value)
readJsonEnvWithKey :: (Text, String) -> IO (Text, Value)
readJsonEnvWithKey (Text
key, String
envVar) =
  String -> IO (Maybe String)
lookupEnv String
envVar IO (Maybe String)
-> (Maybe String -> IO (Text, Value)) -> IO (Text, Value)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> UserException -> IO (Text, Value)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO (Text, Value))
-> UserException -> IO (Text, Value)
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"Environment variable does not exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
envVar
    Just String
x -> case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
x) of
      Left String
e -> UserException -> IO (Text, Value)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO (Text, Value))
-> UserException -> IO (Text, Value)
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"Environment variable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
envVar Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has invalid JSON: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
e
      Right Value
r -> (Text, Value) -> IO (Text, Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Value
r)

readEnvWithKey :: (Text, [Char]) -> IO (Text, Text)
readEnvWithKey :: (Text, String) -> IO (Text, Text)
readEnvWithKey (Text
key, String
envVar) =
  String -> IO (Maybe String)
lookupEnv String
envVar IO (Maybe String)
-> (Maybe String -> IO (Text, Text)) -> IO (Text, Text)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> UserException -> IO (Text, Text)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO (Text, Text))
-> UserException -> IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"Environment variable does not exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
envVar
    Just String
x -> (Text, Text) -> IO (Text, Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, String -> Text
forall a b. ConvertText a b => a -> b
toS String
x)

envCompleter :: Optparse.Completer
envCompleter :: Completer
envCompleter = IO [String] -> Completer
Optparse.listIOCompleter do
  ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> [String])
-> IO [(String, String)] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment

readFileWithKey :: (Text, FilePath) -> IO (Text, Text)
readFileWithKey :: (Text, String) -> IO (Text, Text)
readFileWithKey (Text
key, String
file) = do
  ByteString
bs <- String -> IO ByteString
BS.readFile String
file
  case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bs of
    Left UnicodeException
_e -> UserException -> IO (Text, Text)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO (Text, Text))
-> UserException -> IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not valid UTF-8."
    Right Text
s -> (Text, Text) -> IO (Text, Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
s)

readJsonFileWithKey :: (FromJSON b) => (Text, FilePath) -> IO (Text, b)
readJsonFileWithKey :: forall b. FromJSON b => (Text, String) -> IO (Text, b)
readJsonFileWithKey (Text
key, String
file) = do
  ByteString
bs <- String -> IO ByteString
BS.readFile String
file
  case ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
    Left String
e -> UserException -> IO (Text, b)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO (Text, b)) -> UserException -> IO (Text, b)
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not valid JSON: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
e
    Right b
s -> (Text, b) -> IO (Text, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, b
s)

readJsonFile :: (FromJSON b) => FilePath -> IO b
readJsonFile :: forall b. FromJSON b => String -> IO b
readJsonFile String
file = do
  ByteString
bs <- String -> IO ByteString
BS.readFile String
file
  case ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
    Left String
e -> UserException -> IO b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO b) -> UserException -> IO b
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not valid JSON: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. (Show a, StringConv String b) => a -> b
show String
e
    Right b
s -> b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
s

writeJsonFile :: (ToJSON a) => FilePath -> a -> IO ()
writeJsonFile :: forall a. ToJSON a => String -> a -> IO ()
writeJsonFile String
filePath a
v =
  String -> ByteString -> IO ()
atomicWriteFile String
filePath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Config -> a -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
prettyConf a
v

printJson :: (ToJSON a) => a -> IO ()
printJson :: forall a. ToJSON a => a -> IO ()
printJson = ByteString -> IO ()
BS.putStr (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
prettyConf

prettyConf :: Data.Aeson.Encode.Pretty.Config
prettyConf :: Config
prettyConf =
  Config
defConfig
    { -- Indentation convention for Nix expressions is also 2
      confIndent :: Indent
confIndent = Int -> Indent
Spaces Int
2,
      -- UNIX convention
      confTrailingNewline :: Bool
confTrailingNewline = Bool
True
    }

askPasswordWithKey :: Maybe Text -> Text -> IO (Text, Text)
askPasswordWithKey :: Maybe Text -> Text -> IO (Text, Text)
askPasswordWithKey Maybe Text
secretNameMaybe Text
key = do
  case Maybe Text
secretNameMaybe of
    Maybe Text
Nothing -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Enter value for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
    Just Text
secretName -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Enter value for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in secret " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
secretName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
  Text
s <- Text -> Text
T.strip (Text -> Text) -> IO Text -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO Text -> IO Text
forall a. Bool -> IO a -> IO a
withEcho Bool
False IO Text
getLine
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
""
  case Text
s of
    Text
"" -> UserException -> IO (Text, Text)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (UserException -> IO (Text, Text))
-> UserException -> IO (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException (Text -> UserException) -> Text -> UserException
forall a b. (a -> b) -> a -> b
$ Text
"Value must not be empty for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Text
key
    Text
_ -> (Text, Text) -> IO (Text, Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
s)

withEcho :: Bool -> IO a -> IO a
withEcho :: forall a. Bool -> IO a -> IO a
withEcho Bool
echo IO a
action = do
  Bool
old <- Handle -> IO Bool
hGetEcho Handle
stdin
  IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
echo) (Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
old) IO a
action