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

Derive a key from a passphrase
-}

module Botan.Low.PwdHash
(

-- * Password hashing

  PBKDFName(..)
, pwdhash
, pwdhashTimed

-- * Password hashing algorithms

, pattern PBKDF2
, pbkdf2
, pattern Scrypt
, pattern Argon2d
, pattern Argon2i
, pattern Argon2id
, pattern Bcrypt_PBKDF
, pattern OpenPGP_S2K
, openPGP_S2K
    
) where

import qualified Data.ByteString as ByteString

import Botan.Bindings.PwdHash

import Botan.Low.Hash
import Botan.Low.MAC
import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude

type PBKDFName = ByteString

pattern PBKDF2
    ,   Scrypt
    ,   Argon2d
    ,   Argon2i
    ,   Argon2id
    ,   Bcrypt_PBKDF
    ,   OpenPGP_S2K
    :: PBKDFName

pattern $mPBKDF2 :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
$bPBKDF2 :: PBKDFName
PBKDF2 = BOTAN_PBKDF_PBKDF2
pattern $mScrypt :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
$bScrypt :: PBKDFName
Scrypt = BOTAN_PBKDF_SCRYPT
pattern $mArgon2d :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
$bArgon2d :: PBKDFName
Argon2d = BOTAN_PBKDF_ARGON2D
pattern $mArgon2i :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
$bArgon2i :: PBKDFName
Argon2i = BOTAN_PBKDF_ARGON2I
pattern $mArgon2id :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
$bArgon2id :: PBKDFName
Argon2id = BOTAN_PBKDF_ARGON2ID
pattern $mBcrypt_PBKDF :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
$bBcrypt_PBKDF :: PBKDFName
Bcrypt_PBKDF = BOTAN_PBKDF_BCRYPT_PBKDF
pattern $mOpenPGP_S2K :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
$bOpenPGP_S2K :: PBKDFName
OpenPGP_S2K = BOTAN_PBKDF_OPENPGP_S2K

-- NOTE: May require HMAC
pbkdf2 :: MACName -> PBKDFName
pbkdf2 :: PBKDFName -> PBKDFName
pbkdf2 PBKDFName
m = PBKDFName
PBKDF2 PBKDFName -> PBKDFName -> PBKDFName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ PBKDFName
m

openPGP_S2K:: HashName -> PBKDFName
openPGP_S2K :: PBKDFName -> PBKDFName
openPGP_S2K PBKDFName
h = PBKDFName
OpenPGP_S2K PBKDFName -> PBKDFName -> PBKDFName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ PBKDFName
h

-- NOTE: Should passphrase be Text or ByteString? Text is implied by use of const char*
--  as well as the non-null context implied by passphrase_len == 0. ByteString for now.
pwdhash
    :: PBKDFName        -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)"
    -> Int              -- ^ __param1__: the first PBKDF algorithm parameter
    -> Int              -- ^ __param2__: the second PBKDF algorithm parameter (may be zero if unneeded)
    -> Int              -- ^ __param3__: the third PBKDF algorithm parameter (may be zero if unneeded)
    -> Int              -- ^ __out_len__: the desired length of the key to produce
    -> ByteString       -- ^ __passphrase__: the password to derive the key from
    -> ByteString       -- ^ __salt[]__: a randomly chosen salt
    -> IO ByteString    -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes
pwdhash :: PBKDFName
-> Int
-> Int
-> Int
-> Int
-> PBKDFName
-> PBKDFName
-> IO PBKDFName
pwdhash PBKDFName
algo Int
p1 Int
p2 Int
p3 Int
outLen PBKDFName
passphrase PBKDFName
salt = Int -> (Ptr Word8 -> IO ()) -> IO PBKDFName
forall byte. Int -> (Ptr byte -> IO ()) -> IO PBKDFName
allocBytes Int
outLen ((Ptr Word8 -> IO ()) -> IO PBKDFName)
-> (Ptr Word8 -> IO ()) -> IO PBKDFName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr -> do
    PBKDFName -> (Ptr CChar -> IO ()) -> IO ()
forall a. PBKDFName -> (Ptr CChar -> IO a) -> IO a
asCString PBKDFName
algo ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr -> do
        PBKDFName -> (Ptr CChar -> CSize -> IO ()) -> IO ()
