module Dhall.Secret
  ( encrypt,
    decrypt,
    DecryptPreference(..),
  )
where

import           Control.Lens
import           Data.ByteArray          (ByteArrayAccess)
import           Data.ByteArray.Encoding (Base (Base64), convertFromBase,
                                          convertToBase)
import           Data.HashMap.Strict     (HashMap)
import qualified Data.HashMap.Strict     as HashMap
import qualified Data.Text               as T
import qualified Data.Text.Encoding      as T
import           Data.Void               (Void)
import           Dhall.Core              (Chunks (Chunks), Expr (..),
                                          FieldSelection (FieldSelection),
                                          RecordField (RecordField),
                                          makeFieldSelection, makeRecordField,
                                          subExpressions)
import qualified Dhall.Map               as DM
import qualified Dhall.Secret.Age        as Age
import           Dhall.Secret.Aws        (awsRun)
import           Dhall.Secret.Type       (secretTypes)
import           Dhall.Src               (Src)
import           GHC.Exts                (toList)
import           Network.AWS             (send)
import           Network.AWS.KMS         (decEncryptionContext,
                                          eEncryptionContext)
import qualified Network.AWS.KMS         as KMS
import           Network.AWS.KMS.Decrypt (drsKeyId, drsPlaintext)
import           Network.AWS.KMS.Encrypt (ersCiphertextBlob, ersKeyId)
import           System.Environment      (getEnv)

varName :: Expr s a
varName :: Expr s a
varName = Var -> Expr s a
forall s a. Var -> Expr s a
Var Var
"dhall-secret"

data DecryptPreference = DecryptPreference
  { DecryptPreference -> Bool
dp'notypes :: Bool
  }

encrypt :: Expr Src Void -> IO (Expr Src Void)
encrypt :: Expr Src Void -> IO (Expr Src Void)
encrypt (App (Field Expr Src Void
u (FieldSelection Maybe Src
src Text
t Maybe Src
c)) (RecordLit Map Text (RecordField Src Void)
m))
  | Expr Src Void
u Expr Src Void -> Expr Src Void -> Bool
forall a. Eq a => a -> a -> Bool
== Expr Src Void
secretTypes Bool -> Bool -> Bool
&& Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"AwsKmsDecrypted" = case (Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"KeyId" Map Text (RecordField Src Void)
m, Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"PlainText" Map Text (RecordField Src Void)
m, Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"EncryptionContext" Map Text (RecordField Src Void)
m) of
    ( Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src Void)]
_ Text
kid)) Maybe Src
_ Maybe Src
_),
      Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src Void)]
_ Text
pt)) Maybe Src
_ Maybe Src
_),
      Just ec :: RecordField Src Void
ec@(RecordField Maybe Src
_ (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
ecl) Maybe Src
_ Maybe Src
_)
      ) -> do
        let context :: HashMap Text Text
context = [HashMap Text Text] -> HashMap Text Text
forall a. Monoid a => [a] -> a
mconcat ([HashMap Text Text] -> HashMap Text Text)
-> [HashMap Text Text] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ Seq (HashMap Text Text) -> [Item (Seq (HashMap Text Text))]
forall l. IsList l => l -> [Item l]
toList (Expr Src Void -> HashMap Text Text
forall a. Expr Src a -> HashMap Text Text
dhallMapToHashMap (Expr Src Void -> HashMap Text Text)
-> Seq (Expr Src Void) -> Seq (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Expr Src Void)
ecl)
        EncryptResponse
