{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE QuasiQuotes #-} module Data.OpenPGP.Util.Cv25519 where import Control.Arrow import Control.Monad import Data.Binary import Data.Binary.Get import Data.ByteString (ByteString) import Data.Bits import qualified Data.ByteArray as BA import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Data.Char import Numeric import Data.Int import Data.OpenPGP.Internal import Data.OpenPGP.Util.Fingerprint import Data.OpenPGP.Util.Base import Data.OpenPGP as OpenPGP import Crypto.Cipher.SBox import Data.OpenPGP.Util.Ed25519 (zeroExtend,zeroPad) import qualified Crypto.PubKey.Curve25519 as Cv25519 import Crypto.Error import Crypto.Cipher.AES import Crypto.Cipher.Types import Data.OpenPGP.Util.DecryptSecretKey -- (withS2K, simpleUnCFB, Enciphered(..)) import Crypto.JOSE.AESKW oid_cv25519 = 0x2B060104019755010501 getEphemeralKey :: OpenPGP.Packet -> Maybe ([(Char,MPI)],BL.ByteString) getEphemeralKey AsymmetricSessionKeyPacket { version = 3 , key_algorithm = ECC , encrypted_data = dta } = do -- Algorithm-Specific Fields for ECDH encryption: -- -- * MPI of an EC point representing an ephemeral public key. -- -- * a one-octet size, followed by a symmetric key encoded using the -- method described in Section 13.5. (b,_,d) <- either (const Nothing) Just $ runGetOrFail getEllipticCurvePublicKey dta (sz,m) <- BL.uncons b guard $ BL.length m == fromIntegral sz return (d,m) getEphemeralKey _ = Nothing -- The value "m" in the above formulas is derived from the session key -- as follows. First, the session key is prefixed with a one-octet -- algorithm identifier that specifies the symmetric encryption -- algorithm used to encrypt the following Symmetrically Encrypted Data -- Packet. Then a two-octet checksum is appended, which is equal to the -- sum of the preceding session key octets, not including the algorithm -- identifier, modulo 65536. This value is then encoded as described in -- PKCS#1 block encoding EME-PKCS1-v1_5 in Section 7.2.1 of [RFC3447] to -- form the "m" value used in the formulas above. See Section 14.1 of -- this document for notes on OpenPGP's use of PKCS#1. privateCv25519Key :: OpenPGP.Packet -> Maybe Cv25519.SecretKey privateCv25519Key k@SecretKeyPacket { key_algorithm = ECC, symmetric_algorithm = Unencrypted } = do guard $ oid_cv25519 == keyParam 'c' k case Cv25519.secretKey $ zeroExtend 32 $ integerToLE (keyParam 'd' k) of CryptoPassed cv25519sec -> Just cv25519sec CryptoFailed err -> Nothing hexify = map toUpper . hexString . BS.unpack hexString :: [Word8] -> String hexString = foldr (pad `oo` showHex) "" where pad s | odd $ length s = '0':s | otherwise = s oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c oo = (.) . (.) cv25519Key :: [(Char,MPI)] -> Maybe Cv25519.PublicKey cv25519Key k = do MPI flag <- lookup 'f' k n <- case flag of 0x40 -> zeroPad 32 . integerToBS . (\(MPI n)-> n) <$> lookup 'n' k -- TODO: The following was based on Ed25519. Verify that it is correct for Cv25519. _ -> do MPI y <- lookup 'y' k MPI x <- lookup 'x' k let ybs = zeroExtend 32 $ integerToLE y lb = BS.last ybs return $ if x < 0 then BS.take 31 ybs `BS.snoc` (lb .|. 0x80) else BS.take 31 ybs `BS.snoc` (lb .&. 0x7F) maybeCryptoError $ Cv25519.publicKey n kdfParams :: OpenPGP.Packet -> (OpenPGP.HashAlgorithm, OpenPGP.SymmetricAlgorithm) kdfParams k = toEnum *** toEnum $ divMod e 256 where e = 0x0FFFF .&. (fromIntegral $ keyParam 'e' k) -- flen <- get :: Get Word8 -- always 3 (length of following bytes) -- one <- get :: Get Word8 -- always 0x01 (reserved) -- hashid <- get :: Get Word8 -- HashAlgorithm -- algoid <- get :: Get Word8 -- SymmetricAlgorithm data SomeKeyCipher = forall c. BlockCipher128 c => SomeKeyCipher c someAES128 :: AES128 -> SomeKeyCipher someAES192 :: AES192 -> SomeKeyCipher someAES256 :: AES256 -> SomeKeyCipher someAES128 = SomeKeyCipher someAES192 = SomeKeyCipher someAES256 = SomeKeyCipher keyCipher :: OpenPGP.SymmetricAlgorithm -> BS.ByteString -> Maybe SomeKeyCipher keyCipher OpenPGP.AES128 key = someAES128 <$> maybeCryptoError (cipherInit key) keyCipher OpenPGP.AES192 key = someAES192 <$> maybeCryptoError (cipherInit key) keyCipher OpenPGP.AES256 key = someAES256 <$> maybeCryptoError (cipherInit key) keyCipher _ _ = Nothing keyCipherSize OpenPGP.AES128 = cipherKeySize (undefined :: AES128) keyCipherSize OpenPGP.AES192 = cipherKeySize (undefined :: AES192) keyCipherSize OpenPGP.AES256 = cipherKeySize (undefined :: AES256) kdfParamBytes :: OpenPGP.Packet -> BL.ByteString kdfParamBytes k = BL.fromChunks [ BL.toStrict $ encodeOID (MPI $ keyParam 'c' k) -- curve_OID_len || curve_OID , BS.singleton $ fromIntegral $ fromEnum $ key_algorithm k -- public_key_alg_ID , BL.toStrict $ encode (fromIntegral (keyParam 'e' k) :: Word32) -- 03 || 01 || KDF_hash_ID || KEK_alg_ID for AESKeyWrap , B8.pack "Anonymous Sender " , let Fingerprint fp = fingerprint k in fp ] -- The Concatenation Key Derivation Function (Approved Alternative 1) [SP800-56A] kdf :: OpenPGP.HashAlgorithm -> Cv25519.DhSecret -> Int -> BL.ByteString -> Maybe BL.ByteString kdf hsh z keybytelen otherinfo | reps > 2^32 - 1 = Nothing -- XXX: I don't understand /max_hash_inputlen/. -- -- max_hash_inputlen: an integer that indicates the maximum length (in -- bits) of the bit string(s) input to the hash function. -- -- | 8 * (BS.length zo) > max_hash_inputlen - 32 = Nothing | otherwise = Just derivedKeyingMaterial where keydatalen = 8 * fromIntegral keybytelen :: Int64 hashlen = 8 * fromIntegral (hashLen hsh) :: Int64 reps = fromIntegral $ (keydatalen + hashlen - 1) `div` hashlen counter = 0x00000001 :: Word32 zo = BL.fromStrict (BA.convert z) <> otherinfo hashes = [ hashBySymbol hsh (encode (i::Word32) <> zo) | i <- [1 .. reps] ] -- Compute Hash i = H(counter || Z || OtherInfo). -- Let Hhash be set to Hash[reps] if (keydatalen / hashlen) is an integer; otherwise, let Hhash -- be set to the (keydatalen mod hashlen) leftmost bits of Hash[reps]. hhash = case keydatalen `mod` hashlen of 0 -> last hashes r -> BS.take (fromIntegral $ (r + 7) `div` 8) $ last hashes -- TODO: Zero out the 8 - (r `mod` 8) last bits? derivedKeyingMaterial = BL.fromChunks $ init hashes ++ [ hhash ] -- The input to the key wrapping method is the value "m" derived from -- the session key, as described in Section 5.1, "Public-Key Encrypted -- Session Key Packets (Tag 1)", except that the PKCS #1.5 padding step -- is omitted. The result is padded using the method described in -- [PKCS5] to the 8-byte granularity. For example, the following -- AES-256 session key, in which 32 octets are denoted from k0 to k31, -- is composed to form the following 40 octet sequence: -- -- 09 k0 k1 ... k31 c0 c1 05 05 05 05 05 -- -- The octets c0 and c1 above denote the checksum. This encoding allows -- the sender to obfuscate the size of the symmetric encryption key used -- to encrypt the data. For example, assuming that an AES algorithm is -- used for the session key, the sender MAY use 21, 13, and 5 bytes of -- padding for AES-128, AES-192, and AES-256, respectively, to provide -- the same number of octets, 40 total, as an input to the key wrapping -- method. -- -- From Section 5.1, "Public-Key Encrypted Session Key Packets (Tag 1)" -- -- The value "m" in the above formulas is derived from the session key -- as follows. First, the session key is prefixed with a one-octet -- algorithm identifier that specifies the symmetric encryption -- algorithm used to encrypt the following Symmetrically Encrypted Data -- Packet. Then a two-octet checksum is appended, which is equal to the -- sum of the preceding session key octets, not including the algorithm -- identifier, modulo 65536. This value is then encoded as described in -- PKCS#1 block encoding EME-PKCS1-v1_5 in Section 7.2.1 of [RFC3447] to -- form the "m" value used in the formulas above. See Section 14.1 of -- this document for notes on OpenPGP's use of PKCS#1. decodeEncryptedKey :: ByteString -> Maybe (SymmetricAlgorithm, ByteString) decodeEncryptedKey m = do (algb,ks) <- BS.uncons m let alg = toEnum $ fromIntegral algb :: OpenPGP.SymmetricAlgorithm sz <- case keyCipherSize alg of KeySizeFixed n -> Just n _ -> Nothing let (key,macbs) = BS.splitAt sz ks (macb,trail) = BS.splitAt 2 macbs mac = decode $ BL.fromStrict macb :: Word16 chk = sum $ map fromIntegral $ BS.unpack key guard $ chk == mac Just (alg, key) decryptMessage :: Packet -- ^ local secret key (ecdh cv25519) -> Packet -- ^ ephemeral remote public key (ecdh cv25519) and encrypted symmetric key. -> Packet -- ^ symmetrically encrypted data packet -> Maybe [Packet] decryptMessage ecdhkey asym encdta = do (pubk,m) <- getEphemeralKey asym pub25519 <- cv25519Key pubk sec25519 <- privateCv25519Key ecdhkey let shared = Cv25519.dh pub25519 sec25519 (hsh, alg) = kdfParams ecdhkey miv = let sz = case keyCipherSize alg of KeySizeFixed n -> n KeySizeEnum ns -> head ns KeySizeRange mn mx -> mn in kdf hsh shared sz (kdfParamBytes ecdhkey) (alg,k) <- do iv <- BL.toStrict <$> miv SomeKeyCipher c <- keyCipher alg iv m' <- aesKeyUnwrap c (BL.toStrict m) :: Maybe BS.ByteString decodeEncryptedKey m' withS2K' alg Nothing (BL.fromStrict k) $ \cipher -> do let blksize = blockSize cipher b0 = simpleUnCFB cipher nullIV (encrypted_data encdta) b1 = BL.drop (2 + fromIntegral blksize) b0 (_,_, Message ps) <- either (const Nothing) Just $ decodeOrFail b1 return ps