Cv25519 encryption.

1 files changed, 231 insertions, 0 deletions

diff --git a/Data/OpenPGP/Util/Cv25519.hs b/Data/OpenPGP/Util/Cv25519.hs
new file mode 100644
index 0000000..aef3521
--- /dev/null
+++ b/Data/OpenPGP/Util/Cv25519.hs
@@ -0,0 +1,231 @@
+{-# 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
+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