{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}

-- |
--
-- Module: Sel.Hashing.Password
-- Description: Password hashing with the Argon2id algorithm
-- Copyright: (C) Hécate Moonlight 2022
-- License: BSD-3-Clause
-- Maintainer: The Haskell Cryptography Group
-- Portability: GHC only
module Sel.Hashing.Password
  ( -- * Introduction
    -- $introduction
    PasswordHash

    -- ** Password Hashing and Verifying
  , hashByteString
  , hashText
  , verifyByteString
  , verifyText
  , hashByteStringWithParams

    -- *** Conversion
  , passwordHashToByteString
  , passwordHashToText
  , passwordHashToHexText
  , passwordHashToHexByteString
  , asciiTextToPasswordHash
  , asciiByteStringToPasswordHash

    -- ** Salt
  , Salt
  , genSalt

    -- ** Conversion
  , saltToBinary
  , saltToHexText
  , saltToHexByteString
  , binaryToSalt
  , hexTextToSalt
  , hexByteStringToSalt

    -- * Argon2 Parameters
  , Argon2Params (Argon2Params)
  , defaultArgon2Params
  )
where

import Control.Monad (void)
import Data.ByteString (StrictByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Text (Text)
import Data.Text.Display
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy.Builder as Builder
import Foreign hiding (void)
import Foreign.C
import System.IO.Unsafe (unsafeDupablePerformIO)

import Sel.Internal

import qualified Data.Base16.Types as Base16
import GHC.Generics
import LibSodium.Bindings.PasswordHashing
import LibSodium.Bindings.Random

-- $introduction
--
-- This API provides functions for password hashing, backed by the [Argon2id](https://en.wikipedia.org/wiki/Argon2) algorithm.
--
-- If you need to deviate from the defaults enforced by this module,
-- please use the underlying bindings at "LibSodium.Bindings.PasswordHashing".

-- | A hashed password from the Argon2id algorithm.
--
-- @since 0.0.1.0
newtype PasswordHash = PasswordHash (ForeignPtr CChar)
  deriving stock ((forall x. PasswordHash -> Rep PasswordHash x)
-> (forall x. Rep PasswordHash x -> PasswordHash)
-> Generic PasswordHash
forall x. Rep PasswordHash x -> PasswordHash
forall x. PasswordHash -> Rep PasswordHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PasswordHash -> Rep PasswordHash x
from :: forall x. PasswordHash -> Rep PasswordHash x
$cto :: forall x. Rep PasswordHash x -> PasswordHash
to :: forall x. Rep PasswordHash x -> PasswordHash
Generic)

-- | @since 0.0.1.0
instance Display PasswordHash where
  displayBuilder :: PasswordHash -> Builder
displayBuilder = Text -> Builder
Builder.fromText (Text -> Builder)
-> (PasswordHash -> Text) -> PasswordHash -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordHash -> Text
passwordHashToHexText

-- | @since 0.0.1.0
instance Eq PasswordHash where
  (PasswordHash ForeignPtr CChar
ph1) == :: PasswordHash -> PasswordHash -> Bool
== (PasswordHash ForeignPtr CChar
ph2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CChar -> ForeignPtr CChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CChar
ph1 ForeignPtr CChar
ph2 CSize
cryptoPWHashStrBytes

-- | @since 0.0.1.0
instance Ord PasswordHash where
  (PasswordHash ForeignPtr CChar
ph1) compare :: PasswordHash -> PasswordHash -> Ordering
`compare` (PasswordHash ForeignPtr CChar
ph2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CChar -> ForeignPtr CChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CChar
ph1 ForeignPtr CChar
ph2 CSize
cryptoPWHashStrBytes

-- | @since 0.0.1.0
instance Show PasswordHash where
  show :: PasswordHash -> [Char]
show PasswordHash
s = PasswordHash -> [Char]
showHash PasswordHash
s
    where
      showHash :: PasswordHash -> String
      showHash :: PasswordHash -> [Char]
showHash = Text -> [Char]
forall a. Show a => a -> [Char]
show (Text -> [Char])
-> (PasswordHash -> Text) -> PasswordHash -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordHash -> Text
passwordHashToText

-- | Hash the password with the Argon2id algorithm and a set of pre-defined parameters.
--
-- The hash is encoded in a human-readable format that includes:
--
--   * The result of a memory-hard, CPU-intensive hash function applied to the password;
--   * The automatically generated salt used for the previous computation;
--   * The other parameters required to verify the password, including the algorithm
--     identifier, its version, opslimit, and memlimit.
--
-- Example output: @$argon2id$v=19$m=262144,t=3,p=1$fpPdXj9mK7J4m…@
--
-- @since 0.0.1.0
hashByteString :: StrictByteString -> IO PasswordHash
hashByteString :: StrictByteString -> IO PasswordHash
hashByteString StrictByteString
bytestring =
  StrictByteString
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO PasswordHash) -> IO PasswordHash)
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    ForeignPtr CChar
hashForeignPtr <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashStrBytes)
    ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CChar
hashForeignPtr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
passwordHashPtr ->
      IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
        Ptr CChar -> Ptr CChar -> CULLong -> CULLong -> CSize -> IO CInt
cryptoPWHashStr
          Ptr CChar
passwordHashPtr
          Ptr CChar
cString
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen)
          CULLong
