module Botan.MAC
(
MAC(..)
, macs
, MACKeySpec
, MACKey(..)
, newMACKey
, newMACKeyMaybe
, MACDigest(..)
, macName
, macKeySpec
, macDigestLength
, mac
, gmac
, macLazy
, MutableMAC(..)
, destroyMAC
, newMAC
, getMACName
, getMACKeySpec
, getMACDigestLength
, setMACKey
, GMACNonce(..)
, setGMACNonce
, clearMAC
, updateMAC
, finalizeMAC
, updateFinalizeMAC
, updateFinalizeClearMAC
, cmac
, hmac
, poly1305
, sipHash
, x9_19_mac
) where
import Data.Foldable
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString as ByteString
import qualified Botan.Low.MAC as Low
import Botan.BlockCipher
import Botan.KeySpec
import Botan.Hash
import Botan.RNG
import Botan.Prelude
import Botan.Error (SomeBotanException(SomeBotanException))
import qualified Botan.Bindings.MAC as Low
data MAC
= CMAC BlockCipher
| GMAC BlockCipher
| HMAC CryptoHash
| Poly1305
| SipHash Int Int
| X9_19_MAC
deriving (MAC -> MAC -> Bool
(MAC -> MAC -> Bool) -> (MAC -> MAC -> Bool) -> Eq MAC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MAC -> MAC -> Bool
== :: MAC -> MAC -> Bool
$c/= :: MAC -> MAC -> Bool
/= :: MAC -> MAC -> Bool
Eq, Int -> MAC -> ShowS
[MAC] -> ShowS
MAC -> String
(Int -> MAC -> ShowS)
-> (MAC -> String) -> ([MAC] -> ShowS) -> Show MAC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MAC -> ShowS
showsPrec :: Int -> MAC -> ShowS
$cshow :: MAC -> String
show :: MAC -> String
$cshowList :: [MAC] -> ShowS
showList :: [MAC] -> ShowS
Show)
macs :: [MAC]
macs = [[MAC]] -> [MAC]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ BlockCipher -> MAC
CMAC BlockCipher
bc | BlockCipher
bc <- [BlockCipher]
blockCiphers ]
, [ BlockCipher -> MAC
GMAC BlockCipher
bc | BlockCipher
bc <- [BlockCipher]
blockCiphers ]
, [ CryptoHash -> MAC
HMAC CryptoHash
h | CryptoHash
h <- [CryptoHash]
cryptoHashes ]
, [ MAC
Poly1305
, Int -> Int -> MAC
SipHash Int
2 Int
4
, MAC
X9_19_MAC
]
]
type MACKeySpec = KeySpec
type MACKey = ByteString
newMACKey :: (MonadRandomIO m) => MAC -> m MACKey
newMACKey :: forall (m :: * -> *). MonadRandomIO m => MAC -> m MACKey
newMACKey = KeySpec -> m MACKey
forall (m :: * -> *). MonadRandomIO m => KeySpec -> m MACKey
newKey (KeySpec -> m MACKey) -> (MAC -> KeySpec) -> MAC -> m MACKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MAC -> KeySpec
macKeySpec
newMACKeyMaybe :: (MonadRandomIO m) => Int -> MAC -> m (Maybe MACKey)
newMACKeyMaybe :: forall (m :: * -> *).
MonadRandomIO m =>
Int -> MAC -> m (Maybe MACKey)
newMACKeyMaybe Int
sz MAC
bc = Int -> KeySpec -> m (Maybe MACKey)
forall (m :: * -> *).
MonadRandomIO m =>
Int -> KeySpec -> m (Maybe MACKey)
newKeyMaybe Int
sz (MAC -> KeySpec
macKeySpec MAC
bc)
type MACDigest = ByteString
macName :: MAC -> ByteString
macName :: MAC -> MACKey
macName (CMAC BlockCipher
bc) = MACKey -> MACKey
Low.cmac (BlockCipher -> MACKey
blockCipherName BlockCipher
bc)
macName (GMAC BlockCipher
bc) = MACKey -> MACKey
Low.gmac (BlockCipher -> MACKey
blockCipherName BlockCipher
bc)
macName (HMAC CryptoHash
h) = MACKey -> MACKey
Low.hmac (Hash -> MACKey
hashName (CryptoHash -> Hash
unCryptoHash CryptoHash
h))
macName MAC
Poly1305 = MACKey
Low.Poly1305
macName (SipHash Int
ir Int
fr) = Int -> Int -> MACKey
Low.sipHash Int
ir Int
fr
macName MAC
X9_19_MAC = MACKey
Low.X9_19_MAC
macKeySpec :: MAC -> KeySpec
macKeySpec :: MAC -> KeySpec
macKeySpec (CMAC BlockCipher
bc) = BlockCipher -> KeySpec
blockCipherKeySpec BlockCipher
bc
macKeySpec (GMAC BlockCipher
bc) = BlockCipher -> KeySpec
blockCipherKeySpec BlockCipher
bc
macKeySpec (HMAC CryptoHash
h) = Int -> Int -> Int -> KeySpec
keySpec Int
0 Int
4096 Int
1
macKeySpec MAC
Poly1305 = Int -> Int -> Int -> KeySpec
keySpec Int
32 Int
32 Int
1
macKeySpec (SipHash Int
2 Int
4) = Int -> Int -> Int -> KeySpec
keySpec Int
16 Int
16 Int
1
macKeySpec MAC
X9_19_MAC = Int -> Int -> Int -> KeySpec
keySpec Int
8 Int
16 Int
8
macDigestLength :: MAC -> Int
macDigestLength :: MAC -> Int
macDigestLength (CMAC BlockCipher
bc) = BlockCipher -> Int
blockCipherBlockSize BlockCipher
bc
macDigestLength (GMAC BlockCipher
_) = Int
16
macDigestLength (HMAC CryptoHash
h) = Hash -> Int
hashDigestSize (CryptoHash -> Hash
unCryptoHash CryptoHash
h)
macDigestLength MAC
Poly1305 = Int
16
macDigestLength (SipHash Int
2 Int
4) = Int
8
macDigestLength MAC
X9_19_MAC = Int
8
mac :: MAC -> MACKey -> ByteString -> Maybe MACDigest
mac :: MAC -> MACKey -> MACKey -> Maybe MACKey
mac MAC
m MACKey
k MACKey
msg = IO (Maybe MACKey) -> Maybe MACKey
forall a. IO a -> a
unsafePerformIO (IO (Maybe MACKey) -> Maybe MACKey)
-> IO (Maybe MACKey) -> Maybe MACKey
forall a b. (a -> b) -> a -> b
$ do
MutableMAC
mm <- MAC -> IO MutableMAC
forall (m :: * -> *). MonadIO m => MAC -> m MutableMAC
newMAC MAC
m
Bool
wasSet <- MACKey -> MutableMAC -> IO Bool
forall (m :: * -> *). MonadIO m => MACKey -> MutableMAC -> m Bool
setMACKey MACKey
k MutableMAC
mm
if Bool
wasSet
then MACKey -> Maybe MACKey
forall a. a -> Maybe a
Just (MACKey -> Maybe MACKey) -> IO MACKey -> IO (Maybe MACKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableMAC -> MACKey -> IO MACKey
forall (m :: * -> *). MonadIO m => MutableMAC -> MACKey -> m MACKey
updateFinalizeClearMAC MutableMAC
mm MACKey
msg
else Maybe MACKey -> IO (Maybe MACKey)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MACKey
forall a. Maybe a
Nothing
{-# NOINLINE mac #-}
macLazy :: MAC -> MACKey -> Lazy.ByteString -> Maybe MACDigest
macLazy :: MAC -> MACKey -> ByteString -> Maybe MACKey
macLazy = MAC -> MACKey -> ByteString -> Maybe MACKey
forall a. HasCallStack => a
undefined
gmac :: MAC -> MACKey -> GMACNonce -> ByteString -> Maybe MACDigest
gmac :: MAC -> MACKey -> MACKey -> MACKey -> Maybe MACKey
gmac m :: MAC
m@(GMAC BlockCipher
_) MACKey
k MACKey
n MACKey
msg = IO (Maybe MACKey) -> Maybe MACKey
forall a. IO a -> a
unsafePerformIO (IO (Maybe MACKey) -> Maybe MACKey)
-> IO (Maybe MACKey) -> Maybe MACKey
forall a b. (a -> b) -> a -> b
$ do
MutableMAC
mm <- MAC -> IO MutableMAC
forall (m :: * -> *). MonadIO m => MAC -> m MutableMAC
newMAC MAC
m
Bool
wasSet <- MACKey -> MutableMAC -> IO Bool
forall (m :: * -> *). MonadIO m => MACKey -> MutableMAC -> m Bool
setMACKey MACKey
k MutableMAC
mm
if Bool
wasSet
then do
MACKey -> MutableMAC -> IO ()
forall (m :: * -> *). MonadIO m => MACKey -> MutableMAC -> m ()
setGMACNonce MACKey
n MutableMAC
mm
MACKey -> Maybe MACKey
forall a. a -> Maybe a
Just (MACKey -> Maybe MACKey) -> IO MACKey -> IO (Maybe MACKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableMAC -> MACKey -> IO MACKey
forall (m :: * -> *). MonadIO m => MutableMAC -> MACKey -> m MACKey
updateFinalizeClearMAC MutableMAC
mm MACKey
msg
else Maybe MACKey -> IO (Maybe MACKey)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MACKey
forall a. Maybe a
Nothing
gmac MAC
_ MACKey
_ MACKey
_ MACKey
_ = String -> Maybe MACKey
forall a. HasCallStack => String -> a
error String
"Expected GMAC"
{-# NOINLINE gmac #-}
data MutableMAC = MkMutableMAC
{ MutableMAC -> MAC
mutableMACType :: MAC
, MutableMAC -> MAC
mutableMACCtx :: Low.MAC
}
destroyMAC
:: (MonadIO m)
=> MutableMAC
-> m ()
destroyMAC :: forall (m :: * -> *). MonadIO m => MutableMAC -> m ()
destroyMAC = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (MutableMAC -> IO ()) -> MutableMAC -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MAC -> IO ()
Low.macDestroy (MAC -> IO ()) -> (MutableMAC -> MAC) -> MutableMAC -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableMAC -> MAC
mutableMACCtx
newMAC
:: (MonadIO m)
=> MAC
-> m MutableMAC
newMAC :: forall (m :: * -> *). MonadIO m => MAC -> m MutableMAC
newMAC MAC
h = do
MAC
ctx <- IO MAC -> m MAC
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MAC -> m MAC) -> IO MAC -> m MAC
forall a b. (a -> b) -> a -> b
$ MACKey -> IO MAC
Low.macInit (MACKey -> IO MAC) -> MACKey -> IO MAC
forall a b. (a -> b) -> a -> b
$ MAC -> MACKey
macName MAC
h
MutableMAC -> m MutableMAC
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutableMAC -> m MutableMAC) -> MutableMAC -> m MutableMAC
forall a b. (a -> b) -> a -> b
$ MAC -> MAC -> MutableMAC
MkMutableMAC MAC
h MAC
ctx
getMACName
:: (MonadIO m)
=> MutableMAC
-> m Low.MACName
getMACName :: forall (m :: * -> *). MonadIO m => MutableMAC -> m MACKey
getMACName = IO MACKey -> m MACKey
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MACKey -> m MACKey)
-> (MutableMAC -> IO MACKey) -> MutableMAC -> m MACKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MAC -> IO MACKey
Low.macName (MAC -> IO MACKey)
-> (MutableMAC -> MAC) -> MutableMAC -> IO MACKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableMAC -> MAC
mutableMACCtx
getMACKeySpec
:: (MonadIO m)
=> MutableMAC
-> m MACKeySpec
getMACKeySpec :: forall (m :: * -> *). MonadIO m => MutableMAC -> m KeySpec
getMACKeySpec MutableMAC
mm = do
(Int
mn,Int
mx,Int
md) <- IO (Int, Int, Int) -> m (Int, Int, Int)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int, Int) -> m (Int, Int, Int))
-> IO (Int, Int, Int) -> m (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ MAC -> IO (Int, Int, Int)
Low.macGetKeyspec (MutableMAC -> MAC
mutableMACCtx MutableMAC
mm)
KeySpec -> m KeySpec
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeySpec -> m KeySpec) -> KeySpec -> m KeySpec
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> KeySpec
keySpec Int
mn Int
mx Int
md
getMACDigestLength
:: (MonadIO m)
=> MutableMAC
-> m Int
getMACDigestLength :: forall (m :: * -> *). MonadIO m => MutableMAC -> m Int
getMACDigestLength = IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> (MutableMAC -> IO Int) -> MutableMAC -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MAC -> IO Int
Low.macOutputLength (MAC -> IO Int) -> (MutableMAC -> MAC) -> MutableMAC -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableMAC -> MAC
mutableMACCtx
setMACKey
:: (MonadIO m)
=> MACKey
-> MutableMAC
-> m Bool
setMACKey :: forall (m :: * -> *). MonadIO m => MACKey -> MutableMAC -> m Bool
setMACKey MACKey
k MutableMAC
mm = do
Bool
valid <- Int -> KeySpec -> Bool
keySizeIsValid (MACKey -> Int
ByteString.length MACKey
k) (KeySpec -> Bool) -> m KeySpec -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableMAC -> m KeySpec
forall (m :: * -> *). MonadIO m => MutableMAC -> m KeySpec
getMACKeySpec MutableMAC
mm
if Bool
valid
then do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MAC -> MACKey -> IO ()
Low.macSetKey (MutableMAC -> MAC
mutableMACCtx MutableMAC
mm) MACKey
k
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
type GMACNonce = ByteString
setGMACNonce
:: (MonadIO m)
=> GMACNonce
-> MutableMAC
-> m ()
setGMACNonce :: forall (m :: * -> *). MonadIO m => MACKey -> MutableMAC -> m ()
setGMACNonce MACKey
n mm :: MutableMAC
mm@(MkMutableMAC (GMAC BlockCipher
_) MAC
ctx) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MAC -> MACKey -> IO ()
Low.macSetNonce MAC
ctx MACKey
n
setGMACNonce MACKey
_ MutableMAC
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
clearMAC
:: (MonadIO m)
=> MutableMAC
-> m ()
clearMAC :: forall (m :: * -> *). MonadIO m => MutableMAC -> m ()
clearMAC = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (MutableMAC -> IO ()) -> MutableMAC -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MAC -> IO ()
Low.macClear (MAC -> IO ()) -> (MutableMAC -> MAC) -> MutableMAC -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableMAC -> MAC
mutableMACCtx
updateMAC
:: (MonadIO m)
=> MutableMAC
-> ByteString
-> m ()
updateMAC :: forall (m :: * -> *). MonadIO m => MutableMAC -> MACKey -> m ()
updateMAC MutableMAC
m MACKey
bs = MutableMAC -> [MACKey] -> m ()
forall (m :: * -> *). MonadIO m => MutableMAC -> [MACKey] -> m ()
updateMACChunks MutableMAC
m [MACKey
bs]
updateMACChunks
:: (MonadIO m)
=> MutableMAC
-> [ByteString]
-> m ()
updateMACChunks :: forall (m :: * -> *). MonadIO m => MutableMAC -> [MACKey] -> m ()
updateMACChunks MutableMAC
mm [MACKey]
chunks = let ctx :: MAC
ctx = MutableMAC -> MAC
mutableMACCtx MutableMAC
mm in
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (MACKey -> IO ()) -> [MACKey] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (MAC -> MACKey -> IO ()
Low.macUpdate MAC
ctx) [MACKey]
chunks
finalizeMAC
:: (MonadIO m)
=> MutableMAC
-> m MACDigest
finalizeMAC :: forall (m :: * -> *). MonadIO m => MutableMAC -> m MACKey
finalizeMAC = IO MACKey -> m MACKey
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MACKey -> m MACKey)
-> (MutableMAC -> IO MACKey) -> MutableMAC -> m MACKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MAC -> IO MACKey
Low.macFinal (MAC -> IO MACKey)
-> (MutableMAC -> MAC) -> MutableMAC -> IO MACKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableMAC -> MAC
mutableMACCtx
updateFinalizeMAC
:: (MonadIO m)
=> MutableMAC
-> ByteString
-> m MACDigest
updateFinalizeMAC :: forall (m :: * -> *). MonadIO m => MutableMAC -> MACKey -> m MACKey
updateFinalizeMAC MutableMAC
mm MACKey
bs = IO MACKey -> m MACKey
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MACKey -> m MACKey) -> IO MACKey -> m MACKey
forall a b. (a -> b) -> a -> b
$ do
MutableMAC -> MACKey -> IO ()
forall (m :: * -> *). MonadIO m => MutableMAC -> MACKey -> m ()
updateMAC MutableMAC
mm MACKey
bs
MutableMAC -> IO MACKey
forall (m :: * -> *). MonadIO m => MutableMAC -> m MACKey
finalizeMAC MutableMAC
mm
updateFinalizeClearMAC
:: (MonadIO m)
=> MutableMAC
-> ByteString
-> m MACDigest
updateFinalizeClearMAC :: forall (m :: * -> *). MonadIO m => MutableMAC -> MACKey -> m MACKey
updateFinalizeClearMAC MutableMAC
mm MACKey
bs = MutableMAC -> MACKey -> m MACKey
forall (m :: * -> *). MonadIO m => MutableMAC -> MACKey -> m MACKey
updateFinalizeMAC MutableMAC
mm MACKey
bs m MACKey -> m () -> m MACKey
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MutableMAC -> m ()
forall (m :: * -> *). MonadIO m => MutableMAC -> m ()
clearMAC MutableMAC
mm
cmac :: BlockCipher -> MAC
cmac :: BlockCipher -> MAC
cmac = BlockCipher -> MAC
CMAC
hmac :: CryptoHash -> MAC
hmac :: CryptoHash -> MAC
hmac = CryptoHash -> MAC
HMAC
poly1305 :: MAC
poly1305 :: MAC
poly1305 = MAC
Poly1305
sipHash :: MAC
sipHash :: MAC
sipHash = Int -> Int -> MAC
sipHashWith Int
2 Int
4
sipHashWith :: Int -> Int -> MAC
sipHashWith :: Int -> Int -> MAC
sipHashWith Int
r Int
f = Int -> Int -> MAC
SipHash Int
r Int
f
x9_19_mac :: MAC
x9_19_mac :: MAC
x9_19_mac = MAC
X9_19_MAC