{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- SPDX-FileCopyrightText: 2020 Serokell
--
-- SPDX-License-Identifier: MPL-2.0

-- | Tools for hashing passwords.
module Crypto.Pwhash.Internal
  ( Algorithm (..)
  , Params (..)
  , Salt

  , pwhash
  ) where

import Prelude hiding (length)

import Data.ByteArray (ByteArrayAccess, length, withByteArray)
import Data.ByteArray.Sized (ByteArrayN, SizedByteArray, allocRet)
import Data.Proxy (Proxy (Proxy))
import Data.Word (Word64)
import GHC.TypeLits (type (<=), natVal)
import Foreign.C.Types (CInt, CSize (CSize), CULLong (CULLong))

import qualified Libsodium as Na


-- | Secure hashing algorithm.
data Algorithm
  = Argon2i_1_3 -- ^ Argon2i version 1.3
  | Argon2id_1_3 -- ^ Argon2id version 1.3
  deriving (Algorithm -> Algorithm -> Bool
(Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Bool) -> Eq Algorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Algorithm -> Algorithm -> Bool
$c/= :: Algorithm -> Algorithm -> Bool
== :: Algorithm -> Algorithm -> Bool
$c== :: Algorithm -> Algorithm -> Bool
Eq, Eq Algorithm
Eq Algorithm
-> (Algorithm -> Algorithm -> Ordering)
-> (Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Bool)
-> (Algorithm -> Algorithm -> Algorithm)
-> (Algorithm -> Algorithm -> Algorithm)
-> Ord Algorithm
Algorithm -> Algorithm -> Bool
Algorithm -> Algorithm -> Ordering
Algorithm -> Algorithm -> Algorithm
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
min :: Algorithm -> Algorithm -> Algorithm
$cmin :: Algorithm -> Algorithm -> Algorithm
max :: Algorithm -> Algorithm -> Algorithm
$cmax :: Algorithm -> Algorithm -> Algorithm
>= :: Algorithm -> Algorithm -> Bool
$c>= :: Algorithm -> Algorithm -> Bool
> :: Algorithm -> Algorithm -> Bool
$c> :: Algorithm -> Algorithm -> Bool
<= :: Algorithm -> Algorithm -> Bool
$c<= :: Algorithm -> Algorithm -> Bool
< :: Algorithm -> Algorithm -> Bool
$c< :: Algorithm -> Algorithm -> Bool
compare :: Algorithm -> Algorithm -> Ordering
$ccompare :: Algorithm -> Algorithm -> Ordering
$cp1Ord :: Eq Algorithm
Ord, Int -> Algorithm -> ShowS
[Algorithm] -> ShowS
Algorithm -> String
(Int -> Algorithm -> ShowS)
-> (Algorithm -> String)
-> ([Algorithm] -> ShowS)
-> Show Algorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Algorithm] -> ShowS
$cshowList :: [Algorithm] -> ShowS
show :: Algorithm -> String
$cshow :: Algorithm -> String
showsPrec :: Int -> Algorithm -> ShowS
$cshowsPrec :: Int -> Algorithm -> ShowS
Show)

algorithmToInt :: Algorithm -> CInt
algorithmToInt :: Algorithm -> CInt
algorithmToInt Algorithm
Argon2i_1_3 = CInt
Na.crypto_pwhash_alg_argon2i13
algorithmToInt Algorithm
Argon2id_1_3 = CInt
Na.crypto_pwhash_alg_argon2id13


-- | Secure-hashing parameters.
data Params = Params
  { Params -> Word64
opsLimit :: !Word64  -- ^ Maximum amount of computation to perform.
  , Params -> Word64
memLimit :: !Word64  -- ^ Maximum amount of RAM (bytes) to use.
  }
  deriving (Params -> Params -> Bool
(Params -> Params -> Bool)
-> (Params -> Params -> Bool) -> Eq Params
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Params -> Params -> Bool
$c/= :: Params -> Params -> Bool
== :: Params -> Params -> Bool
$c== :: Params -> Params -> Bool
Eq, Eq Params
Eq Params
-> (Params -> Params -> Ordering)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Bool)
-> (Params -> Params -> Params)
-> (Params -> Params -> Params)
-> Ord Params
Params -> Params -> Bool
Params -> Params -> Ordering
Params -> Params -> Params
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
min :: Params -> Params -> Params
$cmin :: Params -> Params -> Params
max :: Params -> Params -> Params
$cmax :: Params -> Params -> Params
>= :: Params -> Params -> Bool
$c>= :: Params -> Params -> Bool
> :: Params -> Params -> Bool
$c> :: Params -> Params -> Bool
<= :: Params -> Params -> Bool
$c<= :: Params -> Params -> Bool
< :: Params -> Params -> Bool
$c< :: Params -> Params -> Bool
compare :: Params -> Params -> Ordering
$ccompare :: Params -> Params -> Ordering
$cp1Ord :: Eq Params
Ord, Int -> Params -> ShowS
[Params] -> ShowS
Params -> String
(Int -> Params -> ShowS)
-> (Params -> String) -> ([Params] -> ShowS) -> Show Params
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Params] -> ShowS
$cshowList :: [Params] -> ShowS
show :: Params -> String
$cshow :: Params -> String
showsPrec :: Int -> Params -> ShowS
$cshowsPrec :: Int -> Params -> ShowS
Show)


