{-# 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 [] 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)] = forall a b. b -> Either a b
Right Value
v
mergeLeafPaths [Text]
context [([Text], Value)]
items =
  case 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [Text]
k) of
    Maybe [(NonEmpty Text, Value)]
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Conflicting values for " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
showPath [Text]
context
    Just [(NonEmpty Text, Value)]
nonRootItems ->
      [(NonEmpty Text, Value)]
nonRootItems
        forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NEL.groupAllWith (forall a. NonEmpty a -> a
NEL.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
        forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
          ( \(groupItem :: (NonEmpty Text, Value)
groupItem@(Text
child :| [Text]
_, Value
_) :| [(NonEmpty Text, Value)]
groupItems) ->
              (Text -> Key
AK.fromText Text
child forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [([Text], Value)] -> Either Text Value
mergeLeafPaths ([Text]
context forall a. [a] -> [a] -> [a]
++ [Text
child]) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. NonEmpty a -> [a]
NEL.tail) ((NonEmpty Text, Value)
groupItem forall a. a -> [a] -> [a]
: [(NonEmpty Text, Value)]
groupItems))
          )
        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 = 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 forall a b. a -> (a -> b) -> b
& forall v. KeyMap v -> [(Key, v)]
AK.toAscList forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
AK.toText) forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \(Text
subpath, Value
subitem) ->
        [([Text], Value)] -> [([Text], Value)]
toLeafPaths [([Text]
path 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 <-
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          forall s. IsString s => ReadM s
Optparse.str
          forall s. IsString s => ReadM s
Optparse.str
          ( forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"string"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a string at dot-separated PATH in the secret data"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"STRING"
          )
      )
  [Text]
stringPasswords <-
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( forall a. ReadM a -> Mod OptionFields a -> Parser a
Optparse.option
          forall s. IsString s => ReadM s
Optparse.str
          ( forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"password"
              forall a. Semigroup a => a -> a -> a
<> 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"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
          )
      )
  [(Text, Text)]
jsons <-
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          forall s. IsString s => ReadM s
Optparse.str
          forall s. IsString s => ReadM s
Optparse.str
          ( forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"json"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a JSON value at dot-separated PATH in the secret data"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"JSON"
          )
      )
  [(Text, String)]
stringFiles <-
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          forall s. IsString s => ReadM s
Optparse.str
          forall s. IsString s => ReadM s
Optparse.str
          ( forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"string-file"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
Optparse.help String
"Define a string at dot-separated PATH in the secret data, by reading FILE"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"FILE"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 (String -> Completer
Optparse.bashCompleter String
"file")
          )
      )
  [(Text, String)]
jsonFiles <-
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          forall s. IsString s => ReadM s
Optparse.str
          forall s. IsString s => ReadM s
Optparse.str
          ( forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"json-file"
              forall a. Semigroup a => a -> a -> a
<> 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"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"FILE"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 (String -> Completer
Optparse.bashCompleter String
"file")
          )
      )
  [(Text, String)]
stringEnvs <-
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          forall s. IsString s => ReadM s
Optparse.str
          forall s. IsString s => ReadM s
Optparse.str
          ( forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"string-env"
              forall a. Semigroup a => a -> a -> a
<> 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"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"ENV_NAME"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 Completer
envCompleter
          )
      )
  [(Text, String)]
jsonEnvs <-
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( forall a b.
ReadM a -> ReadM b -> Mod OptionFields (a, b) -> Parser (a, b)
Optparse.biOption
          forall s. IsString s => ReadM s
Optparse.str
          forall s. IsString s => ReadM s
Optparse.str
          ( forall (f :: * -> *) a. HasName f => String -> Mod f a
Optparse.long String
"json-env"
              forall a. Semigroup a => a -> a -> a
<> 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"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Optparse.metavar String
"PATH"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar2 f => String -> Mod f a
Optparse.metavar2 String
"ENV_NAME"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter2 f => Completer -> Mod f a
Optparse.completer2 Completer
envCompleter
          )
      )
  pure \Maybe Text
maybeSecretName -> do
    [(Text, Text)]
fileStrings <- 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Text, String)]
jsonFiles forall b. FromJSON b => (Text, String) -> IO (Text, b)
readJsonFileWithKey
    [(Text, Text)]
envStrings <- 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 <- 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 <-
      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 forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
value of
              Left String
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"Value for key " forall a. Semigroup a => a -> a -> a
<> Text
key forall a. Semigroup a => a -> a -> a
<> Text
" is not valid JSON: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
e
              Right Value
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Value
r :: Value)
        )
    [(Text, Text)]
passwordStrings <- 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 =
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> [Text]
split) forall a b. (a -> b) -> a -> b
$
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
strings)
              forall a. Semigroup a => a -> a -> a
<> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
envStrings)
              forall a. Semigroup a => a -> a -> a
<> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
fileStrings)
              forall a. Semigroup a => a -> a -> a
<> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
passwordStrings)
              forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
validJsons
              forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
envJsons
              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 (forall a. Eq a => a -> a -> Bool
== Char
'.') Text
p
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([([Text], Value)]
items forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any \([Text]
path, Value
_) -> [Text]
path forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
'\"'))) do
      forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO 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 -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ forall a b. (Show a, StringConv String b) => a -> b
show Text
e
      Right Value
r -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"Environment variable does not exist: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
envVar
    Just String
x -> case forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
x) of
      Left String
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"Environment variable " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
envVar forall a. Semigroup a => a -> a -> a
<> Text
" has invalid JSON: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
e
      Right Value
r -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"Environment variable does not exist: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
envVar
    Just String
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, forall a b. ConvertText a b => a -> b
toS String
x)

envCompleter :: Optparse.Completer
envCompleter :: Completer
envCompleter = IO [String] -> Completer
Optparse.listIOCompleter do
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a b. (a, b) -> a
fst 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 -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"File " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
file forall a. Semigroup a => a -> a -> a
<> Text
" for key " forall a. Semigroup a => a -> a -> a
<> Text
key forall a. Semigroup a => a -> a -> a
<> Text
" is not valid UTF-8."
    Right Text
s -> 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 forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
    Left String
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"File " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
file forall a. Semigroup a => a -> a -> a
<> Text
" for key " forall a. Semigroup a => a -> a -> a
<> Text
key forall a. Semigroup a => a -> a -> a
<> Text
" is not valid JSON: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
e
    Right b
s -> 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 forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
    Left String
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"File " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
file forall a. Semigroup a => a -> a -> a
<> Text
" is not valid JSON: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show String
e
    Right b
s -> 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 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"Enter value for " forall a. Semigroup a => a -> a -> a
<> Text
key forall a. Semigroup a => a -> a -> a
<> Text
":"
    Just Text
secretName -> forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText forall a b. (a -> b) -> a -> b
$ Text
"Enter value for " forall a. Semigroup a => a -> a -> a
<> Text
key forall a. Semigroup a => a -> a -> a
<> Text
" in secret " forall a. Semigroup a => a -> a -> a
<> Text
secretName forall a. Semigroup a => a -> a -> a
<> Text
":"
  Text
s <- Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Bool -> IO a -> IO a
withEcho Bool
False IO Text
getLine
  forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
""
  case Text
s of
    Text
"" -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> UserException
UserException forall a b. (a -> b) -> a -> b
$ Text
"Value must not be empty for " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Text
key
    Text
_ -> 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
  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