cryptoPWHashOpsLimitModerate
          CSize
cryptoPWHashMemLimitModerate
    PasswordHash -> IO PasswordHash
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PasswordHash -> IO PasswordHash)
-> PasswordHash -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> PasswordHash
PasswordHash ForeignPtr CChar
hashForeignPtr

-- | Hash a UTF8-encoded password with the Argon2id algorithm and
-- a set of pre-defined parameters.
--
-- @since 0.0.1.0
hashText :: Text -> IO PasswordHash
hashText :: Text -> IO PasswordHash
hashText Text
text = StrictByteString -> IO PasswordHash
hashByteString (Text -> StrictByteString
Text.encodeUtf8 Text
text)

-- | Hash the password with the Argon2id algorithm.
--
-- The hash is __not__ encoded in human-readable format.
--
-- @since 0.0.1.0
hashByteStringWithParams :: Argon2Params -> Salt -> StrictByteString -> IO PasswordHash
hashByteStringWithParams :: Argon2Params -> Salt -> StrictByteString -> IO PasswordHash
hashByteStringWithParams Argon2Params{CULLong
opsLimit :: CULLong
opsLimit :: Argon2Params -> CULLong
opsLimit, CSize
memLimit :: CSize
memLimit :: Argon2Params -> CSize
memLimit} (Salt StrictByteString
argonSalt) StrictByteString
bytestring =
  StrictByteString
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO PasswordHash) -> IO PasswordHash)
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    StrictByteString
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
argonSalt ((CStringLen -> IO PasswordHash) -> IO PasswordHash)
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
saltString, Int
_) -> do
      ForeignPtr CUChar
hashForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashStrBytes)
      ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
hashForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
passwordHashPtr ->
        IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
          Ptr CUChar
-> CLLong
-> Ptr CChar
-> CULLong
-> Ptr CUChar
-> CULLong
-> CSize
-> CInt
-> IO CInt
cryptoPWHash
            Ptr CUChar
passwordHashPtr
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @CLLong CSize
cryptoPWHashStrBytes)
            Ptr CChar
cString
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen)
            (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
saltString)
            CULLong
opsLimit
            CSize
memLimit
            CInt
cryptoPWHashAlgDefault
      PasswordHash -> IO PasswordHash
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PasswordHash -> IO PasswordHash)
-> PasswordHash -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> PasswordHash
PasswordHash (forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr @CUChar @CChar ForeignPtr CUChar
hashForeignPtr)

-- | Verify the password hash against a clear 'Text' password
--
-- This function purposefully takes some time to complete, in order to alleviate bruteforce attacks.
--
-- @since 0.0.1.0
verifyText :: PasswordHash -> Text -> Bool
verifyText :: PasswordHash -> Text -> Bool
verifyText PasswordHash
passwordHash Text
clearTextPassword = PasswordHash -> StrictByteString -> Bool
verifyByteString PasswordHash
passwordHash (Text -> StrictByteString
Text.encodeUtf8 Text
clearTextPassword)

-- | Verify the password hash against a clear 'StrictByteString' password
--
-- This function purposefully takes some time to complete, in order to alleviate bruteforce attacks.
--
-- @since 0.0.1.0
verifyByteString :: PasswordHash -> StrictByteString -> Bool
verifyByteString :: PasswordHash -> StrictByteString -> Bool
verifyByteString (PasswordHash ForeignPtr CChar
fPtr) StrictByteString
clearTextPassword = IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  StrictByteString -> (CStringLen -> IO Bool) -> IO Bool
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
clearTextPassword ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    ForeignPtr CChar -> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CChar
fPtr ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
hashPtr -> do
      CInt
