I can't think of a terribly good way to achieve GPG/PGP-compatibility without simply using GPG/PGP, since the file format is quite involved.
That said, here is how to implement a CBC-mode block cipher encryption using Conduit, which is suitable for something like AES256 encryption. It is almost certainly vulnerable to side-channel attacks (timing, cache-poisoning, etc) but as a pure function from input to output it is equivalent to `openssl aes-256-cbc -e -K <KEY-IN-HEX> -iv <IV-IN-HEX> -in data/plain-text.txt` which I should hope would be standard enough for analysis.
This leaves you with the problem of storing the key and IV securely, encrypted using the asymmetric key that you first thought of, but hopefully that problem is surmountable!
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Crypto.Cipher.AES
import Crypto.Cipher.Types
import Crypto.Data.Padding
import Crypto.Error
import qualified Data.ByteString as B
import Data.Conduit
import Data.Conduit.Binary
import Data.Monoid
loadKey :: IO B.ByteString
loadKey = B.readFile "data/key.dat"
loadIV :: IO (IV AES256)
loadIV = do
bytes <- B.readFile "data/iv.dat"
maybe (error "makeIV failed") return $ makeIV bytes
loadCipher :: IO AES256
loadCipher = throwCryptoErrorIO =<< cipherInit <$> loadKey
loadPlainText :: IO B.ByteString
loadPlainText = B.readFile "data/plain-text.txt"
encryptConduit :: (BlockCipher c, Monad m) => c -> IV c -> B.ByteString -> Conduit B.ByteString m B.ByteString
encryptConduit cipher iv partialBlock = await >>= \case
Nothing -> yield $ cbcEncrypt cipher iv $ pad (PKCS7 (blockSize cipher)) partialBlock
Just moreBytes -> let
fullBlocks = (B.length moreBytes + B.length partialBlock) `div` blockSize cipher
(thisTime, nextTime) = B.splitAt (fullBlocks * blockSize cipher) (partialBlock <> moreBytes)
in do
iv' <- if B.null thisTime then return iv else do
let cipherText = cbcEncrypt cipher iv thisTime
lastBlockOfCipherText = B.drop (B.length cipherText - blockSize cipher) cipherText
yield cipherText
maybe (error "makeIV failed") return $ makeIV lastBlockOfCipherText
encryptConduit cipher iv' nextTime
go :: IO ()
go = do
c <- loadCipher
iv <- loadIV
pt <- loadPlainText
let padded = pad (PKCS7 (blockSize c)) $ pt
encrypted = cbcEncrypt c iv padded
B.writeFile "data/haskell-oneshot.dat" encrypted
runResourceT $ runConduit
$ sourceFile "data/plain-text.txt"
=$= encryptConduit c iv mempty
=$= sinkFile "data/haskell-streaming.dat"