-- | Salt used for password hashing.
--
-- This type is parametrised by the actual data type that contains
-- bytes. This can be, for example, a @ByteString@.
type Salt a = SizedByteArray Na.CRYPTO_PWHASH_SALTBYTES a


-- | Securely hash a password.
--
-- This is @crypto_pwhash@, it can be used for key derivation.
pwhash
  ::  forall passwd salt n hash.
      ( ByteArrayAccess passwd, ByteArrayAccess salt
      , ByteArrayN n hash
      , Na.CRYPTO_PWHASH_BYTES_MIN <= n, n <= Na.CRYPTO_PWHASH_BYTES_MAX
      )
  => Algorithm  -- ^ Hashing algorithm.
  -> Params  -- ^ Hashing parameters.
  -> passwd  -- ^ Password to hash.
  -> Salt salt  -- ^ Hashing salt.
  -> IO (Maybe hash)
pwhash :: Algorithm -> Params -> passwd -> Salt salt -> IO (Maybe hash)
pwhash Algorithm
alg Params{Word64
opsLimit :: Word64
opsLimit :: Params -> Word64
opsLimit, Word64
memLimit :: Word64
memLimit :: Params -> Word64
memLimit} passwd
passwd Salt salt
salt = do
  (CInt
ret, hash
hash) <-
    Proxy n -> (Ptr CUChar -> IO CInt) -> IO (CInt, hash)
forall (n :: Nat) c p a.
ByteArrayN n c =>
Proxy n -> (Ptr p -> IO a) -> IO (a, c)
allocRet (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n) ((Ptr CUChar -> IO CInt) -> IO (CInt, hash))
-> (Ptr CUChar -> IO CInt) -> IO (CInt, hash)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
hashPtr ->
    passwd -> (Ptr CChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray passwd
passwd ((Ptr CChar -> IO CInt) -> IO CInt)
-> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
passwdPtr ->
    Salt salt -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray Salt salt
salt ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
saltPtr -> do
      Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> (Any ::: CULLong)
-> (Any ::: CSize)
-> CInt
-> IO CInt
forall k1 k2 k3 k4 k5 k6 k7 k8 (out :: k1) (outlen :: k2)
       (passwd :: k3) (passwdlen :: k4) (salt :: k5) (opslimit :: k6)
       (memlimit :: k7) (alg :: k8).
Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> (Any ::: CULLong)
-> (Any ::: CSize)
-> CInt
-> IO CInt
Na.crypto_pwhash Ptr CUChar
hashPtr (Integer -> Any ::: CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Any ::: CULLong) -> Integer -> Any ::: CULLong
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n))
        Ptr CChar
passwdPtr (Int -> Any ::: CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Any ::: CULLong) -> Int -> Any ::: CULLong
forall a b. (a -> b) -> a -> b
$ passwd -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length passwd
passwd)
        Ptr CUChar
saltPtr
        (Word64 -> Any ::: CULLong
CULLong Word64
opsLimit) (Word64 -> Any ::: CSize
CSize Word64
memLimit) (Algorithm -> CInt
algorithmToInt Algorithm
alg)
  if CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then
    Maybe hash -> IO (Maybe hash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe hash -> IO (Maybe hash)) -> Maybe hash -> IO (Maybe hash)
forall a b. (a -> b) -> a -> b
$ hash -> Maybe hash
forall a. a -> Maybe a
Just hash
hash
  else
    Maybe hash -> IO (Maybe hash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe hash -> IO (Maybe hash)) -> Maybe hash -> IO (Maybe hash)
forall a b. (a -> b) -> a -> b
$ Maybe hash
forall a. Maybe a
Nothing