result <-
        Ptr CChar -> Ptr CChar -> CULLong -> IO CInt
cryptoPWHashStrVerify
          Ptr CChar
hashPtr
          Ptr CChar
cString
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen)
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0

-- | Convert a 'PasswordHash' to a 'StrictByteString'.
--
-- @since 0.0.1.0
passwordHashToByteString :: PasswordHash -> StrictByteString
passwordHashToByteString :: PasswordHash -> StrictByteString
passwordHashToByteString (PasswordHash ForeignPtr CChar
fPtr) = IO StrictByteString -> StrictByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO StrictByteString -> StrictByteString)
-> IO StrictByteString -> StrictByteString
forall a b. (a -> b) -> a -> b
$
  ForeignPtr CChar
-> (Ptr CChar -> IO StrictByteString) -> IO StrictByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CChar
fPtr ((Ptr CChar -> IO StrictByteString) -> IO StrictByteString)
-> (Ptr CChar -> IO StrictByteString) -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
hashPtr -> do
    StrictByteString
resultByteString <- CStringLen -> IO StrictByteString
BS.unsafePackCStringLen (Ptr CChar
hashPtr, forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
cryptoPWHashStrBytes)
    StrictByteString -> IO StrictByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString -> IO StrictByteString)
-> StrictByteString -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> StrictByteString -> StrictByteString
Char8.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL') StrictByteString
resultByteString

-- | Convert a 'PasswordHash' to a strict 'Text'.
--
-- @since 0.0.1.0
passwordHashToText :: PasswordHash -> Text
passwordHashToText :: PasswordHash -> Text
passwordHashToText PasswordHash
passwordHash =
  let bs :: StrictByteString
bs = PasswordHash -> StrictByteString
passwordHashToByteString PasswordHash
passwordHash
      (Text
prefix, StrictByteString
suffix) = StrictByteString -> (Text, StrictByteString)
Text.decodeASCIIPrefix StrictByteString
bs
   in case StrictByteString -> Maybe (Word8, StrictByteString)
BS.uncons StrictByteString
suffix of
        Maybe (Word8, StrictByteString)
Nothing -> Text
prefix
        Just (Word8
word, StrictByteString
_) ->
          let !errPos :: Int
errPos = StrictByteString -> Int
BS.length StrictByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- StrictByteString -> Int
BS.length StrictByteString
suffix
           in [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"decodeASCII: detected non-ASCII codepoint " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
word [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" at position " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
errPos [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
". " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> [Char]
forall a. Show a => a -> [Char]
show StrictByteString
bs

-- | Convert a 'PasswordHash' to a hexadecimal-encoded 'StrictByteString'.
--
-- It is recommended to use this one on a 'PasswordHash' produced by 'hashByteStringWithParams'.
--
-- @since 0.0.1.0
passwordHashToHexByteString :: PasswordHash -> StrictByteString
passwordHashToHexByteString :: PasswordHash -> StrictByteString
passwordHashToHexByteString = Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (PasswordHash -> Base16 StrictByteString)
-> PasswordHash
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> Base16 StrictByteString)
-> (PasswordHash -> StrictByteString)
-> PasswordHash
-> Base16 StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordHash -> StrictByteString
passwordHashToByteString

-- | Convert a 'PasswordHash' to a strict hexadecimal-encoded 'Text'.
--
-- It is recommended to use this one on a 'PasswordHash' produced by 'hashByteStringWithParams'.
--
-- @since 0.0.1.0
passwordHashToHexText :: PasswordHash -> Text
passwordHashToHexText :: PasswordHash -> Text
passwordHashToHexText = Base16 Text -> Text
forall a. Base16 a -> a
Base16.extractBase16 (Base16 Text -> Text)
-> (PasswordHash -> Base16 Text) -> PasswordHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 Text
Base16.encodeBase16 (StrictByteString -> Base16 Text)
-> (PasswordHash -> StrictByteString)
-> PasswordHash
-> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordHash -> StrictByteString
passwordHashToByteString

-- | Convert an ascii-encoded password hash to a 'PasswordHash'
--
-- This function does not perform ASCII validation.
--
-- @since 0.0.1.0
asciiTextToPasswordHash :: Text -> PasswordHash
asciiTextToPasswordHash :: Text -> PasswordHash
asciiTextToPasswordHash = StrictByteString -> PasswordHash
asciiByteStringToPasswordHash (StrictByteString -> PasswordHash)
-> (Text -> StrictByteString) -> Text -> PasswordHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
Text.encodeUtf8

-- | Convert an ascii-encoded password hash to a 'PasswordHash'
--
-- This function does not perform ASCII validation.
--
-- @since 0.0.1.0
asciiByteStringToPasswordHash :: StrictByteString -> PasswordHash
asciiByteStringToPasswordHash :: StrictByteString -> PasswordHash
asciiByteStringToPasswordHash StrictByteString
textualHash = IO PasswordHash -> PasswordHash
forall a. IO a -> a
unsafeDupablePerformIO (IO PasswordHash -> PasswordHash)
-> IO PasswordHash -> PasswordHash
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr CChar
destinationFPtr <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashStrBytes)
  ForeignPtr CChar
-> (Ptr CChar -> IO PasswordHash) -> IO PasswordHash
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CChar
destinationFPtr ((Ptr CChar -> IO PasswordHash) -> IO PasswordHash)
-> (Ptr CChar -> IO PasswordHash) -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
destinationPtr -> do
    StrictByteString
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen StrictByteString
textualHash ((CStringLen -> IO PasswordHash) -> IO PasswordHash)
-> (CStringLen -> IO PasswordHash) -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
sourcePtr, Int
len) -> do
      Ptr CChar -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
