{-|
Module      : Botan.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.Bcrypt
( 

-- * Bcrypt
-- $introduction

-- * Usage
-- $usage

-- * Work factors
  WorkFactor(..)
, workFactor
, toWorkFactor

-- * Generating a bcrypt digest
, Password(..)
, BcryptDigest(..)
, bcryptGenerate
, bcryptGenerateRNG
, unsafeBcryptGenerateRNG

-- * Validating a bcrypt digest
, bcryptValidate
, unsafeBcryptValidate

) where

import qualified Data.ByteString as ByteString

import qualified Botan.Low.Bcrypt as Low
import qualified Botan.Low.RNG as Low

import Botan.Error
import Botan.Prelude
import Botan.RNG

{- $introduction

Bcrypt is an adaptive password-hashing algorithm designed to protect against brute force and
rainbow table attacks. It contains a work factor that may be increased to increase resistance
as computing power increases.

Bcrypt produces digests suitable for secure storage and validation. 

Bcrypt is designed to be an expensive operation, and can block for some time. It also performs
this same operation upon validation.
-}

{- $usage

=== Directly using an `RNG` context

Direct usage is very simple

> main = do
>     rng <- newRNG Autoseeded
>     dg <- bcryptGenerateRNG rng "Fee fi fo fum!" Fast
>     print dg
>     valid <- bcryptValidate "Fee fi fo fum!" dg
>     print valid

=== Implicitly using `MonadRandomIO`

> main = do
>     dg <- bcryptGenerate "Fee fi fo fum!" Fast
>     print dg
>     valid <- bcryptValidate "Fee fi fo fum!" dg
>     print valid

-}

-- | An work factor representing the level of security
data WorkFactor
    = Fast
    | Good
    | Strong
    | WorkFactor Low.BcryptWorkFactor
    deriving (Int -> WorkFactor -> ShowS
[WorkFactor] -> ShowS
WorkFactor -> String
(Int -> WorkFactor -> ShowS)
-> (WorkFactor -> String)
-> ([WorkFactor] -> ShowS)
-> Show WorkFactor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkFactor -> ShowS
showsPrec :: Int -> WorkFactor -> ShowS
$cshow :: WorkFactor -> String
show :: WorkFactor -> String
$cshowList :: [WorkFactor] -> ShowS
showList :: [WorkFactor] -> ShowS
Show)

instance Eq WorkFactor where
    WorkFactor
a == :: WorkFactor -> WorkFactor -> Bool
== WorkFactor
b = (WorkFactor -> Int
workFactor WorkFactor
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== WorkFactor -> Int
workFactor WorkFactor
b)

instance Ord WorkFactor where
    WorkFactor
a <= :: WorkFactor -> WorkFactor -> Bool
<= WorkFactor
b = (WorkFactor -> Int
workFactor WorkFactor
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WorkFactor -> Int
workFactor WorkFactor
b)

-- | Convert a work factor to an integer
workFactor :: WorkFactor -> Low.BcryptWorkFactor
workFactor :: WorkFactor -> Int
workFactor WorkFactor
Fast             = Int
Low.BcryptFast
workFactor WorkFactor
Good             = Int
Low.BcryptGood
workFactor WorkFactor
Strong           = Int
Low.BcryptStrong
workFactor (WorkFactor Int
wf)  = Int
wf

toWorkFactor :: Low.BcryptWorkFactor -> WorkFactor
toWorkFactor :: Int -> WorkFactor
toWorkFactor Int
Low.BcryptFast   = WorkFactor
Fast
toWorkFactor Int
Low.BcryptGood   = WorkFactor
Good
toWorkFactor Int
Low.BcryptStrong = WorkFactor
Strong
toWorkFactor Int
wf               = Int -> WorkFactor
WorkFactor Int
wf

type Password = ByteString -- NOTE: Should actually be Text

{- |
A bcrypt password hash

It should be formatted is formatted bcrypt $2a${wf}$... where wf is some integer work factor.
-}
type BcryptDigest = ByteString

{- |
Generate a `BcryptDigest` password hash using Bcrypt

Output is formatted bcrypt $2a$...
-}
bcryptGenerate
    :: (MonadRandomIO m)
    => Password         -- ^ The password to check against
    -> WorkFactor       -- ^ A work factor to slow down guessing attack
    -> m BcryptDigest
bcryptGenerate :: forall (m :: * -> *).
MonadRandomIO m =>
Password -> WorkFactor -> m Password
bcryptGenerate Password
pass WorkFactor
wf = do
    RNG
rng <- m RNG
forall (m :: * -> *). MonadRandomIO m => m RNG
getRNG
    RNG -> Password -> WorkFactor -> m Password
forall (m :: * -> *).
MonadIO m =>
RNG -> Password -> WorkFactor -> m Password
bcryptGenerateRNG RNG
rng Password
pass WorkFactor
wf

{- |
Generate a `BcryptDigest` password hash using Bcrypt

Uses the provided RNG.
-}
bcryptGenerateRNG
    :: (MonadIO m)
    => RNG          -- ^ A random number generator
    -> Password     -- ^ The password to check against
    -> WorkFactor   -- ^ A work factor to slow down guessing attack
    -> m BcryptDigest
bcryptGenerateRNG :: forall (m :: * -> *).
MonadIO m =>
RNG -> Password -> WorkFactor -> m Password
bcryptGenerateRNG RNG
rng Password
pass WorkFactor
wf = IO Password -> m Password
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Password -> m Password) -> IO Password -> m Password
forall a b. (a -> b) -> a -> b
$ Password -> RNG -> Int -> IO Password
Low.bcryptGenerate Password
pass RNG
rng (WorkFactor -> Int
workFactor WorkFactor
wf)