eResp <- AWS EncryptResponse -> IO EncryptResponse
forall b. AWS b -> IO b
awsRun (AWS EncryptResponse -> IO EncryptResponse)
-> AWS EncryptResponse -> IO EncryptResponse
forall a b. (a -> b) -> a -> b
$ Encrypt -> AWST' Env (ResourceT IO) (Rs Encrypt)
forall (m :: * -> *) a. (MonadAWS m, AWSRequest a) => a -> m (Rs a)
send (Encrypt -> AWST' Env (ResourceT IO) (Rs Encrypt))
-> Encrypt -> AWST' Env (ResourceT IO) (Rs Encrypt)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> Encrypt
KMS.encrypt Text
kid (Text -> ByteString
T.encodeUtf8 Text
pt) Encrypt -> (Encrypt -> Encrypt) -> Encrypt
forall a b. a -> (a -> b) -> b
& (HashMap Text Text -> Identity (HashMap Text Text))
-> Encrypt -> Identity Encrypt
Lens' Encrypt (HashMap Text Text)
eEncryptionContext ((HashMap Text Text -> Identity (HashMap Text Text))
 -> Encrypt -> Identity Encrypt)
-> HashMap Text Text -> Encrypt -> Encrypt
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashMap Text Text
context
        case (EncryptResponse
eResp EncryptResponse
-> Getting (Maybe Text) EncryptResponse (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) EncryptResponse (Maybe Text)
Lens' EncryptResponse (Maybe Text)
ersKeyId, EncryptResponse
eResp EncryptResponse
-> Getting (Maybe ByteString) EncryptResponse (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) EncryptResponse (Maybe ByteString)
Lens' EncryptResponse (Maybe ByteString)
ersCiphertextBlob) of
          (Just Text
_, Just ByteString
cb) ->
            Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$
              Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App
                (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
forall s a. Expr s a
varName (Text -> FieldSelection Src
forall s. Text -> FieldSelection s
makeFieldSelection Text
"AwsKmsEncrypted"))
                ( Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$
                    [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
DM.fromList
                      [ (Text
"KeyId", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
kid))),
                        (Text
"CiphertextBlob", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (ByteString -> Text
forall baa. ByteArrayAccess baa => baa -> Text
byteStringToB64 ByteString
cb)))),
                        (Text
"EncryptionContext", RecordField Src Void
ec)
                      ]
                )
          (Maybe Text, Maybe ByteString)
_ -> [Char] -> IO (Expr Src Void)
forall a. HasCallStack => [Char] -> a
error (EncryptResponse -> [Char]
forall a. Show a => a -> [Char]
show EncryptResponse
eResp)
    (Maybe (RecordField Src Void), Maybe (RecordField Src Void),
 Maybe (RecordField Src Void))
_ -> [Char] -> IO (Expr Src Void)
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal Error when encrypting AwsKmsDecrypted expr"
  | Expr Src Void
u Expr Src Void -> Expr Src Void -> Bool
forall a. Eq a => a -> a -> Bool
== Expr Src Void
secretTypes Bool -> Bool -> Bool
&& Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"AgeDecrypted" = case
      ( Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"Recipients" Map Text (RecordField Src Void)
m,
        Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"PlainText" Map Text (RecordField Src Void)
m) of
        (Just (RecordField Maybe Src
_ (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
pks) Maybe Src
_ Maybe Src
_),
         Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src Void)]
_ Text
plaintext)) Maybe Src
_ Maybe Src
_)) -> do
          [X25519Recipient]
rs <- (Text -> IO X25519Recipient) -> [Text] -> IO [X25519Recipient]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> IO X25519Recipient
Age.parseRecipient (Seq Text -> [Item (Seq Text)]
forall l. IsList l => l -> [Item l]
toList (Seq Text -> [Item (Seq Text)]) -> Seq Text -> [Item (Seq Text)]
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Text
extractTextLit (Expr Src Void -> Text) -> Seq (Expr Src Void) -> Seq Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Expr Src Void)
pks)
          ByteString
encrypted <- [X25519Recipient] -> ByteString -> IO ByteString
Age.encrypt [X25519Recipient]
rs (Text -> ByteString
T.encodeUtf8 Text
plaintext)
          Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App
              (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
forall s a. Expr s a
varName (Text -> FieldSelection Src
forall s. Text -> FieldSelection s
makeFieldSelection Text
"AgeEncrypted"))
              ( Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$
                  [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
DM.fromList
                    [ (Text
"Recipients", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
forall a. Maybe a
Nothing Seq (Expr Src Void)
pks)),
                      (Text
"CiphertextBlob", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (ByteString -> Text
T.decodeUtf8 ByteString
encrypted))))
                    ])
        (Maybe (RecordField Src Void), Maybe (RecordField Src Void))
_ -> [Char] -> IO (Expr Src Void)
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal Error when encrypting Symmetric expr"
  | Expr Src Void
u Expr Src Void -> Expr Src Void -> Bool
forall a. Eq a => a -> a -> Bool
== Expr Src Void
secretTypes = Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
forall s a. Expr s a
varName (Maybe Src -> Text -> Maybe Src -> FieldSelection Src
forall s. Maybe s -> Text -> Maybe s -> FieldSelection s
FieldSelection Maybe Src
src Text
t Maybe Src
c)) (Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit Map Text (RecordField Src Void)
m)
encrypt Expr Src Void
expr = (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions Expr Src Void -> IO (Expr Src Void)
encrypt Expr Src Void
expr

decrypt :: DecryptPreference -> Expr Src Void -> IO (Expr Src Void)
decrypt :: DecryptPreference -> Expr Src Void -> IO (Expr Src Void)
decrypt DecryptPreference
opts (App (Field Expr Src Void
u (FieldSelection Maybe Src
s Text
t Maybe Src
c)) (RecordLit Map Text (RecordField Src Void)
m))
  | Expr Src Void
u Expr Src Void -> Expr Src Void -> Bool
forall a. Eq a => a -> a -> Bool
== Expr Src Void
secretTypes Bool -> Bool -> Bool
&& Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"AwsKmsEncrypted" = case (Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"KeyId" Map Text (RecordField Src Void)
m, Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"CiphertextBlob" Map Text (RecordField Src Void)
m, Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"EncryptionContext" Map Text (RecordField Src Void)
m) of
    (Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src Void)]
