-- |
-- Module      : Crypto.Saltine.Core.Password
-- Description : Argon2 password hash
-- Copyright   : (c) Promethea Raschke 2018
--                   Max Amanshauser 2021
-- License     : MIT
-- Maintainer  : max@lambdalifting.org
-- Stability   : experimental
-- Portability : non-portable
--
-- Password hashing and key derivation
--
-- When in doubt, just use one of [ interactivePolicy, moderatePolicy, sensitivePolicy ],
-- but this module also allows you to fine-tune parameters for specific circumstances.
--
-- This module uses the @Text@ type for passwords, because this seems to be the only
-- reasonable way to get consistent encodings across locales and architectures, short of
-- letting users mess around with ByteStrings themselves.

module Crypto.Saltine.Core.Password
  ( Salt
  , newSalt

  , needsRehash

  , pwhashStr
  , pwhashStrVerify
  , pwhash

  , Policy(..)
  , interactivePolicy
  , moderatePolicy
  , sensitivePolicy

  , Opslimit
  , opslimit
  , getOpslimit

  , minOpslimit
  , maxOpslimit

  , opslimitInteractive
  , opslimitModerate
  , opslimitSensitive

  , Memlimit
  , memlimit
  , getMemlimit

  , minMemlimit
  , maxMemlimit

  , memlimitInteractive
  , memlimitModerate
  , memlimitSensitive

  , Algorithm
  , defaultAlgorithm
  ) where

import Crypto.Saltine.Internal.Util
import Crypto.Saltine.Internal.Password as I
import Data.ByteString (ByteString)
import Data.Text       (Text)
import Foreign.C
import System.IO.Unsafe

import qualified Crypto.Saltine.Internal.Password as Bytes
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE


newSalt :: IO Salt
newSalt = Salt <$> randomByteString Bytes.pwhash_saltbytes

-- | Hashes a password according to the policy
-- This function is non-deterministic and hence in IO.
-- Since this function may cause a huge amount of memory to be allocated, it will return
-- Nothing if the allocation failed and on any other error.
pwhashStr :: Text -> Policy -> IO (Maybe PasswordHash)
pwhashStr pw policy = do
  let (ops, mem, _alg) = unpackPolicy policy

  -- Hash is always ASCII, so no decoding needed
  fmap (fmap (PasswordHash . T.pack)) $ allocaBytes pwhash_strbytes $ \pp ->
    constByteStrings [TE.encodeUtf8 pw] $ \ [(ppw, ppwlen)] -> do
          ret <- c_pwhash_str pp ppw (fromIntegral ppwlen) (fromIntegral ops) (fromIntegral mem)

          case ret of
              0 -> Just <$> peekCAString pp
              _ -> pure Nothing

-- | Verifies that a certain password hash was constructed from the supplied password
pwhashStrVerify :: PasswordHash -> Text -> Bool
pwhashStrVerify (PasswordHash h) pw = unsafePerformIO $
  constByteStrings [TE.encodeUtf8 $ T.snoc h '\NUL', TE.encodeUtf8 pw] $ \[(ph, _), (ppw, ppwlen)] -> do
    res <- c_pwhash_str_verify ph ppw (fromIntegral ppwlen)
    pure (res == 0)

-- | Indicates whether a password needs to be rehashed, because the opslimit/memlimit parameters
-- used to hash the password are inconsistent with the supplied values.
-- Returns Nothing if the hash appears to be invalid.
-- Internally this function will always use the current DefaultAlgorithm and hence will give
-- undefined results if a different algorithm was used to hash the password.
needsRehash :: Opslimit -> Memlimit -> PasswordHash -> Maybe Bool
needsRehash (Opslimit ops) (Memlimit mem) (PasswordHash h) =
    unsafePerformIO $
        constByteStrings [TE.encodeUtf8 $ T.snoc h '\NUL'] $ \[(ph,_)] -> do
            res <- c_pwhash_str_needs_rehash ph (fromIntegral ops) (fromIntegral mem)
            pure $  if res == -1
                    then Nothing
                    else Just (res == 1)

-- | Derives a key of the specified length from a password using a salt according to the provided policy.
-- Since this function may cause a huge amount of memory to be allocated, it will return
-- Nothing if the allocation failed and on any other error.
pwhash :: Text -> Int -> Salt -> Policy -> Maybe ByteString
pwhash pw len (Salt salt) policy = do
  let (ops, mem, alg) = unpackPolicy policy

  let (e, hashed) =
        buildUnsafeByteString len $ \hbuf ->
          constByteStrings [TE.encodeUtf8 pw, salt] $ \[(ppw,ppwlen), (psalt,_)] ->
              c_pwhash
                    hbuf (fromIntegral len)
                    ppw (fromIntegral ppwlen)
                    psalt
                    (fromIntegral ops)
                    (fromIntegral mem)
                    (fromIntegral $ fromEnum alg)

  if e == -1
  then Nothing
  else Just hashed


-- | Smart constructor for opslimit
opslimit :: Algorithm -> Int -> Maybe Opslimit
opslimit alg x
  | Opslimit x < minOpslimit alg = Nothing
  | Opslimit x > maxOpslimit alg = Nothing
  | otherwise = Just (Opslimit x)

opslimitInteractive :: Algorithm -> Opslimit
opslimitInteractive DefaultAlgorithm = Opslimit (fromIntegral Bytes.pwhash_opslimit_interactive)
opslimitInteractive Argon2i13        = Opslimit (fromIntegral Bytes.pwhash_argon2i_opslimit_interactive)
opslimitInteractive Argon2id13       = Opslimit (fromIntegral Bytes.pwhash_argon2id_opslimit_interactive)

