{-|
Module      : Z.Crypto.PwdHash
Description : Password Hashing
Copyright   : Dong Han, 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Storing passwords for user authentication purposes in plaintext is the simplest but least secure method; when an attacker compromises the database in which the passwords are stored, they immediately gain access to all of them. Often passwords are reused among multiple services or machines, meaning once a password to a single service is known an attacker has a substantial head start on attacking other machines.

The general approach is to store, instead of the password, the output of a one way function of the password. Upon receiving an authentication request, the authenticating party can recompute the one way function and compare the value just computed with the one that was stored. If they match, then the authentication request succeeds. But when an attacker gains access to the database, they only have the output of the one way function, not the original password.

Common hash functions such as SHA-256 are one way, but used alone they have problems for this purpose. What an attacker can do, upon gaining access to such a stored password database, is hash common dictionary words and other possible passwords, storing them in a list. Then he can search through his list; if a stored hash and an entry in his list match, then he has found the password. Even worse, this can happen offline: an attacker can begin hashing common passwords days, months, or years before ever gaining access to the database. In addition, if two users choose the same password, the one way function output will be the same for both of them, which will be visible upon inspection of the database.

There are two solutions to these problems: salting and iteration. Salting refers to including, along with the password, a randomly chosen value which perturbs the one way function. Salting can reduce the effectiveness of offline dictionary generation, because for each potential password, an attacker would have to compute the one way function output for all possible salts. It also prevents the same password from producing the same output, as long as the salts do not collide. Choosing n-bit salts randomly, salt collisions become likely only after about 2:sup:(n/2) salts have been generated. Choosing a large salt (say 80 to 128 bits) ensures this is very unlikely. Note that in password hashing salt collisions are unfortunate, but not fatal - it simply allows the attacker to attack those two passwords in parallel easier than they would otherwise be able to.

The other approach, iteration, refers to the general technique of forcing multiple one way function evaluations when computing the output, to slow down the operation. For instance if hashing a single password requires running SHA-256 100,000 times instead of just once, that will slow down user authentication by a factor of 100,000, but user authentication happens quite rarely, and usually there are more expensive operations that need to occur anyway (network and database I/O, etc). On the other hand, an attacker who is attempting to break a database full of stolen password hashes will be seriously inconvenienced by a factor of 100,000 slowdown; they will be able to only test at a rate of .0001% of what they would without iterations (or, equivalently, will require 100,000 times as many zombie botnet hosts).

Memory usage while checking a password is also a consideration; if the computation requires using a certain minimum amount of memory, then an attacker can become memory-bound, which may in particular make customized cracking hardware more expensive. Some password hashing designs, such as scrypt, explicitly attempt to provide this. The bcrypt approach requires over 4 KiB of RAM (for the Blowfish key schedule) and may also make some hardware attacks more expensive.
-}

module Z.Crypto.PwdHash where

import           Z.Botan.Exception
import           Z.Botan.FFI
import           Z.Crypto.RNG       (RNG, withRNG)
import qualified Z.Data.Vector.Base as V
import           Z.Foreign