_ Text
kid)) Maybe Src
_ Maybe Src
_), Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src Void)]
_ Text
cb)) Maybe Src
_ Maybe Src
_), Just ec :: RecordField Src Void
ec@(RecordField Maybe Src
_ (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
ecl) Maybe Src
_ Maybe Src
_)) -> do
      DecryptResponse
eResp <- case Base -> ByteString -> Either [Char] ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either [Char] bout
convertFromBase Base
Base64 (Text -> ByteString
T.encodeUtf8 Text
cb) of
        Left [Char]
e -> [Char] -> IO DecryptResponse
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
e)
        Right ByteString
a -> AWS DecryptResponse -> IO DecryptResponse
forall b. AWS b -> IO b
awsRun (AWS DecryptResponse -> IO DecryptResponse)
-> AWS DecryptResponse -> IO DecryptResponse
forall a b. (a -> b) -> a -> b
$ Decrypt -> AWST' Env (ResourceT IO) (Rs Decrypt)
forall (m :: * -> *) a. (MonadAWS m, AWSRequest a) => a -> m (Rs a)
send (Decrypt -> AWST' Env (ResourceT IO) (Rs Decrypt))
-> Decrypt -> AWST' Env (ResourceT IO) (Rs Decrypt)
forall a b. (a -> b) -> a -> b
$ ByteString -> Decrypt
KMS.decrypt ByteString
a Decrypt -> (Decrypt -> Decrypt) -> Decrypt
forall a b. a -> (a -> b) -> b
& (HashMap Text Text -> Identity (HashMap Text Text))
-> Decrypt -> Identity Decrypt
Lens' Decrypt (HashMap Text Text)
decEncryptionContext ((HashMap Text Text -> Identity (HashMap Text Text))
 -> Decrypt -> Identity Decrypt)
-> HashMap Text Text -> Decrypt -> Decrypt
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [HashMap Text Text] -> HashMap Text Text
forall a. Monoid a => [a] -> a
mconcat (Seq (HashMap Text Text) -> [Item (Seq (HashMap Text Text))]
forall l. IsList l => l -> [Item l]
toList (Expr Src Void -> HashMap Text Text
forall a. Expr Src a -> HashMap Text Text
dhallMapToHashMap (Expr Src Void -> HashMap Text Text)
-> Seq (Expr Src Void) -> Seq (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Expr Src Void)
ecl))
      case (DecryptResponse
eResp DecryptResponse
-> Getting (Maybe Text) DecryptResponse (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) DecryptResponse (Maybe Text)
Lens' DecryptResponse (Maybe Text)
drsKeyId, DecryptResponse
eResp DecryptResponse
-> Getting (Maybe ByteString) DecryptResponse (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) DecryptResponse (Maybe ByteString)
Lens' DecryptResponse (Maybe ByteString)
drsPlaintext) of
        (Just Text
_, Just ByteString
pt) ->
          Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ if DecryptPreference -> Bool
dp'notypes DecryptPreference
opts then
           Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (ByteString -> Text
T.decodeUtf8 ByteString
pt))
          else
            Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App
              (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
forall s a. Expr s a
varName (Text -> FieldSelection Src
forall s. Text -> FieldSelection s
makeFieldSelection Text
"AwsKmsDecrypted"))
              ( Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$
                  [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
DM.fromList
                    [ (Text
"KeyId", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
kid))),
                      (Text
"PlainText", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (ByteString -> Text
T.decodeUtf8 ByteString
pt)))),
                      (Text
"Context", RecordField Src Void
ec)
                    ])
        (Maybe Text, Maybe ByteString)
_ -> [Char] -> IO (Expr Src Void)
forall a. HasCallStack => [Char] -> a
error (DecryptResponse -> [Char]
forall a. Show a => a -> [Char]
show DecryptResponse
eResp)
    (Maybe (RecordField Src Void), Maybe (RecordField Src Void),
 Maybe (RecordField Src Void))
