-- |
-- Module      : Crypto.Store.KeyWrap.RC2
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- RC2 Key Wrap (<https://tools.ietf.org/html/rfc3217 RFC 3217>)
--
-- Should be used with a cipher from module "Crypto.Store.Cipher.RC2".
module Crypto.Store.KeyWrap.RC2
    ( wrap
    , wrap'
    , unwrap
    ) where

import           Data.ByteArray (ByteArray)
import qualified Data.ByteArray as B

import Crypto.Cipher.Types
import Crypto.Hash
import Crypto.Random

import Crypto.Store.Error
import Crypto.Store.Util

checksum :: ByteArray ba => ba -> ba
checksum :: forall ba. ByteArray ba => ba -> ba
checksum ba
bs = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall a b. (a -> b) -> a -> b
$ forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
B.takeView (forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1 ba
bs) Int
8

iv4adda22c79e82105 :: B.Bytes
iv4adda22c79e82105 :: Bytes
iv4adda22c79e82105 = forall a. ByteArray a => [Word8] -> a
B.pack [Word8
0x4a, Word8
0xdd, Word8
0xa2, Word8
0x2c, Word8
0x79, Word8
0xe8, Word8
0x21, Word8
0x05]

-- | Wrap an RC2 key with the specified RC2 cipher.
--
-- Input must be between 0 and 255 bytes.  A fresh IV should be generated
-- randomly for each invocation.
wrap :: (MonadRandom m, BlockCipher cipher, ByteArray ba)
     => cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrap :: forall (m :: * -> *) cipher ba.
(MonadRandom m, BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> m (Either StoreError ba)
wrap = forall ba cipher result.
(ByteArray ba, BlockCipher cipher) =>
(StoreError -> result)
-> ((ba -> ba) -> Int -> result)
-> cipher
-> IV cipher
-> ba
-> result
wrap' (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall {f :: * -> *} {a} {b} {a}.
(MonadRandom f, ByteArray a) =>
(a -> b) -> Int -> f (Either a b)
randomPad
  where randomPad :: (a -> b) -> Int -> f (Either a b)
randomPad a -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes

-- | Wrap an RC2 key with the specified RC2 cipher, using the given source of
-- random padding data.
--
-- Input must be between 0 and 255 bytes.  A fresh IV should be generated
-- randomly for each invocation.
wrap' :: (ByteArray ba, BlockCipher cipher)
      => (StoreError -> result) -> ((ba -> ba) -> Int -> result)
      -> cipher -> IV cipher -> ba -> result
wrap' :: forall ba cipher result.
(ByteArray ba, BlockCipher cipher) =>
(StoreError -> result)
-> ((ba -> ba) -> Int -> result)
-> cipher
-> IV cipher
-> ba
-> result
wrap' StoreError -> result
failure (ba -> ba) -> Int -> result
withRandomPad cipher
cipher IV cipher
iv ba
cek
    | Int
inLen forall a. Ord a => a -> a -> Bool
< Int
256 = (ba -> ba) -> Int -> result
withRandomPad ba -> ba
f Int
padlen
    | Bool
otherwise   = StoreError -> result
failure
        (String -> StoreError
InvalidInput String
"KeyWrap.RC2: invalid length for content encryption key")
  where
    inLen :: Int
inLen      = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
cek
    padlen :: Int
padlen     = (Int
7 forall a. Num a => a -> a -> a
- Int
inLen) forall a. Integral a => a -> a -> a
`mod` Int
8

    f :: ba -> ba
f ba
pad =
        let lcek :: ba
lcek       = forall a. ByteArray a => Word8 -> a -> a
B.cons (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen) ba
cek
            lcekpad :: ba
lcekpad    = forall bs. ByteArray bs => bs -> bs -> bs
B.append ba
lcek ba
pad
            lcekpadicv :: ba
lcekpadicv = forall bs. ByteArray bs => bs -> bs -> bs
B.append ba
lcekpad (forall ba. ByteArray ba => ba -> ba
checksum ba
lcekpad)
            temp1 :: ba
temp1      = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt cipher
cipher IV cipher
iv ba
lcekpadicv
            temp2 :: ba
temp2      = forall bs. ByteArray bs => bs -> bs -> bs
B.append (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert IV cipher
iv) ba
temp1
            temp3 :: ba
temp3      = forall ba. ByteArray ba => ba -> ba
reverseBytes ba
temp2
            Just IV cipher
iv'   = forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV Bytes
iv4adda22c79e82105
         in forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt cipher
cipher IV cipher
iv' ba
temp3

-- | Unwrap an encrypted RC2 key with the specified RC2 cipher.
unwrap :: (BlockCipher cipher, ByteArray ba)
       => cipher -> ba -> Either StoreError ba
unwrap :: forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> Either StoreError ba
unwrap cipher
cipher ba
wrapped
    | Int
inLen forall a. Ord a => a -> a -> Bool
<= Int
16        = forall {b}. Either StoreError b
invalid
    | Int
inLen forall a. Integral a => a -> a -> a
`mod` Int
8 forall a. Eq a => a -> a -> Bool
/= Int
0 = forall {b}. Either StoreError b
invalid
    | Bool
checksumPadValid   = forall a b. b -> Either a b
Right ba
cek
    | Bool
otherwise          = forall {b}. Either StoreError b
invalid
  where
    inLen :: Int
inLen            = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
wrapped
    Just IV cipher
iv'         = forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV Bytes
iv4adda22c79e82105
    temp3 :: ba
temp3            = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt cipher
cipher IV cipher
iv' ba
wrapped
    temp2 :: ba
temp2            = forall ba. ByteArray ba => ba -> ba
reverseBytes ba
temp3
    (ba
ivBs, ba
temp1)    = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt Int
8 ba
temp2
    Just IV cipher
iv          = forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ba
ivBs
    lcekpadicv :: ba
lcekpadicv       = forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt cipher
cipher IV cipher
iv ba
temp1
    (ba
lcekpad, ba
icv)   = forall bs. ByteArray bs => Int -> bs -> (bs, bs)
B.splitAt (Int
inLen forall a. Num a => a -> a -> a
- Int
16) ba
lcekpadicv
    Just (Word8
l, ba
cekpad) = forall a. ByteArray a => a -> Maybe (Word8, a)
B.uncons ba
lcekpad
    len :: Int
len              = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
l
    padlen :: Int
padlen           = Int
inLen forall a. Num a => a -> a -> a
- Int
16 forall a. Num a => a -> a -> a
- Int
len forall a. Num a => a -> a -> a
- Int
1
    cek :: ba
cek              = forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
len ba
cekpad
    invalid :: Either StoreError b
invalid          = forall a b. a -> Either a b
Left StoreError
BadChecksum
    checksumPadValid :: Bool
checksumPadValid = forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
B.constEq ba
icv (forall ba. ByteArray ba => ba -> ba
checksum ba
lcekpad)
                           Bool -> Bool -> Bool
&&! Int
padlen forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&&! Int
padlen forall a. Ord a => a -> a -> Bool
< Int
8