forall a. PBKDFName -> (Ptr CChar -> CSize -> IO a) -> IO a
asCStringLen PBKDFName
passphrase ((Ptr CChar -> CSize -> IO ()) -> IO ())
-> (Ptr CChar -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passphrasePtr CSize
passphraseLen -> do
            PBKDFName -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall byte a. PBKDFName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen PBKDFName
salt ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
saltPtr CSize
saltLen -> do
                HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ConstPtr CChar
-> CSize
-> CSize
-> CSize
-> Ptr Word8
-> CSize
-> ConstPtr CChar
-> CSize
-> ConstPtr Word8
-> CSize
-> IO BotanErrorCode
botan_pwdhash
                    (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
algoPtr)
                    (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p1)
                    (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p2)
                    (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p3)
                    Ptr Word8
outPtr
                    (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outLen)
                    (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
passphrasePtr)
                    CSize
passphraseLen
                    (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
saltPtr)
                    CSize
saltLen
{-# WARNING pwdhash "pwdhash and pwdhashTimed's parameter order may be inconsistent. See botan-low/test/Botan/Low/PwdHashSpec.hs for more information." #-}



pwdhashTimed
    :: PBKDFName                    -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)"
    -> Int                          -- ^ __msec__: the desired runtime in milliseconds
    -> Int                          -- ^ __out_len__: the desired length of the key to produce
    -> ByteString                   -- ^ __passphrase__: the password to derive the key from
    -> ByteString                   -- ^ __salt[]__: a randomly chosen salt
    -> IO (Int,Int,Int,ByteString)  -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes
pwdhashTimed :: PBKDFName
-> Int
-> Int
-> PBKDFName
-> PBKDFName
-> IO (Int, Int, Int, PBKDFName)
pwdhashTimed PBKDFName
algo Int
msec Int
outLen PBKDFName
passphrase PBKDFName
salt = (Ptr CSize -> IO (Int, Int, Int, PBKDFName))
-> IO (Int, Int, Int, PBKDFName)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int, Int, PBKDFName))
 -> IO (Int, Int, Int, PBKDFName))
-> (Ptr CSize -> IO (Int, Int, Int, PBKDFName))
-> IO (Int, Int, Int, PBKDFName)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
p1Ptr -> (Ptr CSize -> IO (Int, Int, Int, PBKDFName))
-> IO (Int, Int, Int, PBKDFName)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int, Int, PBKDFName))
 -> IO (Int, Int, Int, PBKDFName))
-> (Ptr CSize -> IO (Int, Int, Int, PBKDFName))
-> IO (Int, Int, Int, PBKDFName)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
p2Ptr -> (Ptr CSize -> IO (Int, Int, Int, PBKDFName))
-> IO (Int, Int, Int, PBKDFName)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int, Int, PBKDFName))
 -> IO (Int, Int, Int, PBKDFName))
-> (Ptr CSize -> IO (Int, Int, Int, PBKDFName))
-> IO (Int, Int, Int, PBKDFName)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
p3Ptr -> do
    PBKDFName
out <- Int -> (Ptr Word8 -> IO ()) -> IO PBKDFName
forall byte. Int -> (Ptr byte -> IO ()) -> IO PBKDFName
allocBytes Int
outLen ((Ptr Word8 -> IO ()) -> IO PBKDFName)
-> (Ptr Word8 -> IO ()) -> IO PBKDFName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr -> do
        PBKDFName -> (Ptr CChar -> IO ()) -> IO ()
forall a. PBKDFName -> (Ptr CChar -> IO a) -> IO a
asCString PBKDFName
algo ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr -> do
            PBKDFName -> (Ptr CChar -> CSize -> IO ()) -> IO ()
forall a. PBKDFName -> (Ptr CChar -> CSize -> IO a) -> IO a
asCStringLen PBKDFName
passphrase ((Ptr CChar -> CSize -> IO ()) -> IO ())
-> (Ptr CChar -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passphrasePtr CSize
passphraseLen -> do
                PBKDFName -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall byte a. PBKDFName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen PBKDFName
salt ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
saltPtr CSize
saltLen -> do
                    HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ConstPtr CChar
-> Word32
-> Ptr CSize
-> Ptr CSize
-> Ptr CSize
-> Ptr Word8
-> CSize
-> ConstPtr CChar
-> CSize
-> ConstPtr Word8
-> CSize
-> IO BotanErrorCode
botan_pwdhash_timed
                        (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
algoPtr)
                        (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
msec)
                        Ptr CSize
p1Ptr
                        Ptr CSize
p2Ptr
                        Ptr CSize
p3Ptr
                        Ptr Word8
outPtr
                        (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outLen)
                        (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
passphrasePtr)
                        CSize
passphraseLen
                        (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
saltPtr)
                        CSize
saltLen
    Int
p1 <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
p1Ptr
    Int
p2 <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
p2Ptr
    Int
p3 <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
p3Ptr
    (Int, Int, Int, PBKDFName) -> IO (Int, Int, Int, PBKDFName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
p1,Int
p2,Int
p3,PBKDFName
out)
{-# WARNING pwdhashTimed "pwdhash and pwdhashTimed's parameter order may be inconsistent. See botan-low/test/Botan/Low/PwdHashSpec.hs for more information." #-}