module Z.Crypto.KDF (
KDFType(..)
, HashType(..)
, MACType(..)
, kdf
, kdf'
, PBKDFType(..)
, pbkdf
, pbkdfTimed
, kdfTypeToCBytes
, pbkdfTypeToParam
, module Z.Crypto.SafeMem
) where
import GHC.Generics
import Z.Botan.Exception
import Z.Botan.FFI
import Z.Crypto.Hash (HashType (..), hashTypeToCBytes)
import Z.Crypto.MAC (MACType (..), macTypeToCBytes)
import Z.Crypto.SafeMem
import Z.Data.CBytes (CBytes, withCBytes, withCBytesUnsafe)
import qualified Z.Data.CBytes as CB
import Z.Data.JSON (JSON)
import qualified Z.Data.Text as T
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
deriving (Int -> KDFType -> ShowS
[KDFType] -> ShowS
KDFType -> String
(Int -> KDFType -> ShowS)
-> (KDFType -> String) -> ([KDFType] -> ShowS) -> Show KDFType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KDFType] -> ShowS
$cshowList :: [KDFType] -> ShowS
show :: KDFType -> String
$cshow :: KDFType -> String
showsPrec :: Int -> KDFType -> ShowS
$cshowsPrec :: Int -> KDFType -> ShowS
Show, ReadPrec [KDFType]
ReadPrec KDFType
Int -> ReadS KDFType
ReadS [KDFType]
(Int -> ReadS KDFType)
-> ReadS [KDFType]
-> ReadPrec KDFType
-> ReadPrec [KDFType]
-> Read KDFType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KDFType]
$creadListPrec :: ReadPrec [KDFType]
readPrec :: ReadPrec KDFType
$creadPrec :: ReadPrec KDFType
readList :: ReadS [KDFType]
$creadList :: ReadS [KDFType]
readsPrec :: Int -> ReadS KDFType
$creadsPrec :: Int -> ReadS KDFType
Read, KDFType -> KDFType -> Bool
(KDFType -> KDFType -> Bool)
-> (KDFType -> KDFType -> Bool) -> Eq KDFType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KDFType -> KDFType -> Bool
$c/= :: KDFType -> KDFType -> Bool
== :: KDFType -> KDFType -> Bool
$c== :: KDFType -> KDFType -> Bool
Eq, Eq KDFType
Eq KDFType
-> (KDFType -> KDFType -> Ordering)
-> (KDFType -> KDFType -> Bool)
-> (KDFType -> KDFType -> Bool)
-> (KDFType -> KDFType -> Bool)
-> (KDFType -> KDFType -> Bool)
-> (KDFType -> KDFType -> KDFType)
-> (KDFType -> KDFType -> KDFType)
-> Ord KDFType
KDFType -> KDFType -> Bool
KDFType -> KDFType -> Ordering
KDFType -> KDFType -> KDFType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KDFType -> KDFType -> KDFType
$cmin :: KDFType -> KDFType -> KDFType
max :: KDFType -> KDFType -> KDFType
$cmax :: KDFType -> KDFType -> KDFType
>= :: KDFType -> KDFType -> Bool
$c>= :: KDFType -> KDFType -> Bool
> :: KDFType -> KDFType -> Bool
$c> :: KDFType -> KDFType -> Bool
<= :: KDFType -> KDFType -> Bool
$c<= :: KDFType -> KDFType -> Bool
< :: KDFType -> KDFType -> Bool
$c< :: KDFType -> KDFType -> Bool
compare :: KDFType -> KDFType -> Ordering
$ccompare :: KDFType -> KDFType -> Ordering
$cp1Ord :: Eq KDFType
Ord, (forall x. KDFType -> Rep KDFType x)
-> (forall x. Rep KDFType x -> KDFType) -> Generic KDFType
forall x. Rep KDFType x -> KDFType
forall x. KDFType -> Rep KDFType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KDFType x -> KDFType
$cfrom :: forall x. KDFType -> Rep KDFType x
Generic)
deriving anyclass (Int -> KDFType -> Builder ()
(Int -> KDFType -> Builder ()) -> Print KDFType
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> KDFType -> Builder ()
$ctoUTF8BuilderP :: Int -> KDFType -> Builder ()
T.Print, Value -> Converter KDFType
KDFType -> Value
KDFType -> Builder ()
(Value -> Converter KDFType)
-> (KDFType -> Value) -> (KDFType -> Builder ()) -> JSON KDFType
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: KDFType -> Builder ()
$cencodeJSON :: KDFType -> Builder ()
toValue :: KDFType -> Value
$ctoValue :: KDFType -> Value
fromValue :: Value -> Converter KDFType
$cfromValue :: Value -> Converter KDFType
JSON)
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
-> Secret
-> V.Bytes
-> V.Bytes
-> IO Secret
{-# INLINABLE kdf #-}
kdf :: KDFType -> Int -> Secret -> Bytes -> Bytes -> IO Secret
kdf KDFType
algo Int
siz Secret
secret Bytes
salt Bytes
label =
CBytes -> (BA# Word8 -> IO Secret) -> IO Secret
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe (KDFType -> CBytes
kdfTypeToCBytes KDFType
algo) ((BA# Word8 -> IO Secret) -> IO Secret)
-> (BA# Word8 -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
algoBA ->
Secret -> (Ptr Word8 -> CSize -> IO Secret) -> IO Secret
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
secret ((Ptr Word8 -> CSize -> IO Secret) -> IO Secret)
-> (Ptr Word8 -> CSize -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
psecret CSize
secretLen ->
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
salt ((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
saltBA Int
saltOff Int
saltLen ->
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
label ((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
labelBA Int
labelOff Int
labelLen ->
Int -> (Ptr Word8 -> IO ()) -> IO Secret
forall r. Int -> (Ptr Word8 -> IO r) -> IO Secret
newSecret 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
$
BA# Word8
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> BA# Word8
-> Int
-> Int
-> BA# Word8
-> Int
-> Int
-> IO CInt
hs_botan_kdf BA# Word8
algoBA Ptr Word8
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
Ptr Word8
psecret CSize
secretLen
BA# Word8
saltBA Int
saltOff Int
saltLen
BA# Word8
labelBA Int
labelOff Int
labelLen)
kdf' :: HasCallStack
=> KDFType
-> Int
-> Secret
-> IO Secret
{-# INLINABLE kdf' #-}
kdf' :: KDFType -> Int -> Secret -> IO Secret
kdf' KDFType
algo Int
siz Secret
secret = HasCallStack =>
KDFType -> Int -> Secret -> Bytes -> Bytes -> IO Secret
KDFType -> Int -> Secret -> Bytes -> Bytes -> IO Secret
kdf KDFType
algo Int
siz Secret
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
-> Password
-> V.Bytes
-> IO Secret
{-# INLINABLE pbkdf #-}
pbkdf :: PBKDFType -> Int -> Password -> Bytes -> IO Secret
pbkdf PBKDFType
typ Int
siz Password
pwd Bytes
salt = do
CBytes -> (BA# Word8 -> IO Secret) -> IO Secret
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
algo ((BA# Word8 -> IO Secret) -> IO Secret)
-> (BA# Word8 -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
algoBA ->
Password -> (BA# Word8 -> IO Secret) -> IO Secret
forall r. Password -> (BA# Word8 -> IO r) -> IO r
withPasswordUnsafe Password
pwd ((BA# Word8 -> IO Secret) -> IO Secret)
-> (BA# Word8 -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pwdBA ->
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
salt ((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
saltBA Int
saltOff Int
saltLen -> do
Int -> (Ptr Word8 -> IO ()) -> IO Secret
forall r. Int -> (Ptr Word8 -> IO r) -> IO Secret
newSecret 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
$
BA# Word8
-> Int
-> Int
-> Int
-> Ptr Word8
-> Int
-> BA# Word8
-> Int
-> BA# Word8
-> Int
-> Int
-> IO CInt
hs_botan_pwdhash BA# Word8
algoBA
Int
i1 Int
i2 Int
i3
Ptr Word8
buf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
BA# Word8
pwdBA (Password -> Int
passwordSize Password
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 Secret
{-# INLINABLE pbkdfTimed #-}
pbkdfTimed :: PBKDFType -> Int -> Int -> CBytes -> Bytes -> IO Secret
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 Secret) -> IO Secret
forall a. CBytes -> (Ptr Word8 -> IO a) -> IO a
withCBytes CBytes
algo ((Ptr Word8 -> IO Secret) -> IO Secret)
-> (Ptr Word8 -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
algo' ->
CBytes -> (Ptr Word8 -> IO Secret) -> IO Secret
forall a. CBytes -> (Ptr Word8 -> IO a) -> IO a
withCBytes CBytes
pwd ((Ptr Word8 -> IO Secret) -> IO Secret)
-> (Ptr Word8 -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pwd' ->
Bytes -> (Ptr Word8 -> Int -> IO Secret) -> IO Secret
forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
s ((Ptr Word8 -> Int -> IO Secret) -> IO Secret)
-> (Ptr Word8 -> Int -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
s' Int
sLen ->
Int -> (Ptr Word8 -> IO ()) -> IO Secret
forall r. Int -> (Ptr Word8 -> IO r) -> IO Secret
newSecret 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 Secret) -> IO Secret
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
algo ((BA# Word8 -> IO Secret) -> IO Secret)
-> (BA# Word8 -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \BA# Word8
algo' ->
CBytes -> (BA# Word8 -> IO Secret) -> IO Secret
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
pwd ((BA# Word8 -> IO Secret) -> IO Secret)
-> (BA# Word8 -> IO Secret) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pwd' ->
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
s ((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
s' Int
sOff Int
sLen ->
Int -> (Ptr Word8 -> IO ()) -> IO Secret
forall r. Int -> (Ptr Word8 -> IO r) -> IO Secret
newSecret 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
$
BA# Word8
-> Int
-> Ptr Word8
-> Int
-> BA# Word8
-> Int
-> BA# Word8
-> Int
-> Int
-> IO CInt
hs_botan_pwdhash_timed
BA# Word8
algo' Int
msec Ptr 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