Foreign.fillBytes Ptr CChar
destinationPtr Word8
0 (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashStrBytes)
      Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyBytes Ptr CChar
destinationPtr Ptr CChar
sourcePtr Int
len
      PasswordHash -> IO PasswordHash
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PasswordHash -> IO PasswordHash)
-> PasswordHash -> IO PasswordHash
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> PasswordHash
PasswordHash ForeignPtr CChar
destinationFPtr

-- | The 'Salt' is used in conjunction with 'hashByteStringWithParams'
-- when you want to manually provide the piece of data that will
-- differentiate two fingerprints of the same password.
--
-- It is automatically taken care of for you when you use
-- 'hashByteString' or 'hashText'.
--
-- Use 'genSalt' to create a 'Salt' of size
-- equal to the constant 'cryptoPWHashSaltBytes'.
--
-- @since 0.0.1.0
newtype Salt = Salt StrictByteString
  deriving newtype
    ( Salt -> Salt -> Bool
(Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
/= :: Salt -> Salt -> Bool
Eq
      -- ^ @since 0.0.1.0
    , Eq Salt
Eq Salt =>
(Salt -> Salt -> Ordering)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> Ord Salt
Salt -> Salt -> Bool
Salt -> Salt -> Ordering
Salt -> Salt -> Salt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Salt -> Salt -> Ordering
compare :: Salt -> Salt -> Ordering
$c< :: Salt -> Salt -> Bool
< :: Salt -> Salt -> Bool
$c<= :: Salt -> Salt -> Bool
<= :: Salt -> Salt -> Bool
$c> :: Salt -> Salt -> Bool
> :: Salt -> Salt -> Bool
$c>= :: Salt -> Salt -> Bool
>= :: Salt -> Salt -> Bool
$cmax :: Salt -> Salt -> Salt
max :: Salt -> Salt -> Salt
$cmin :: Salt -> Salt -> Salt
min :: Salt -> Salt -> Salt
Ord
      -- ^ @since 0.0.1.0
    , Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> [Char]
(Int -> Salt -> ShowS)
-> (Salt -> [Char]) -> ([Salt] -> ShowS) -> Show Salt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Salt -> ShowS
showsPrec :: Int -> Salt -> ShowS
$cshow :: Salt -> [Char]
show :: Salt -> [Char]
$cshowList :: [Salt] -> ShowS
showList :: [Salt] -> ShowS
Show
      -- ^ @since 0.0.1.0
    )

-- |
--
-- @since 0.0.1.0
instance Display Salt where
  displayBuilder :: Salt -> Builder
displayBuilder Salt
salt = Text -> Builder
Builder.fromText (Text -> Builder) -> (Salt -> Text) -> Salt -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt -> Text
saltToHexText (Salt -> Builder) -> Salt -> Builder
forall a b. (a -> b) -> a -> b
$ Salt
salt

-- | Generate a random 'Salt' for password hashing
--
-- @since 0.0.1.0
genSalt :: IO Salt
genSalt :: IO Salt
genSalt =
  StrictByteString -> Salt
Salt
    (StrictByteString -> Salt) -> IO StrictByteString -> IO Salt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Ptr Word8 -> IO ()) -> IO StrictByteString
