packages feed

dhall-secret 0.5.52 → 0.5.53

raw patch · 5 files changed

+88/−80 lines, 5 files

Files

app/Main.hs view
@@ -3,17 +3,13 @@ {-# LANGUAGE QuasiQuotes       #-} module Main where -import qualified Data.Text           as T import qualified Data.Text.IO        as TIO import           Data.Void           (Void)-import           Dhall               (EvaluateSettings (..), InputSettings (..),-                                      inputExpr, inputExprWithSettings)-import           Dhall.Core          (pretty)-import           Dhall.Import        (load)+import           Dhall.Core          (Expr, pretty) import           Dhall.Secret import           Dhall.Secret.IO     (parseExpr, prettyExpr, version) import           Dhall.Secret.Type   (secretTypes)-import           Dhall.Src+import           Dhall.Src           (Src) import           Options.Applicative data EncryptOpts = EncryptOpts   { eo'file    :: Maybe String@@ -32,14 +28,17 @@  data Command = Encrypt EncryptOpts | Decrypt DecryptOpts | GenTypes GenTypesOpts +versionOpt :: Parser (a -> a) versionOpt = infoOption version (long "version" <> short 'v' <> help "print version") +genTypesOpt :: Parser GenTypesOpts genTypesOpt = GenTypesOpts  <$> optional (strOption                 (long "output"                 <> short 'o'                 <> metavar "FILE"                 <> help "Output types into FILE")) +encryptOpt :: Parser EncryptOpts encryptOpt = EncryptOpts   <$> optional (strOption                 (long "file"@@ -54,6 +53,7 @@                <> help "Write result to a file instead of stdout"))  +decryptOpt :: Parser DecryptOpts decryptOpt = DecryptOpts   <$> optional (strOption                 (long "file"@@ -68,12 +68,17 @@                <> help "Write result to a file instead of stdout"))   <*> switch (long "plain-text" <> short 'p' <> help "decrypt into plain text without types") +encryptCmdParser :: Parser EncryptOpts encryptCmdParser = hsubparser $ command "encrypt" (info encryptOpt (progDesc "Encrypt a Dhall expression")) <> metavar "encrypt" +decryptCmdParser :: Parser DecryptOpts decryptCmdParser = hsubparser $ command "decrypt" (info decryptOpt (progDesc "Decrypt a Dhall expression")) <> metavar "decrypt" +genTypesCmdParser :: Parser GenTypesOpts genTypesCmdParser = hsubparser $ command "gen-types" (info genTypesOpt (progDesc "generate types")) <> metavar "gen-types" ++commands :: Parser Command commands = Encrypt <$> encryptCmdParser   <|> Decrypt <$>decryptCmdParser   <|> GenTypes <$> genTypesCmdParser@@ -90,6 +95,7 @@   let a = pretty secretTypes   maybe (TIO.putStrLn a) (`TIO.writeFile` a) gt'output +ioDhallExpr :: Maybe FilePath -> Maybe FilePath -> Bool -> (Expr Src Void -> IO (Expr Src Void)) -> IO () ioDhallExpr input output inplace op = do   text <- maybe TIO.getContents TIO.readFile input   expr <- parseExpr text
dhall-secret.cabal view
@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.5.52+version:            0.5.53  -- A short (one-line) description of the package. synopsis:           Encrypt Decrypt Dhall expressions
src/Dhall/Secret/Age.hs view
@@ -4,8 +4,10 @@     generateX25519Identity,     parseRecipient,     parseIdentity,-    toRecipient-  ) where+    toRecipient,+  )+where+ import qualified Codec.Binary.Bech32          as Bech32 import qualified Crypto.Cipher.ChaChaPoly1305 as CC import           Crypto.Error                 (CryptoError (..),@@ -30,15 +32,19 @@ import qualified Data.Text                    as T  data Stanza = Stanza-  { stzType:: ByteString-  , stzArgs :: [ByteString]-  , stzBody :: ByteString-  } deriving Show+  { stzType :: ByteString,+    stzArgs :: [ByteString],+    stzBody :: ByteString+  }+  deriving (Show)+ data X25519Recipient = X25519Recipient X25519.PublicKey+ instance Show X25519Recipient where   show (X25519Recipient pub) = T.unpack $ b32 "age" pub  data X25519Identity = X25519Identity X25519.PublicKey X25519.SecretKey+ instance Show X25519Identity where   show (X25519Identity _ sec) = T.unpack $ T.toUpper $ b32 "AGE-SECRET-KEY-" sec @@ -51,8 +57,8 @@   fileKey <- getRandomBytes 16 :: IO ByteString   nonce <- getRandomBytes 16 :: IO ByteString   stanzas <- traverse (mkStanza fileKey) recipients-  body <-  encryptChunks (payloadKey nonce fileKey) (zeroNonceOf 11) msg-  pure $ pemWriteBS $ PEM { pemName ="AGE ENCRYPTED FILE", pemHeader = [], pemContent = mkHeader fileKey stanzas <> nonce <> body}+  body <- encryptChunks BS.empty (payloadKey nonce fileKey) (zeroNonceOf 11) msg+  pure $ pemWriteBS $ PEM {pemName = "AGE ENCRYPTED FILE", pemHeader = [], pemContent = mkHeader fileKey stanzas <> nonce <> body}  decrypt :: ByteString -> [X25519Identity] -> IO ByteString decrypt ciphertext identities = do@@ -62,10 +68,10 @@   case find isRight $ possibleKeys of     Just (Right key) -> do       let (headerNoMac, macGot) = mkHeaderMac key stz-      if macGot == mac then-        decryptChunks (payloadKey nonce key) (zeroNonceOf 11) body-      else error $ show $  "Header MAC not match" <> headerNoMac <> "\n" <> macGot-    _                -> error "No file key found"+      if macGot == mac+        then decryptChunks BS.empty (payloadKey nonce key) (zeroNonceOf 11) body+        else error $ show $ "Header MAC not match" <> headerNoMac <> "\n" <> macGot+    _ -> error "No file key found"  generateX25519Identity :: IO X25519Identity generateX25519Identity = do@@ -80,20 +86,38 @@   key <- X25519.secretKey (b32dec i)   pure $ X25519Identity (X25519.toPublic key) key -decryptChunks :: ByteString -> ByteString -> ByteString -> IO ByteString-decryptChunks key nonce body = case BS.splitAt (64 * 1024) body of-  (head', tail') | tail' == BS.empty -> decryptChunk key nonce head' (BS.pack [1])-  (head', tail')                    -> decryptChunk key nonce head' (BS.pack [0]) <> decryptChunks key (incNonce nonce) tail'+decryptChunks :: ByteString -> ByteString -> ByteString -> ByteString -> IO ByteString+decryptChunks acc key nonce body = case BS.splitAt (64 * 1024 + 16) body of+  (head', tail') | tail' == BS.empty -> (acc <>) <$> decryptChunk key nonce head' (BS.pack [1])+  (head', tail') -> do+    decrypted <- decryptChunk key nonce head' (BS.pack [0])+    decryptChunks (acc <> decrypted) key (incNonce nonce) tail' +encryptChunks :: ByteString -> ByteString -> ByteString -> ByteString -> IO ByteString+encryptChunks acc key nonce msg = case BS.splitAt (64 * 1024) msg of+  (head', tail') | tail' == BS.empty -> (acc <>) <$> encryptChunk key nonce head' (BS.pack [1])+  (head', tail') -> do+    encrypted <- encryptChunk key nonce head' (BS.pack [0])+    encryptChunks (acc <> encrypted) key (incNonce nonce) tail'++encryptChunk :: ByteString -> ByteString -> ByteString -> ByteString -> IO ByteString+encryptChunk key nonce msg isFinal = do+  st <- throwCryptoErrorIO $ do+    payloadNonce <- CC.nonce12 $ (nonce <> isFinal)+    CC.finalizeAAD <$> CC.initialize key payloadNonce+  let (e, st1) = CC.encrypt msg st+  let tag = CC.finalize st1+  return $ e <> (convert tag)+ decryptChunk :: ByteString -> ByteString -> ByteString -> ByteString -> IO ByteString decryptChunk key nonce cipherblob isFinal = do-    st1 <- throwCryptoErrorIO $ do-      payloadNonce <- CC.nonce12 $ (nonce <> isFinal)-      CC.finalizeAAD  <$> CC.initialize key payloadNonce-    let (msg, tag) = BS.splitAt (BS.length cipherblob - 16) cipherblob-    let (d, st2) = CC.decrypt msg st1-    let authtag = CC.finalize st2-    if (convert authtag) == tag then pure d else error "Invalid auth tag"+  st1 <- throwCryptoErrorIO $ do+    payloadNonce <- CC.nonce12 $ (nonce <> isFinal)+    CC.finalizeAAD <$> CC.initialize key payloadNonce+  let (msg, tag) = BS.splitAt (BS.length cipherblob - 16) cipherblob+  let (d, st2) = CC.decrypt msg st1+  let authtag = CC.finalize st2+  if (convert authtag) == tag then pure d else error "Invalid auth tag"  parseCipher :: ByteString -> Either String CipherBlock parseCipher ct = do@@ -103,19 +127,19 @@   let (nonce, body) = BS.splitAt 16 rest2   pure $ Cipher header nonce body -parseHeader :: Header ->  ByteString -> Either String (Header, ByteString)+parseHeader :: Header -> ByteString -> Either String (Header, ByteString) parseHeader (Header stz mac) content = do   case BS.take 3 content of     "---" ->-      let (mac', body) = BS.break isLF $ content in-        Right $ (Header (reverse stz) (BS.decodeBase64Lenient $ BS.drop 4 mac'), BS.drop 1 body)+      let (mac', body) = BS.break isLF $ content+       in Right $ (Header (reverse stz) (BS.decodeBase64Lenient $ BS.drop 4 mac'), BS.drop 1 body)     "-> " ->       let (recipients, rest1) = BS.break isLF $ BS.drop 3 content           (fileKey, rest2) = BS.break isLF $ BS.drop 1 rest1           (stztype, rest11) = BS.break isSpace recipients           stzarg = BS.drop 1 rest11-          st = Stanza {stzType = stztype, stzArgs = [stzarg], stzBody = BS.decodeBase64Lenient fileKey} in-      parseHeader (Header (st:stz) mac) (BS.drop 1 rest2)+          st = Stanza {stzType = stztype, stzArgs = [stzarg], stzBody = BS.decodeBase64Lenient fileKey}+       in parseHeader (Header (st : stz) mac) (BS.drop 1 rest2)     _ -> Left "invalid headers"   where     isLF = (== 0x0a)@@ -139,41 +163,27 @@       let dtag = CC.finalize st1       if (convert dtag) == tag then pure d else CryptoFailed CryptoError_AuthenticationTagSizeInvalid -encryptChunks :: ByteString -> ByteString -> ByteString -> IO ByteString-encryptChunks key nonce msg = case BS.splitAt (64 * 1024) msg of-  (head', tail') | tail' == BS.empty -> encryptChunk key nonce head' (BS.pack [1])-  (head', tail')                    -> encryptChunk key nonce head' (BS.pack [0]) <> encryptChunks key (incNonce nonce) tail'--encryptChunk :: ByteString -> ByteString -> ByteString -> ByteString -> IO ByteString-encryptChunk key nonce msg isFinal = do-  st <- throwCryptoErrorIO $ do-    payloadNonce <- CC.nonce12 $ (nonce <> isFinal)-    CC.finalizeAAD <$> CC.initialize key payloadNonce-  let (e, st1) = CC.encrypt msg st-  let tag = CC.finalize st1-  return $ e <> (convert tag)- toRecipient :: X25519Identity -> X25519Recipient toRecipient (X25519Identity pub _) = X25519Recipient pub  b32 :: (ByteArrayAccess b) => Text -> b -> Text b32 header b = case Bech32.humanReadablePartFromText header of-        Left e -> T.pack $ show e-        Right header' -> case Bech32.encode header' (Bech32.dataPartFromBytes (convert b)) of-          Left e  -> T.pack $ show e-          Right t -> t+  Left e -> T.pack $ show e+  Right header' -> case Bech32.encode header' (Bech32.dataPartFromBytes (convert b)) of+    Left e  -> T.pack $ show e+    Right t -> t  b32dec :: Text -> ByteString b32dec r = case Bech32.decode r of-  Left _         -> error "Cannot decode bech32"+  Left _ -> error "Cannot decode bech32"   Right (_, d) -> fromMaybe (error "Cannot extract bech32 data") $ Bech32.dataPartToBytes d -mkStanza ::   ByteString -> X25519Recipient -> IO Stanza+mkStanza :: ByteString -> X25519Recipient -> IO Stanza mkStanza fileKey (X25519Recipient theirPK) = do   ourKey <- X25519.generateSecretKey   let ourPK = X25519.toPublic ourKey   let shareKey = X25519.dh theirPK ourKey-  let salt  = (convert ourPK) <> (convert theirPK) :: ByteString+  let salt = (convert ourPK) <> (convert theirPK) :: ByteString   let wrappingKey = hkdf "age-encryption.org/v1/X25519" (convert shareKey) salt   body <- throwCryptoErrorIO $ do     nonce <- CC.nonce12 (BS.pack $ take 12 $ repeat 0)@@ -187,13 +197,14 @@   let prefix = "-> " :: ByteString       body = BS.encodeBase64Unpadded' $ stzBody stanza       argLine = prefix <> stzType stanza <> " " <> intercalate " " (stzArgs stanza) <> "\n"-  in argLine <>-     wrap64b body <> "\n"+   in argLine+        <> wrap64b body+        <> "\n"  mkHeader :: ByteString -> [Stanza] -> ByteString mkHeader fileKey recipients =   let (headerNoMac, mac) = mkHeaderMac fileKey recipients-  in  headerNoMac <> " " <>  (BS.encodeBase64Unpadded' mac) <> "\n"+   in headerNoMac <> " " <> (BS.encodeBase64Unpadded' mac) <> "\n"  mkHeaderMac :: ByteString -> [Stanza] -> (ByteString, ByteString) mkHeaderMac fileKey recipients =@@ -201,27 +212,28 @@       macKey = hkdf "header" fileKey ""       footer = "---" :: ByteString       stanza = BS.concat (marshalStanza <$> recipients)-      headerNoMac = intro <>  stanza <> footer+      headerNoMac = intro <> stanza <> footer       mac = convert (hmac macKey headerNoMac :: HMAC SHA256) :: ByteString-  in (headerNoMac, mac)+   in (headerNoMac, mac)  hkdf :: ByteString -> ByteString -> ByteString -> ByteString-hkdf info key salt = HKDF.expand (HKDF.extract  salt key ::PRK SHA256) info 32+hkdf info key salt = HKDF.expand (HKDF.extract salt key :: PRK SHA256) info 32  incNonce :: ByteString -> ByteString incNonce n = BS.pack . snd $ foldr inc1 (True, []) (BS.unpack n)   where-    inc1  cur (True, acc) = (cur + 1 == 0, (cur + 1) : acc)+    inc1 cur (True, acc)  = (cur + 1 == 0, (cur + 1) : acc)     inc1 cur (False, acc) = (False, cur : acc)  zeroNonceOf :: Int -> ByteString zeroNonceOf n = BS.pack (take n $ repeat 0) -wrap64b :: ByteString  -> ByteString+wrap64b :: ByteString -> ByteString wrap64b bs =   let (head', tail') = BS.splitAt 64 bs-  in if (BS.length tail' == 0) then head'-  else head' <> "\n" <> wrap64b tail'+   in if (BS.length tail' == 0)+        then head'+        else head' <> "\n" <> wrap64b tail'  payloadKey :: ByteString -> ByteString -> ByteString-payloadKey nonce filekey = HKDF.expand (HKDF.extract  nonce filekey ::PRK SHA256) ("payload" :: ByteString) 32+payloadKey nonce filekey = HKDF.expand (HKDF.extract nonce filekey :: PRK SHA256) ("payload" :: ByteString) 32
test/Age.hs view
@@ -1,14 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Age where-import qualified Crypto.Cipher.ChaChaPoly1305 as CC-import           Crypto.Error                 (throwCryptoErrorIO)-import           Data.ByteArray               (ByteArray, ByteArrayAccess,-                                               Bytes, convert, pack)-import           Data.ByteString              (ByteString, empty)-import qualified Data.ByteString              as BS-import qualified Data.Text                    as T-import qualified Data.Text.Encoding           as TE-import qualified Data.Text.IO                 as TIO+import qualified Data.ByteString  as BS import           Dhall.Secret.Age import           Test.HUnit @@ -17,8 +9,7 @@   i2 <- generateX25519Identity   let r = toRecipient i   let r2 = toRecipient i2-  plaintext <- BS.readFile "./README.md"+  plaintext <- BS.readFile "./test/age.md"   encrypted <- encrypt [r, r2] plaintext-  print encrypted   decrypted <- decrypt encrypted [i]   assertEqual "age encryption" plaintext decrypted
test/Spec.hs view
@@ -1,13 +1,12 @@ module Main where import           Age import qualified Data.Text.IO             as TIO-import           Dhall-import           Dhall.Core               (pretty) import qualified Dhall.Secret             as Lib import           Dhall.Secret.IO import           System.Environment       (setEnv) import           System.Environment.Blank (getEnv) import           Test.HUnit+ testKms = "encrypt decrypt with KMS" ~: snapshot "./test/example01.dhall" "./test/example01.encrypted.dhall" testAge = "encrypt decrypt with Age Algo" ~: snapshot "./test/example02.dhall" "./test/example02.encrypted.dhall"