{-|
Module      : Botan.Low.KeyWrap
Description : Bcrypt password hashing
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX

NIST specifies two mechanisms for wrapping (encrypting) symmetric keys
using another key. The first (and older, more widely supported) method
requires the input be a multiple of 8 bytes long. The other allows any
length input, though only up to 2**32 bytes.

These algorithms are described in NIST SP 800-38F, and RFCs 3394 and 5649.

These functions take an arbitrary 128-bit block cipher. NIST only allows
these functions with AES, but any 128-bit cipher will do and some other
implementations (such as in OpenSSL) do also allow other ciphers.

Use AES for best interop.
-}

module Botan.Low.KeyWrap
(

  nistKeyWrapEncode
, nistKeyWrapDecode

) where

import qualified Data.ByteString as ByteString

import Botan.Bindings.KeyWrap

import Botan.Low.BlockCipher
import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude

nistKeyWrapEncode
    :: BlockCipherName  -- ^ __cipher_algo__
    -> Int              -- ^ __padded__
    -> ByteString       -- ^ __key[]__
    -> ByteString       -- ^ __kek[]__
    -> IO ByteString    -- ^ __wrapped_key[]__
nistKeyWrapEncode :: BlockCipherName
-> Int -> BlockCipherName -> BlockCipherName -> IO BlockCipherName
nistKeyWrapEncode BlockCipherName
algo Int
padded BlockCipherName
key BlockCipherName
kek = BlockCipherName
-> (Ptr CChar -> IO BlockCipherName) -> IO BlockCipherName
forall a. BlockCipherName -> (Ptr CChar -> IO a) -> IO a
asCString BlockCipherName
algo ((Ptr CChar -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr CChar -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr -> do
    BlockCipherName
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall byte a.
BlockCipherName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen BlockCipherName
key ((Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
keyPtr CSize
keyLen -> do
        BlockCipherName
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall byte a.
BlockCipherName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen BlockCipherName
kek ((Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
kekPtr CSize
kekLen -> do
            (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO BlockCipherName
forall byte.
(Ptr byte -> Ptr CSize -> IO CInt) -> IO BlockCipherName
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO BlockCipherName)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
wrappedKeyPtr Ptr CSize
wrappedKeyLen -> ConstPtr CChar
-> CInt
-> ConstPtr Word8
-> CSize
-> ConstPtr Word8
-> CSize
-> Ptr Word8
-> Ptr CSize
-> IO CInt
botan_nist_kw_enc
                (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
algoPtr)
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padded)
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
keyPtr)
                CSize
keyLen
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
kekPtr)
                CSize
kekLen
                Ptr Word8
wrappedKeyPtr
                Ptr CSize
wrappedKeyLen

nistKeyWrapDecode
    :: BlockCipherName  -- ^ __cipher_algo__
    -> Int              -- ^ __padded__
    -> ByteString       -- ^ __wrapped_key[]__
    -> ByteString       -- ^ __kek[]__
    -> IO ByteString    -- ^ __key[]__
nistKeyWrapDecode :: BlockCipherName
-> Int -> BlockCipherName -> BlockCipherName -> IO BlockCipherName
nistKeyWrapDecode BlockCipherName
algo Int
padded BlockCipherName
wrappedKey BlockCipherName
kek = BlockCipherName
-> (Ptr CChar -> IO BlockCipherName) -> IO BlockCipherName
forall a. BlockCipherName -> (Ptr CChar -> IO a) -> IO a
asCString BlockCipherName
algo ((Ptr CChar -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr CChar -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr -> do
    BlockCipherName
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall byte a.
BlockCipherName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen BlockCipherName
wrappedKey ((Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
wrappedKeyPtr CSize
wrappedKeyLen -> do
        BlockCipherName
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall byte a.
BlockCipherName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen BlockCipherName
kek ((Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName)
-> (Ptr Word8 -> CSize -> IO BlockCipherName) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
kekPtr CSize
kekLen -> do
            (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO BlockCipherName
forall byte.
(Ptr byte -> Ptr CSize -> IO CInt) -> IO BlockCipherName
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO BlockCipherName)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO BlockCipherName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
keyPtr Ptr CSize
keyLen -> ConstPtr CChar
-> CInt
-> ConstPtr Word8
-> CSize
-> ConstPtr Word8
-> CSize
-> Ptr Word8
-> Ptr CSize
-> IO CInt
botan_nist_kw_dec
                (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
algoPtr)
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padded)
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
wrappedKeyPtr)
                CSize
wrappedKeyLen
                (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
kekPtr)
                CSize
kekLen
                Ptr Word8
keyPtr
                Ptr CSize
keyLen