_ -> [Char] -> IO (Expr Src Void)
forall a. HasCallStack => [Char] -> a
error [Char]
"something wrong decrypting aws kms"
  | Expr Src Void
u Expr Src Void -> Expr Src Void -> Bool
forall a. Eq a => a -> a -> Bool
== Expr Src Void
secretTypes Bool -> Bool -> Bool
&& Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"AgeEncrypted" = case
      ( Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"Recipients" Map Text (RecordField Src Void)
m,
        Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"CiphertextBlob" Map Text (RecordField Src Void)
m) of
        (Just (RecordField Maybe Src
_ (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
pks) Maybe Src
_ Maybe Src
_),
         Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src Void)]
_ Text
plaintext)) Maybe Src
_ Maybe Src
_)) -> do
          [Text]
keys <- Text -> Text -> [Text]
T.splitOn Text
"\n" (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> [Text]) -> IO [Char] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
getEnv [Char]
"DHALL_SECRET_AGE_KEYS"
          [X25519Identity]
decodedKeys <- (Text -> IO X25519Identity) -> [Text] -> IO [X25519Identity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> IO X25519Identity
Age.parseIdentity [Text]
keys
          ByteString
decrypted <- ByteString -> [X25519Identity] -> IO ByteString
Age.decrypt (Text -> ByteString
T.encodeUtf8 Text
plaintext) [X25519Identity]
decodedKeys
          Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ if DecryptPreference -> Bool
dp'notypes DecryptPreference
opts then
            Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (ByteString -> Text
T.decodeUtf8 ByteString
decrypted))
           else Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App
              (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
forall s a. Expr s a
varName (Text -> FieldSelection Src
forall s. Text -> FieldSelection s
makeFieldSelection Text
"AgeDecrypted"))
              ( Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$
                  [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
DM.fromList
                    [ (Text
"Recipients", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
forall a. Maybe a
Nothing Seq (Expr Src Void)
pks)),
                      (Text
"PlainText", Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
makeRecordField (Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (ByteString -> Text
T.decodeUtf8 ByteString
decrypted))))
                    ])
        (Maybe (RecordField Src Void), Maybe (RecordField Src Void))
_ -> [Char] -> IO (Expr Src Void)
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal Error when decrypting Age"
  | Expr Src Void
u Expr Src Void -> Expr Src Void -> Bool
forall a. Eq a => a -> a -> Bool
== Expr Src Void
secretTypes = Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
forall s a. Expr s a
varName (Maybe Src -> Text -> Maybe Src -> FieldSelection Src
forall s. Maybe s -> Text -> Maybe s -> FieldSelection s
FieldSelection Maybe Src
s Text
t Maybe Src
c)) (Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit Map Text (RecordField Src Void)
m)
decrypt DecryptPreference
opts Expr Src Void
expr = (Expr Src Void -> IO (Expr Src Void))
-> Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions (DecryptPreference -> Expr Src Void -> IO (Expr Src Void)
decrypt DecryptPreference
opts) Expr Src Void
expr

dhallMapToHashMap :: Expr Src a -> HashMap T.Text T.Text
dhallMapToHashMap :: Expr Src a -> HashMap Text Text
dhallMapToHashMap (RecordLit Map Text (RecordField Src a)
m) = case (Text -> Map Text (RecordField Src a) -> Maybe (RecordField Src a)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"mapKey" Map Text (RecordField Src a)
m, Text -> Map Text (RecordField Src a) -> Maybe (RecordField Src a)
forall k v. Ord k => k -> Map k v -> Maybe v
DM.lookup Text
"mapValue" Map Text (RecordField Src a)
m) of
  (Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src a)]
_ Text
k)) Maybe Src
_ Maybe Src
_), Just (RecordField Maybe Src
_ (TextLit (Chunks [(Text, Expr Src a)]
_ Text
v)) Maybe Src
_ Maybe Src
_)) -> Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
k Text
v
  (Maybe (RecordField Src a), Maybe (RecordField Src a))
_ -> HashMap Text Text
forall a. Monoid a => a
mempty
dhallMapToHashMap Expr Src a
_ = HashMap Text Text
forall a. Monoid a => a
mempty

byteStringToB64 :: (ByteArrayAccess baa) => baa -> T.Text
byteStringToB64 :: baa -> Text
byteStringToB64 = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (baa -> ByteString) -> baa -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> baa -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64

extractTextLit :: Expr Src Void -> T.Text
extractTextLit :: Expr Src Void -> Text
extractTextLit (TextLit (Chunks [(Text, Expr Src Void)]
_ Text
t)) = Text
t
extractTextLit Expr Src Void
_                      = Text
""