opslimitModerate :: Algorithm -> Opslimit
opslimitModerate DefaultAlgorithm   = Opslimit (fromIntegral Bytes.pwhash_opslimit_moderate)
opslimitModerate Argon2i13          = Opslimit (fromIntegral Bytes.pwhash_argon2i_opslimit_moderate)
opslimitModerate Argon2id13         = Opslimit (fromIntegral Bytes.pwhash_argon2id_opslimit_moderate)

opslimitSensitive :: Algorithm -> Opslimit
opslimitSensitive DefaultAlgorithm  = Opslimit (fromIntegral Bytes.pwhash_opslimit_sensitive)
opslimitSensitive Argon2i13         = Opslimit (fromIntegral Bytes.pwhash_argon2i_opslimit_sensitive)
opslimitSensitive Argon2id13        = Opslimit (fromIntegral Bytes.pwhash_argon2id_opslimit_sensitive)


-- | Smart constructor for memlimit
memlimit :: Algorithm -> Int -> Maybe Memlimit
memlimit alg x
  | Memlimit x < minMemlimit alg  = Nothing
  | Memlimit x > maxMemlimit alg= Nothing
  | otherwise = Just (Memlimit x)

memlimitInteractive :: Algorithm -> Memlimit
memlimitInteractive DefaultAlgorithm = Memlimit (fromIntegral Bytes.pwhash_memlimit_interactive)
memlimitInteractive Argon2i13        = Memlimit (fromIntegral Bytes.pwhash_argon2i_memlimit_interactive)
memlimitInteractive Argon2id13       = Memlimit (fromIntegral Bytes.pwhash_argon2id_memlimit_interactive)

memlimitModerate :: Algorithm -> Memlimit
memlimitModerate DefaultAlgorithm   = Memlimit (fromIntegral Bytes.pwhash_memlimit_moderate)
memlimitModerate Argon2i13          = Memlimit (fromIntegral Bytes.pwhash_argon2i_memlimit_moderate)
memlimitModerate Argon2id13         = Memlimit (fromIntegral Bytes.pwhash_argon2id_memlimit_moderate)

memlimitSensitive :: Algorithm -> Memlimit
memlimitSensitive DefaultAlgorithm  = Memlimit (fromIntegral Bytes.pwhash_memlimit_sensitive)
memlimitSensitive Argon2i13         = Memlimit (fromIntegral Bytes.pwhash_argon2i_memlimit_sensitive)
memlimitSensitive Argon2id13        = Memlimit (fromIntegral Bytes.pwhash_argon2id_memlimit_sensitive)

defaultAlgorithm :: Algorithm
defaultAlgorithm = DefaultAlgorithm


-- | Get raw C types from a policy, suitable for passing to FFI functions
unpackPolicy :: Policy -> (CULLong, CSize, CInt)
unpackPolicy (Policy ops mem alg) =
  ( fromIntegral (getOpslimit ops)
  , fromIntegral (getMemlimit mem)
  , algorithm alg
  )


{-
Fast policy suitable for low-powered devices

Takes approximately 0.1 seconds on a typical desktop computer
and requires 64 MiB of dedicated RAM
-}
interactivePolicy :: Policy
interactivePolicy = Policy (opslimitInteractive defaultAlgorithm)
                           (memlimitInteractive defaultAlgorithm)
                           defaultAlgorithm

{-|
Moderate policy with a balance of speed and security

Takes approximately 1 second on a typical desktop computer
and requires 256 MiB of dedicated RAM
-}
moderatePolicy :: Policy
moderatePolicy = Policy (opslimitModerate defaultAlgorithm)
                        (memlimitModerate defaultAlgorithm)
                        defaultAlgorithm

{-|
High-security policy designed to make attacking the password extremely expensive

Takes several seconds on a typical desktop computer
and requires 1024 MiB of dedicated RAM
-}
sensitivePolicy :: Policy
sensitivePolicy = Policy (opslimitSensitive defaultAlgorithm)
                         (memlimitSensitive defaultAlgorithm)
                         defaultAlgorithm


minOpslimit :: Algorithm -> Opslimit
minOpslimit DefaultAlgorithm = Opslimit $ fromIntegral Bytes.pwhash_opslimit_min
minOpslimit Argon2i13        = Opslimit $ fromIntegral Bytes.pwhash_argon2i_opslimit_min
minOpslimit Argon2id13       = Opslimit $ fromIntegral Bytes.pwhash_argon2id_opslimit_min

maxOpslimit :: Algorithm -> Opslimit
maxOpslimit DefaultAlgorithm = Opslimit $ fromIntegral Bytes.pwhash_opslimit_max
maxOpslimit Argon2i13        = Opslimit $ fromIntegral Bytes.pwhash_argon2i_opslimit_max
maxOpslimit Argon2id13       = Opslimit $ fromIntegral Bytes.pwhash_argon2id_opslimit_max

minMemlimit :: Algorithm -> Memlimit
minMemlimit DefaultAlgorithm = Memlimit $ fromIntegral Bytes.pwhash_memlimit_min
minMemlimit Argon2i13        = Memlimit $ fromIntegral Bytes.pwhash_argon2i_memlimit_min
minMemlimit Argon2id13       = Memlimit $ fromIntegral Bytes.pwhash_argon2id_memlimit_min

maxMemlimit :: Algorithm -> Memlimit
maxMemlimit DefaultAlgorithm = Memlimit $ fromIntegral Bytes.pwhash_memlimit_max
maxMemlimit Argon2i13        = Memlimit $ fromIntegral Bytes.pwhash_argon2i_memlimit_max
maxMemlimit Argon2id13       = Memlimit $ fromIntegral Bytes.pwhash_argon2id_memlimit_max