-- |This function is unsafe as it may block for an indeterminate
--  amount of time
unsafeBcryptGenerateSystem
    :: Password         -- ^ The password to check against
    -> WorkFactor       -- ^ A work factor to slow down guessing attack
    -> BcryptDigest
unsafeBcryptGenerateSystem :: Password -> WorkFactor -> Password
unsafeBcryptGenerateSystem = (RNG -> Password -> WorkFactor -> IO Password)
-> RNG -> Password -> WorkFactor -> Password
forall a b c d. (a -> b -> c -> IO d) -> a -> b -> c -> d
unsafePerformIO3 RNG -> Password -> WorkFactor -> IO Password
forall (m :: * -> *).
MonadIO m =>
RNG -> Password -> WorkFactor -> m Password
bcryptGenerateRNG RNG
systemRNG
{-# NOINLINE unsafeBcryptGenerateSystem #-}

{- |
This function is unsafe as it may block for an indeterminate amount of time
-}
unsafeBcryptGenerateRNG
    :: RNG          -- ^ A random number generator
    -> Password     -- ^ The password to check against
    -> WorkFactor   -- ^ A work factor to slow down guessing attack
    -> BcryptDigest
unsafeBcryptGenerateRNG :: RNG -> Password -> WorkFactor -> Password
unsafeBcryptGenerateRNG = (RNG -> Password -> WorkFactor -> IO Password)
-> RNG -> Password -> WorkFactor -> Password
forall a b c d. (a -> b -> c -> IO d) -> a -> b -> c -> d
unsafePerformIO3 RNG -> Password -> WorkFactor -> IO Password
forall (m :: * -> *).
MonadIO m =>
RNG -> Password -> WorkFactor -> m Password
bcryptGenerateRNG
{-# NOINLINE unsafeBcryptGenerateRNG #-}

{- |
Check a previously created digest

Returns True iff this password / digest combination is valid,
False if the combination is not valid (but otherwise well formed),
and otherwise throws an exception on error
-}
bcryptValidate
    :: (MonadIO m)
    => Password     -- ^ The password to check against
    -> BcryptDigest -- ^ The stored hash to check against
    -> m Bool
bcryptValidate :: forall (m :: * -> *). MonadIO m => Password -> Password -> m Bool
bcryptValidate Password
pass Password
dg = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Password -> Password -> IO Bool
Low.bcryptIsValid Password
pass Password
dg
{-# NOINLINE bcryptValidate #-}

{- |
Check a previously created digest, unsafely.

This function is unsafe as it may block for an indeterminate amount of time
-}
unsafeBcryptValidate
    :: Password     -- ^ The password to check against
    -> BcryptDigest -- ^ The stored hash to check against
    -> Bool
unsafeBcryptValidate :: Password -> Password -> Bool
unsafeBcryptValidate = (Password -> Password -> IO Bool) -> Password -> Password -> Bool
forall a b c. (a -> b -> IO c) -> a -> b -> c
unsafePerformIO2 Password -> Password -> IO Bool
Low.bcryptIsValid
{-# NOINLINE unsafeBcryptValidate #-}

-- TODO: bcryptDigestWorkFactor :: BcryptDigest -> Int
-- TODO: bcryptDigestWorkFactor :: BcryptDigest -> WorkFactor