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

Generate and validate Bcrypt password hashes
-}

module Botan.Low.Bcrypt
(

-- * Bcrypt
-- $introduction

-- * Usage
-- $usage

-- * Generate a bcrypt digest
  bcryptGenerate

-- * Validate a bcrypt digest
, bcryptIsValid

-- * Work factor
, BcryptWorkFactor(..)
, pattern BcryptFast
, pattern BcryptGood
, pattern BcryptStrong
, BcryptPassword(..)
, BcryptDigest(..)

) where

import qualified Data.ByteString as ByteString

import Botan.Bindings.Bcrypt

import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.RNG

import Data.ByteString.Internal as ByteString

{- $introduction

`bcrypt` is a password-hashing algorithm designed to protect your passwords
against hackers using an expensive key setup phase. Instead of storing a user's
password in plaintext in the database, the server may instead generate a salted
bcrypt digest upon signup, and verify it upon login. 

The `bcrypt` implementation provided by `botan` generates a random salt for you
automatically. A work factor of 12 or greater is recommended.

-}

{- $usage

To generate a bcrypt digest:

> import Botan.Low.RNG
> import Botan.Low.Bcrypt
> 
> -- The user has sent us a username and password in order to sign up 
> onUserSignup :: ByteString -> ByteString -> IO ()
> onUserSignup username password = do
>     rng <- rngInit "user"
>     digest <- bcryptGenerate password rng 12
>     createAndStoreNewUser username digest

To validate a bcrypt digest:

> import Botan.Low.RNG
> import Botan.Low.Bcrypt
> 
> -- The user has sent us a username and password in order to log in
> onUserLogin :: ByteString -> ByteString -> IO Bool
> onUserLogin username password = do
>     rng <- rngInit "user"
>     digestMaybe <- getStoredUserDigest username
>     case digestMaybe of
>         Nothing     -> return False
>         Just digest -> bcryptIsValid password digest

-}

-- | A work factor to slow down guessing attacks.
type BcryptWorkFactor = Int

pattern BcryptFast
    ,   BcryptGood
    ,   BcryptStrong
    ::  BcryptWorkFactor

-- | Should not cause noticable CPU usage
pattern $mBcryptFast :: forall {r}. BcryptWorkFactor -> ((# #) -> r) -> ((# #) -> r) -> r
$bBcryptFast :: BcryptWorkFactor
BcryptFast    = BOTAN_BCRYPT_WORK_FACTOR_FAST

-- | May cause noticable CPU usage
pattern $mBcryptGood :: forall {r}. BcryptWorkFactor -> ((# #) -> r) -> ((# #) -> r) -> r
$bBcryptGood :: BcryptWorkFactor
BcryptGood    = BOTAN_BCRYPT_WORK_FACTOR_GOOD

-- | May block for several seconds
pattern $mBcryptStrong :: forall {r}. BcryptWorkFactor -> ((# #) -> r) -> ((# #) -> r) -> r
$bBcryptStrong :: BcryptWorkFactor
BcryptStrong  = BOTAN_BCRYPT_WORK_FACTOR_STRONG

-- | A bcrypt password.
type BcryptPassword = ByteString

-- | A bcrypt-hashed password digest.
type BcryptDigest = ByteString

{- |
Create a password hash using Bcrypt

> rng <- rngInit "user"
> digest <- bcryptGenerate password rng 12

Output is formatted bcrypt $2a$...
-}
bcryptGenerate
    :: BcryptPassword   -- ^ __password__: The password
    -> RNG              -- ^ __rng__: A random number generator
    -> BcryptWorkFactor -- ^ __work_factor__: How much work to do to slow down guessing attacks. A value of 12 to 16 is probably fine.
    -> IO BcryptDigest
bcryptGenerate :: BcryptPassword -> RNG -> BcryptWorkFactor -> IO BcryptPassword
bcryptGenerate BcryptPassword
password RNG
rng BcryptWorkFactor
factor = BcryptPassword
-> (Ptr CChar -> IO BcryptPassword) -> IO BcryptPassword
forall a. BcryptPassword -> (Ptr CChar -> IO a) -> IO a
asCString BcryptPassword
password ((Ptr CChar -> IO BcryptPassword) -> IO BcryptPassword)
-> (Ptr CChar -> IO BcryptPassword) -> IO BcryptPassword
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passwordPtr -> do
   RNG -> (BotanRNG -> IO BcryptPassword) -> IO BcryptPassword
forall a. RNG -> (BotanRNG -> IO a) -> IO a
withRNG RNG
rng ((BotanRNG -> IO BcryptPassword) -> IO BcryptPassword)
-> (BotanRNG -> IO BcryptPassword) -> IO BcryptPassword
forall a b. (a -> b) -> a -> b
$ \ BotanRNG
botanRNG -> do
        (Ptr CSize -> IO BcryptPassword) -> IO BcryptPassword
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO BcryptPassword) -> IO BcryptPassword)
-> (Ptr CSize -> IO BcryptPassword) -> IO BcryptPassword
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
            -- NOTE: bcrypt max pass size should be < 72 in general, we'll
            -- do 80 for safety
            Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
szPtr CSize
80
            BcryptWorkFactor
-> (Ptr Word8 -> IO BcryptPassword) -> IO BcryptPassword
forall a b. BcryptWorkFactor -> (Ptr a -> IO b) -> IO b
allocaBytes BcryptWorkFactor
80 ((Ptr Word8 -> IO BcryptPassword) -> IO BcryptPassword)
-> (Ptr Word8 -> IO BcryptPassword) -> IO BcryptPassword
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr -> do
                HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8
-> Ptr CSize
-> ConstPtr CChar
-> BotanRNG
-> CSize
-> Word32
-> IO BotanErrorCode
botan_bcrypt_generate
                    Ptr Word8
outPtr
                    Ptr CSize
szPtr
                    (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
passwordPtr)
                    BotanRNG
botanRNG
                    (BcryptWorkFactor -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral BcryptWorkFactor
factor)
                    Word32
0   -- "@param flags should be 0 in current API revision, all other uses are reserved"
                Ptr CChar -> IO BcryptPassword
ByteString.packCString (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outPtr)

{- |
Check a previously created password hash

> valid <- bcryptIsValid password digest
> if valid ...

Returns True iff this password/hash combination is valid,
False if the combination is not valid (but otherwise well formed),
and otherwise throws an exception on error.
-}
bcryptIsValid
    :: BcryptPassword   -- ^ __password__: The password to check against
    -> BcryptDigest     -- ^ __hash__: The stored hash to check against
    -> IO Bool
bcryptIsValid :: BcryptPassword -> BcryptPassword -> IO Bool
bcryptIsValid BcryptPassword
password BcryptPassword
hash = BcryptPassword -> (Ptr CChar -> IO Bool) -> IO Bool
forall a. BcryptPassword -> (Ptr CChar -> IO a) -> IO a
asCString BcryptPassword
password ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passwordPtr -> do
    BcryptPassword -> (Ptr CChar -> IO Bool) -> IO Bool
forall a. BcryptPassword -> (Ptr CChar -> IO a) -> IO a
asCString BcryptPassword
hash ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
hashPtr -> do
        HasCallStack => IO BotanErrorCode -> IO Bool
IO BotanErrorCode -> IO Bool
throwBotanCatchingSuccess (IO BotanErrorCode -> IO Bool) -> IO BotanErrorCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ ConstPtr CChar -> ConstPtr CChar -> IO BotanErrorCode
botan_bcrypt_is_valid (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
passwordPtr) (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
hashPtr)