{-|
Module      : Z.Crypto.KeyWrap
Description : AES Key Wrapping
Copyright   : AnJie Dong, Dong Han, 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides RFC3394 key Wrapping. It uses a 128-bit, 192-bit, or 256-bit key to encrypt an input key. AES is always used. The input must be a multiple of 8 bytes; if not an exception is thrown.

-}
module Z.Crypto.KeyWrap where

import           Z.Botan.FFI
import qualified Z.Data.Vector as V
import           Z.Foreign

-- | Wrap the input key using kek (the key encryption key), and return the result. It will be 8 bytes longer than the input key.
keyWrap :: V.Bytes -- ^ key
        -> V.Bytes -- ^ kek
        -> IO V.Bytes
{-# INLINABLE keyWrap #-}
keyWrap :: Bytes -> Bytes -> IO Bytes
keyWrap Bytes
key Bytes
kek =
    Bytes -> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
key ((BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
key' Int
keyOff Int
keyLen ->
    Bytes -> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
kek ((BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
kek' Int
kekOff Int
kekLen ->
    Int -> (MBA# Word8 -> MBA# Word8 -> IO CInt) -> IO Bytes
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# Word8 -> MBA# Word8 -> IO r) -> IO Bytes
allocBotanBufferUnsafe (Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
key Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) ((MBA# Word8 -> MBA# Word8 -> IO CInt) -> IO Bytes)
-> (MBA# Word8 -> MBA# Word8 -> IO CInt) -> IO Bytes
forall a b. (a -> b) -> a -> b
$
        BA# Word8
-> Int
-> Int
-> BA# Word8
-> Int
-> Int
-> MBA# Word8
-> MBA# Word8
-> IO CInt
hs_botan_key_wrap3394 BA# Word8
key' Int
keyOff Int
keyLen BA# Word8
kek' Int
kekOff Int
kekLen

-- | Unwrap a key wrapped with rfc3394_keywrap.
keyUnwrap :: V.Bytes -- ^ wrapped key
          -> V.Bytes -- ^ kek
          -> IO V.Bytes
{-# INLINABLE keyUnwrap #-}
keyUnwrap :: Bytes -> Bytes -> IO Bytes
keyUnwrap Bytes
key Bytes
kek =
    Bytes -> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
key ((BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
key' Int
keyOff Int
keyLen ->
    Bytes -> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
kek ((BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> Int -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
kek' Int
kekOff Int
kekLen ->
    Int -> (MBA# Word8 -> MBA# Word8 -> IO CInt) -> IO Bytes
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# Word8 -> MBA# Word8 -> IO r) -> IO Bytes
allocBotanBufferUnsafe (Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
key Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) ((MBA# Word8 -> MBA# Word8 -> IO CInt) -> IO Bytes)
-> (MBA# Word8 -> MBA# Word8 -> IO CInt) -> IO Bytes
forall a b. (a -> b) -> a -> b
$
        BA# Word8
-> Int
-> Int
-> BA# Word8
-> Int
-> Int
-> MBA# Word8
-> MBA# Word8
-> IO CInt
hs_botan_key_unwrap3394 BA# Word8
key' Int
keyOff Int
keyLen BA# Word8
kek' Int
kekOff Int
kekLen