BS.create
      (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashSaltBytes)
      (Ptr Word8 -> CSize -> IO ()
`randombytesBuf` CSize
cryptoPWHashSaltBytes)

-- | Convert 'Salt' to underlying 'StrictByteString' binary.
--
-- @since 0.0.2.0
saltToBinary :: Salt -> StrictByteString
saltToBinary :: Salt -> StrictByteString
saltToBinary (Salt StrictByteString
bs) = StrictByteString
bs

-- | Convert 'Salt' to a strict hexadecimal-encoded 'Text'.
--
-- @since 0.0.2.0
saltToHexText :: Salt -> Text
saltToHexText :: Salt -> Text
saltToHexText = Base16 Text -> Text
forall a. Base16 a -> a
Base16.extractBase16 (Base16 Text -> Text) -> (Salt -> Base16 Text) -> Salt -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 Text
Base16.encodeBase16 (StrictByteString -> Base16 Text)
-> (Salt -> StrictByteString) -> Salt -> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt -> StrictByteString
saltToBinary

-- | Convert 'Salt' to a hexadecimal-encoded 'StrictByteString'.
--
-- @since 0.0.2.0
saltToHexByteString :: Salt -> StrictByteString
saltToHexByteString :: Salt -> StrictByteString
saltToHexByteString = Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (Salt -> Base16 StrictByteString) -> Salt -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> Base16 StrictByteString)
-> (Salt -> StrictByteString) -> Salt -> Base16 StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt -> StrictByteString
saltToBinary

-- | Convert 'StrictByteString' to 'Salt'.
--
-- The input salt must be of length 'cryptoPWHashSaltBytes'.
--
-- @since 0.0.2.0
binaryToSalt :: StrictByteString -> Maybe Salt
binaryToSalt :: StrictByteString -> Maybe Salt
binaryToSalt StrictByteString
bs =
  if StrictByteString -> Int
BS.length StrictByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashSaltBytes
    then Maybe Salt
forall a. Maybe a
Nothing
    else Salt -> Maybe Salt
forall a. a -> Maybe a
Just (StrictByteString -> Salt
Salt StrictByteString
bs)

-- | Convert a strict hexadecimal-encoded 'Text' to a 'Salt'.
--
-- The input salt, once decoded from base16, must be of length 'cryptoPWHashSaltBytes'.
--
-- @since 0.0.1.0
hexTextToSalt :: Text -> Maybe Salt
hexTextToSalt :: Text -> Maybe Salt
hexTextToSalt = StrictByteString -> Maybe Salt
hexByteStringToSalt (StrictByteString -> Maybe Salt)
-> (Text -> StrictByteString) -> Text -> Maybe Salt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
Text.encodeUtf8

-- | Convert a hexadecimal-encoded 'StrictByteString' to a 'Salt'.
--
-- The input salt, once decoded from base16, must be of length 'cryptoPWHashSaltBytes'.
--
-- @since 0.0.1.0
hexByteStringToSalt :: StrictByteString -> Maybe Salt
hexByteStringToSalt :: StrictByteString -> Maybe Salt
hexByteStringToSalt StrictByteString
hexByteString =
  case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped StrictByteString
hexByteString of
    Right StrictByteString
binary -> StrictByteString -> Maybe Salt
binaryToSalt StrictByteString
binary
    Left Text
_ -> Maybe Salt
forall a. Maybe a
Nothing

-- |
--
-- @since 0.0.1.0
data Argon2Params = Argon2Params
  { Argon2Params -> CULLong
opsLimit :: CULLong
  , Argon2Params -> CSize
memLimit :: CSize
  }

-- | These are the default parameters with which 'hashByteStringWithParams' can be invoked:
--
-- * /opsLimit/ = 'cryptoPWHashOpsLimitModerate'
-- * /memLimit/ = 'cryptoPWHashMemLimitModerate'
--
-- @since 0.0.1.0
defaultArgon2Params :: Argon2Params
defaultArgon2Params :: Argon2Params
defaultArgon2Params =
  Argon2Params
    { opsLimit :: CULLong
opsLimit = CULLong
cryptoPWHashOpsLimitModerate
    , memLimit :: CSize
memLimit = CSize
cryptoPWHashMemLimitModerate
    }