{-|
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 (
    -- * key wrap & unwrap
    keyWrap, keyUnwrap
    -- * re-export
  , module Z.Crypto.SafeMem
  ) where

import           Z.Botan.Exception
import           Z.Botan.FFI
import           Z.Crypto.SafeMem
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 :: HasCallStack
        => Secret   -- ^ key
        -> Secret   -- ^ kek
        -> IO V.Bytes
{-# INLINABLE keyWrap #-}
keyWrap :: Secret -> Secret -> IO Bytes
keyWrap Secret
key Secret
kek =
    Secret -> (Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
key ((Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes)
-> (Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
key' CSize
keyLen ->
    Secret -> (Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
kek ((Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes)
-> (Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
kek' CSize
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 (Secret -> Int
secretSize Secret
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
$
        Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> MBA# Word8
-> MBA# Word8
-> IO CInt
botan_key_wrap3394 Ptr Word8
key' CSize
keyLen Ptr Word8
kek' CSize
kekLen

-- | Unwrap a key wrapped with rfc3394_keywrap.
keyUnwrap :: HasCallStack
          => V.Bytes -- ^ wrapped key
          -> Secret -- ^ kek
          -> IO Secret
{-# INLINABLE keyUnwrap #-}
keyUnwrap :: Bytes -> Secret -> IO Secret
keyUnwrap Bytes
key Secret
kek =
    Bytes -> (BA# Word8 -> Int -> Int -> IO Secret) -> IO Secret
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
key ((BA# Word8 -> Int -> Int -> IO Secret) -> IO Secret)
-> (BA# Word8 -> Int -> Int -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
key' Int
keyOff Int
keyLen ->
    Secret -> (Ptr Word8 -> CSize -> IO Secret) -> IO Secret
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
kek ((Ptr Word8 -> CSize -> IO Secret) -> IO Secret)
-> (Ptr Word8 -> CSize -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
kek' CSize
kekLen ->
    let out_len :: Int
out_len = 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
    in Int -> (Ptr Word8 -> IO CInt) -> IO Secret
forall r. Int -> (Ptr Word8 -> IO r) -> IO Secret
newSecret Int
out_len ((Ptr Word8 -> IO CInt) -> IO Secret)
-> (Ptr Word8 -> IO CInt) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
out ->
        BA# Word8
-> Int
-> Int
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> IO CInt
hs_botan_key_unwrap3394 BA# Word8
key' Int
keyOff Int
keyLen Ptr Word8
kek' CSize
kekLen Ptr Word8
out (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
out_len)