{-|
Module      : Botan.Low.PwdHash
Description : Password hashing
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX

This module is based on the [Password Based Key
Deriviation](https://botan.randombit.net/handbook/api_ref/pbkdf.html) section of
the C++ API reference.
-}

module Botan.Low.PwdHash (
    pwdhash
  , pwdhashTimed
    -- * Available schemes
    -- $available-schemes
  , PBKDFName
  , pattern PBKDF2
  , pbkdf2
  , pattern Scrypt
  , pattern Argon2d
  , pattern Argon2i
  , pattern Argon2id
  , pattern Bcrypt_PBKDF
  , pattern OpenPGP_S2K
  , openPGP_S2K
  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.PwdHash
import           Botan.Low.Error.Internal
import           Botan.Low.Hash
import           Botan.Low.Internal.ByteString
import           Botan.Low.Internal.String
import           Data.ByteString (ByteString)
import           Foreign.Marshal.Alloc
import           Foreign.Storable

{- $setup
>>> import Botan.Low.Hash
-}

{-------------------------------------------------------------------------------
  Password hashing
-------------------------------------------------------------------------------}

-- | Derive a cryptographic key from a passphrase using algorithm-specific parameters
--
-- NOTE: the interpretation of parameters @param1@, @param2@, and @param3@ are
-- different depending on the PBKDF algorithm that is picked. See the
-- documentation of the
-- [@from_params@](https://botan.randombit.net/handbook/api_ref/pbkdf.html#passwordhash)
-- C++ function for more information about the meaning of the parameters.
--
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 ->
    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 ->
    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 ->
    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 ->
      HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ ConstPtr CChar
-> CSize
-> CSize
-> CSize
-> Ptr Word8
-> CSize
-> ConstPtr CChar
-> CSize
-> ConstPtr Word8
-> CSize
-> IO CInt
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

-- | Derive a cryptographic key from a passphrase using algorithm-specific
-- parameters that are tuned automatically for a desired running time of the
-- algorithm.
--
-- NOTE: for the @Argon2@ and @Scrypt@ PBKDF algorithms, 'pwdhashTimed' returns
-- parameters in a different order than the order in which they should be passed
-- to 'pwdhash'. This is a known issue with the Botan C++ library. See
-- <https://github.com/randombit/botan/issues/2144> for more information.
--
-- 'pwdhashTimed' always returns parameters in this order:
--
-- > (iterations, parallelism, memoryParam)
--
-- 'pwdhash' shoulds be given parameters in this order for the
-- @Argon2@ and @Scrypt@ algorithms:
--
-- > param1 = memoryParam
-- > param2 = iterations
-- > param3 = parallelism
--
pwdhashTimed ::
     -- | __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)"
    PBKDFName
     -- | __msec__: the desired runtime in milliseconds
  -> Int
     -- | __out_len__: the desired length of the key to produce
  -> Int
     -- | __passphrase__: the password to derive the key from
  -> ByteString
     -- | __salt[]__: a randomly chosen salt
  -> ByteString
     -- | A tuple of four elements (in order):
     --
     -- * __param1__: the first PBKDF algorithm parameter
     -- * __param2__: the second PBKDF algorithm parameter (may be zero if unneeded)
     -- * __param3__: the third PBKDF algorithm parameter (may be zero if unneeded)
     -- * __out[]__: buffer to store the derived key, must be of out_len bytes
  -> IO (Int, Int, Int, ByteString)
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 ->
        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 ->
        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 ->
        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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt
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)

{-------------------------------------------------------------------------------
  Available schemes
-------------------------------------------------------------------------------}

{- $available-schemes

A number of algorithms are available to be used as password derivation schemes.
An algorithm is selected by passing the /algorithm specification name/ of the
algorithm as a string to the password hashing functions. In some cases an
algorithm specification name is just the /algorithm name/, like @"Scrypt"@. In
other cases an algorithm specification name is a combination of an algorithm
name paired with some parameters, such as @"PKBDF2(SHA-256)"@ where @"PBKDF2"@
is the algorithm name followed by a single parameter. Pattern synonyms are
included for each available /algorithm name/. Where necessary, such as in the
@"PBKDF2"@ case, these algorithm names can be be manually extended to full
algorithm specification names, or by using utility functions like 'pbkdf2' that
this module also provides.

See the [Available
Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes)
section of the C++ API reference for more information about available schemes.
-}

-- | The name of a key derivation scheme used as a PBKDF algorithm
type PBKDFName = ByteString

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

-- |
-- >>> PBKDF2
-- "PBKDF2"
pattern $bPBKDF2 :: PBKDFName
$mPBKDF2 :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
PBKDF2 = BOTAN_PBKDF_PBKDF2

-- |
-- >>> pbkdf2 SHA256
-- "PBKDF2(SHA-256)"
--
-- NOTE: "PBKDF(HMAC(SHA-256))" is equivalent to "PBKDF(SHA-256)". 'pbkdf2'
-- always outputs the latter given a hash function name.
pbkdf2 :: HashName -> PBKDFName
pbkdf2 :: PBKDFName -> PBKDFName
pbkdf2 PBKDFName
m = PBKDFName
PBKDF2 PBKDFName -> PBKDFName -> PBKDFName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ PBKDFName
m

-- |
-- >>> Scrypt
-- "Scrypt"
pattern $bScrypt :: PBKDFName
$mScrypt :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
Scrypt = BOTAN_PBKDF_SCRYPT

-- |
-- >>> Argon2d
-- "Argon2d"
pattern $bArgon2d :: PBKDFName
$mArgon2d :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
Argon2d = BOTAN_PBKDF_ARGON2D

-- |
-- >>> Argon2i
-- "Argon2i"
pattern $bArgon2i :: PBKDFName
$mArgon2i :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
Argon2i = BOTAN_PBKDF_ARGON2I

-- |
-- >>> Argon2id
-- "Argon2id"
pattern $bArgon2id :: PBKDFName
$mArgon2id :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
Argon2id = BOTAN_PBKDF_ARGON2ID

-- |
-- >>> Bcrypt_PBKDF
-- "Bcrypt-PBKDF"
pattern $bBcrypt_PBKDF :: PBKDFName
$mBcrypt_PBKDF :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
Bcrypt_PBKDF = BOTAN_PBKDF_BCRYPT_PBKDF

-- |
-- >>> OpenPGP_S2K
-- "OpenPGP-S2K"
pattern $bOpenPGP_S2K :: PBKDFName
$mOpenPGP_S2K :: forall {r}. PBKDFName -> ((# #) -> r) -> ((# #) -> r) -> r
OpenPGP_S2K = BOTAN_PBKDF_OPENPGP_S2K

-- |
-- >>> openPGP_S2K SHA256
-- "OpenPGP-S2K(SHA-256)"
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