module Z.Crypto.KDF (
KDFType(..)
, HashType(..)
, MACType(..)
, kdf
, kdf'
, PBKDFType(..)
, pbkdf
, pbkdfTimed
, kdfTypeToCBytes
, pbkdfTypeToParam
) where
import Z.Botan.Exception
import Z.Botan.FFI
import Z.Crypto.Hash (HashType (..), hashTypeToCBytes)
import Z.Crypto.MAC (MACType (..), macTypeToCBytes)
import Z.Data.CBytes (CBytes, withCBytes, withCBytesUnsafe)
import qualified Z.Data.CBytes as CB
import qualified Z.Data.Vector as V
import Z.Foreign
data KDFType
= HKDF MACType
| MACType
| HKDF_Expand MACType
| KDF2 HashType
| KDF1_18033 HashType
| KDF1 HashType
| TLS_PRF
| TLS_12_PRF MACType
| SP800_108_Counter MACType
| SP800_108_Feedback MACType
| SP800_108_Pipeline MACType
| SP800_56AHash HashType
| SP800_56AMAC MACType
| SP800_56C MACType
kdfTypeToCBytes :: KDFType -> CBytes
kdfTypeToCBytes :: KDFType -> CBytes
kdfTypeToCBytes (HKDF MACType
mt ) = [CBytes] -> CBytes
CB.concat [ CBytes
"HKDF(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (HKDF_Extract MACType
mt) = [CBytes] -> CBytes
CB.concat [ CBytes
"HKDF-Extract(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (HKDF_Expand MACType
mt ) = [CBytes] -> CBytes
CB.concat [ CBytes
"HKDF-Expand(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (KDF2 HashType
ht ) = [CBytes] -> CBytes
CB.concat [ CBytes
"KDF2(" , HashType -> CBytes
hashTypeToCBytes HashType
ht, CBytes
")"]
kdfTypeToCBytes (KDF1_18033 HashType
ht ) = [CBytes] -> CBytes
CB.concat [ CBytes
"KDF1-18033(" , HashType -> CBytes
hashTypeToCBytes HashType
ht, CBytes
")"]
kdfTypeToCBytes (KDF1 HashType
ht ) = [CBytes] -> CBytes
CB.concat [ CBytes
"KDF1(" , HashType -> CBytes
hashTypeToCBytes HashType
ht, CBytes
")"]
kdfTypeToCBytes (KDFType
TLS_PRF ) = CBytes
"TLS-PRF"
kdfTypeToCBytes (TLS_12_PRF MACType
mt ) = [CBytes] -> CBytes
CB.concat [ CBytes
"TLS-12-PRF(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (SP800_108_Counter MACType
mt ) = [CBytes] -> CBytes
CB.concat [ CBytes
"SP800-108-Counter(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (SP800_108_Feedback MACType
mt) = [CBytes] -> CBytes
CB.concat [ CBytes
"SP800-108-Feedback(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (SP800_108_Pipeline MACType
mt) = [CBytes] -> CBytes
CB.concat [ CBytes
"SP800-108-Pipeline(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (SP800_56AHash HashType
ht ) = [CBytes] -> CBytes
CB.concat [ CBytes
"SP800-56A(" , HashType -> CBytes
hashTypeToCBytes HashType
ht, CBytes
")"]
kdfTypeToCBytes (SP800_56AMAC MACType
mt ) = [CBytes] -> CBytes
CB.concat [ CBytes
"SP800-56A(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdfTypeToCBytes (SP800_56C MACType
mt ) = [CBytes] -> CBytes
CB.concat [ CBytes
"SP800-56C(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"]
kdf :: HasCallStack
=> KDFType
-> Int
-> V.Bytes
-> V.Bytes
-> V.Bytes
-> IO V.Bytes
{-# INLINABLE kdf #-}
kdf :: KDFType -> Int -> Bytes -> Bytes -> Bytes -> IO Bytes
kdf KDFType
algo Int
siz Bytes
secret Bytes
salt Bytes
label =
CBytes -> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe (KDFType -> CBytes
kdfTypeToCBytes KDFType
algo) ((BA# Word8 -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
algoBA ->
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
secret ((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
secretBA Int
secretOff Int
secretLen ->
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
salt ((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
saltBA Int
saltOff Int
saltLen ->
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
label ((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
labelBA Int
labelOff Int
labelLen ->
(Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (MBA# Word8 -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (MBA# Word8 -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
siz (\ MBA# Word8
buf -> do
MBA# Word8 -> Int -> IO ()
forall k (a :: k). MBA# Word8 -> Int -> IO ()
clearMBA MBA# Word8
buf Int
siz
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
BA# Word8
-> MBA# Word8
-> Int
-> BA# Word8
-> Int
-> Int
-> BA# Word8
-> Int
-> Int
-> BA# Word8
-> Int
-> Int
-> IO CInt
hs_botan_kdf BA# Word8
algoBA MBA# Word8
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
BA# Word8
secretBA Int
secretOff Int
secretLen
BA# Word8
saltBA Int
saltOff Int
saltLen
BA# Word8
labelBA Int
labelOff Int
labelLen)
kdf' :: HasCallStack
=> KDFType
-> Int
-> V.Bytes
-> IO V.Bytes
{-# INLINABLE kdf' #-}
kdf' :: KDFType -> Int -> Bytes -> IO Bytes
kdf' KDFType
algo Int
siz Bytes
secret = HasCallStack =>
KDFType -> Int -> Bytes -> Bytes -> Bytes -> IO Bytes
KDFType -> Int -> Bytes -> Bytes -> Bytes -> IO Bytes
kdf KDFType
algo Int
siz Bytes
secret Bytes
forall a. Monoid a => a
mempty Bytes
forall a. Monoid a => a
mempty
data PBKDFType
= PBKDF2 MACType Int
| Scrypt Int Int Int
| Argon2d Int Int Int
| Argon2i Int Int Int
| Argon2id Int Int Int
| Bcrypt Int
| OpenPGP_S2K HashType Int
pbkdfTypeToParam :: PBKDFType -> (CBytes, Int, Int, Int)
pbkdfTypeToParam :: PBKDFType -> (CBytes, Int, Int, Int)
pbkdfTypeToParam (PBKDF2 MACType
mt Int
i ) = ([CBytes] -> CBytes
CB.concat [ CBytes
"PBKDF2(" , MACType -> CBytes
macTypeToCBytes MACType
mt, CBytes
")"], Int
i, Int
0, Int
0)
pbkdfTypeToParam (Scrypt Int
n Int
r Int
p ) = (CBytes
"Scrypt", Int
n, Int
r, Int
p)
pbkdfTypeToParam (Argon2d Int
i Int
m Int
p ) = (CBytes
"Argon2d", Int
i, Int
m, Int
p)
pbkdfTypeToParam (Argon2i Int
i Int
m Int
p ) = (CBytes
"Argon2i", Int
i, Int
m, Int
p)
pbkdfTypeToParam (Argon2id Int
i Int
m Int
p ) = (CBytes
"Argon2id", Int
i, Int
m, Int
p)
pbkdfTypeToParam (Bcrypt Int
i ) = (CBytes
"Bcrypt-PBKDF", Int
i, Int
0, Int
0)
pbkdfTypeToParam (OpenPGP_S2K HashType
ht Int
i) = ([CBytes] -> CBytes
CB.concat [ CBytes
"OpenPGP-S2K(" , HashType -> CBytes
hashTypeToCBytes HashType
ht, CBytes
")"], Int
i, Int
0, Int
0)
pbkdf :: HasCallStack
=> PBKDFType
-> Int
-> CBytes
-> V.Bytes
-> IO V.Bytes
{-# INLINABLE pbkdf #-}
pbkdf :: PBKDFType -> Int -> CBytes -> Bytes -> IO Bytes
pbkdf PBKDFType
typ Int
siz CBytes
pwd Bytes
salt = do
CBytes -> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
algo ((BA# Word8 -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
algoBA ->
CBytes -> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
pwd ((BA# Word8 -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pwdBA ->
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
salt ((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
saltBA Int
saltOff Int
saltLen -> do
(Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (MBA# Word8 -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (MBA# Word8 -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
siz (\ MBA# Word8
buf -> do
MBA# Word8 -> Int -> IO ()
forall k (a :: k). MBA# Word8 -> Int -> IO ()
clearMBA MBA# Word8
buf Int
siz
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
BA# Word8
-> Int
-> Int
-> Int
-> MBA# Word8
-> Int
-> BA# Word8
-> Int
-> BA# Word8
-> Int
-> Int
-> IO CInt
hs_botan_pwdhash BA# Word8
algoBA
Int
i1 Int
i2 Int
i3
MBA# Word8
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
BA# Word8
pwdBA (CBytes -> Int
CB.length CBytes
pwd)
BA# Word8
saltBA Int
saltOff Int
saltLen)
where
(CBytes
algo, Int
i1, Int
i2, Int
i3) = PBKDFType -> (CBytes, Int, Int, Int)
pbkdfTypeToParam PBKDFType
typ
pbkdfTimed :: HasCallStack
=> PBKDFType
-> Int
-> Int
-> CBytes
-> V.Bytes
-> IO V.Bytes
{-# INLINABLE pbkdfTimed #-}
pbkdfTimed :: PBKDFType -> Int -> Int -> CBytes -> Bytes -> IO Bytes
pbkdfTimed PBKDFType
typ Int
msec Int
siz CBytes
pwd Bytes
s = do
if Int
msec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100
then CBytes -> (Ptr Word8 -> IO Bytes) -> IO Bytes
forall a. CBytes -> (Ptr Word8 -> IO a) -> IO a
withCBytes CBytes
algo ((Ptr Word8 -> IO Bytes) -> IO Bytes)
-> (Ptr Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
algo' ->
CBytes -> (Ptr Word8 -> IO Bytes) -> IO Bytes
forall a. CBytes -> (Ptr Word8 -> IO a) -> IO a
withCBytes CBytes
pwd ((Ptr Word8 -> IO Bytes) -> IO Bytes)
-> (Ptr Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pwd' ->
Bytes -> (Ptr Word8 -> Int -> IO Bytes) -> IO Bytes
forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
s ((Ptr Word8 -> Int -> IO Bytes) -> IO Bytes)
-> (Ptr Word8 -> Int -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
s' Int
sLen ->
(Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Ptr Word8 -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (Ptr a -> IO b) -> IO (PrimVector a, b)
allocPrimVectorSafe Int
siz (\ Ptr Word8
buf -> do
Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Int -> IO ()
clearPtr Ptr Word8
buf Int
siz
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Int
-> IO CInt
hs_botan_pwdhash_timed_safe
Ptr Word8
algo' Int
msec Ptr Word8
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
Ptr Word8
pwd' (CBytes -> Int
CB.length CBytes
pwd) Ptr Word8
s' Int
0 Int
sLen)
else CBytes -> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
algo ((BA# Word8 -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \BA# Word8
algo' ->
CBytes -> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
pwd ((BA# Word8 -> IO Bytes) -> IO Bytes)
-> (BA# Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pwd' ->
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
s ((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
s' Int
sOff Int
sLen ->
(Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (MBA# Word8 -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (MBA# Word8 -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
siz (\ MBA# Word8
buf -> do
MBA# Word8 -> Int -> IO ()
forall k (a :: k). MBA# Word8 -> Int -> IO ()
clearMBA MBA# Word8
buf Int
siz
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
BA# Word8
-> Int
-> MBA# Word8
-> Int
-> BA# Word8
-> Int
-> BA# Word8
-> Int
-> Int
-> IO CInt
hs_botan_pwdhash_timed
BA# Word8
algo' Int
msec MBA# Word8
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
BA# Word8
pwd' (CBytes -> Int
CB.length CBytes
pwd) BA# Word8
s' Int
sOff Int
sLen)
where
(CBytes
algo, Int
_, Int
_, Int
_) = PBKDFType -> (CBytes, Int, Int, Int)
pbkdfTypeToParam PBKDFType
typ