module Botan.KeyWrap where

import qualified Botan.Low.KeyWrap as Low

import Botan.BlockCipher
import Botan.Prelude

-- NOTE: These friendlier names reflect the higher-level C++ interface names
--  as opposed to Botan.Low.KeyWrap and the C FFI names, but drop the 'nist'
--  prefix for even simpler nomenclature

type KWKey = ByteString
type KWPKey = ByteString

type KWWrappedKey = ByteString
type KWPWrappedKey = ByteString

keyWrap :: BlockCipher128 -> KWKey -> BlockCipher128Key -> IO KWWrappedKey
keyWrap :: BlockCipher128 -> KWKey -> KWKey -> IO KWKey
keyWrap BlockCipher128
bc = BlockCipher128 -> Bool -> KWKey -> KWKey -> IO KWKey
nistKeyWrapEncode BlockCipher128
bc Bool
False

keyUnwrap :: BlockCipher128 -> KWWrappedKey -> BlockCipher128Key -> IO KWKey
keyUnwrap :: BlockCipher128 -> KWKey -> KWKey -> IO KWKey
keyUnwrap BlockCipher128
bc = BlockCipher128 -> Bool -> KWKey -> KWKey -> IO KWKey
nistKeyWrapDecode BlockCipher128
bc Bool
False

keyWrapPadded :: BlockCipher128 -> KWPKey -> BlockCipher128Key -> IO KWPWrappedKey
keyWrapPadded :: BlockCipher128 -> KWKey -> KWKey -> IO KWKey
keyWrapPadded BlockCipher128
bc = BlockCipher128 -> Bool -> KWKey -> KWKey -> IO KWKey
nistKeyWrapEncode BlockCipher128
bc Bool
True

keyUnwrapPadded :: BlockCipher128 -> KWPWrappedKey -> BlockCipher128Key -> IO KWPKey
keyUnwrapPadded :: BlockCipher128 -> KWKey -> KWKey -> IO KWKey
keyUnwrapPadded BlockCipher128
bc = BlockCipher128 -> Bool -> KWKey -> KWKey -> IO KWKey
nistKeyWrapDecode BlockCipher128
bc Bool
True

-- NOTE: The Botan FFI conflates the unpadded and padded key wrap functions using the
--  int / bool flag to select which.
--  I feel it best to split them, but here we can provide a form consistent with the FFI

nistKeyWrapEncode :: BlockCipher128 -> Bool -> ByteString -> ByteString -> IO ByteString
nistKeyWrapEncode :: BlockCipher128 -> Bool -> KWKey -> KWKey -> IO KWKey
nistKeyWrapEncode BlockCipher128
bc Bool
padded = KWKey -> Int -> KWKey -> KWKey -> IO KWKey
Low.nistKeyWrapEncode (BlockCipher128 -> KWKey
blockCipher128Name BlockCipher128
bc) (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
padded)

nistKeyWrapDecode :: BlockCipher128 -> Bool -> ByteString -> ByteString -> IO ByteString
nistKeyWrapDecode :: BlockCipher128 -> Bool -> KWKey -> KWKey -> IO KWKey
nistKeyWrapDecode BlockCipher128
bc Bool
padded = KWKey -> Int -> KWKey -> KWKey -> IO KWKey
Low.nistKeyWrapDecode (BlockCipher128 -> KWKey
blockCipher128Name BlockCipher128
bc) (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
padded)