-- | Create a password hash using Bcrypt.
--
-- Bcrypt is a password hashing scheme originally designed for use in OpenBSD, but numerous other implementations exist. It has the advantage that it requires a small amount (4K) of fast RAM to compute, which can make hardware password cracking somewhat more expensive.
--
-- Bcrypt provides outputs that look like this:
--
-- >>> "$2a$12$7KIYdyv8Bp32WAvc.7YvI.wvRlyVn0HP/EhPmmOyMQA4YKxINO0p2"
--
-- Higher work factors increase the amount of time the algorithm runs, increasing the cost of cracking attempts. The increase is exponential, so a work factor of 12 takes roughly twice as long as work factor 11. The default work factor was set to 10 up until the 2.8.0 release.
--
-- It is recommended to set the work factor as high as your system can tolerate (from a performance and latency perspective) since higher work factors greatly improve the security against GPU-based attacks. For example, for protecting high value administrator passwords, consider using work factor 15 or 16; at these work factors each bcrypt computation takes several seconds. Since admin logins will be relatively uncommon, it might be acceptable for each login attempt to take some time. As of 2018, a good password cracking rig (with 8 NVIDIA 1080 cards) can attempt about 1 billion bcrypt computations per month for work factor 13. For work factor 12, it can do twice as many. For work factor 15, it can do only one quarter as many attempts.
--
-- The bcrypt work factor must be at least 4 (though at this work factor bcrypt is not very secure). The bcrypt format allows up to 31, but Botan currently rejects all work factors greater than 18 since even that work factor requires roughly 15 seconds of computation on a fast machine.
--
genBcrypt :: HasCallStack
          => V.Bytes    -- ^ password.
          -> RNG
          -> Int        -- ^ work factors (4 <= n <= 18).
          -> IO V.Bytes
{-# INLINABLE genBcrypt #-}
genBcrypt :: Bytes -> RNG -> Int -> IO Bytes
genBcrypt Bytes
pwd RNG
rng Int
n = do
    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
pwd ((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
pwd_p Int
pwd_off Int
pwd_len ->
        RNG -> (BotanStructT -> IO Bytes) -> IO Bytes
forall a. HasCallStack => RNG -> (BotanStructT -> IO a) -> IO a
withRNG RNG
rng ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
rng_p -> do
            (PrimArray Word8
pa, Int
r) <- Int -> (MBA# Word8 -> IO Int) -> IO (PrimArray Word8, Int)
forall a b.
Prim a =>
Int -> (MBA# Word8 -> IO b) -> IO (PrimArray a, b)
allocPrimArrayUnsafe Int
64 ((MBA# Word8 -> IO Int) -> IO (PrimArray Word8, Int))
-> (MBA# Word8 -> IO Int) -> IO (PrimArray Word8, Int)
forall a b. (a -> b) -> a -> b
$ \ MBA# Word8
out -> do
                IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$
                    MBA# Word8
-> BA# Word8
-> Int
-> Int
-> BotanStructT
-> Int
-> Word32
-> IO Int
hs_botan_bcrypt_generate MBA# Word8
out
                        BA# Word8
pwd_p Int
pwd_off Int
pwd_len BotanStructT
rng_p Int
n Word32
0
            let !r' :: Int
r' = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            MutablePrimArray RealWorld Word8
mpa <- PrimArray Word8 -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
PrimMonad m =>
PrimArray a -> m (MutablePrimArray (PrimState m) a)
unsafeThawPrimArray PrimArray Word8
pa
            MutablePrimArray (PrimState IO) Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m ()
shrinkMutablePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa Int
r'
            PrimArray Word8
pa' <- MutablePrimArray (PrimState IO) Word8 -> IO (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Word8
MutablePrimArray (PrimState IO) Word8
mpa
            Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
pa' Int
0 Int
r')

-- | Takes a password and a bcrypt output and returns true if the password is the same as the one that was used to generate the bcrypt hash.
--
validBcrypt :: HasCallStack
            => V.Bytes -- ^ password.
            -> V.Bytes -- ^ hash generated by 'genBcrypt'.
            -> IO Bool
{-# INLINABLE validBcrypt #-}
validBcrypt :: Bytes -> Bytes -> IO Bool
validBcrypt Bytes
pwd Bytes
hash = do
    Bytes -> (BA# Word8 -> Int -> Int -> IO Bool) -> IO Bool
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
pwd ((BA# Word8 -> Int -> Int -> IO Bool) -> IO Bool)
-> (BA# Word8 -> Int -> Int -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pwd_p Int
pwd_off Int
pwd_l ->
        Bytes -> (BA# Word8 -> Int -> Int -> IO Bool) -> IO Bool
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
hash ((BA# Word8 -> Int -> Int -> IO Bool) -> IO Bool)
-> (BA# Word8 -> Int -> Int -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
hash_p Int
hash_off Int
hash_l -> do
            CInt
ret <- BA# Word8 -> Int -> Int -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_bcrypt_is_valid  BA# Word8
pwd_p Int
pwd_off Int
pwd_l BA# Word8
hash_p Int
hash_off Int
hash_l
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
BOTAN_FFI_SUCCESS