{-# LANGUAGE TypeApplications #-}

-- |
--
-- Module: Sel.Scrypt
-- Description: Hashing with the Scrypt algorithm.
-- Copyright: (C) Seth Paul Hubbard 2023
-- License: BSD-3-Clause
-- Maintainer: The Haskell Cryptography Group
-- Stability: Stable
-- Portability: GHC only
module Sel.Scrypt
  ( -- ** Introduction
    -- $introduction
    ScryptHash

    -- ** Password Hashing and Verifying.
  , scryptHashPassword
  , scryptVerifyPassword

    -- *** Conversion
  , scryptHashToByteString
  , scryptHashToText
  , asciiTextToScryptHash
  , asciiByteStringToScryptHash
  )
where

import Control.Monad (void)
import Data.ByteString (StrictByteString)
import qualified Data.ByteString.Internal as BS
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.Text as Text
import qualified Data.Text.Builder.Linear as Builder
import Data.Text.Display
import qualified Data.Text.Encoding as Text
import Foreign hiding (void)
import Foreign.C
import LibSodium.Bindings.Scrypt

import Sel.Internal
import Sel.Internal.Sodium (binaryToHex)

-- $introduction
--
-- This API is used for hashing and verifying passwords using the Scrypt algorithm.
-- This module is provided for interoperability with other applications. If you do
-- not need to use Scrypt specifically, use "Sel.Hashing.Password".

-- | A hashed password from the Scrypt algorithm.
--
-- @since 0.0.1.0
newtype ScryptHash = ScryptHash (ForeignPtr CChar)

-- | @since 0.0.1.0
instance Eq ScryptHash where
  (ScryptHash ForeignPtr CChar
sh1) == :: ScryptHash -> ScryptHash -> Bool
== (ScryptHash ForeignPtr CChar
sh2) =
    ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Bool
foreignPtrEq
      (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
sh1)
      (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
sh2)
      CSize
cryptoPWHashScryptSalsa208SHA256StrBytes

-- | @since 0.0.1.0
instance Ord ScryptHash where
  compare :: ScryptHash -> ScryptHash -> Ordering
compare (ScryptHash ForeignPtr CChar
sh1) (ScryptHash ForeignPtr CChar
sh2) =
    ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> Ordering
foreignPtrOrd
      (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
sh1)
      (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
sh2)
      CSize
cryptoPWHashScryptSalsa208SHA256StrBytes

-- | @since 0.0.1.0
instance Show ScryptHash where
  show :: ScryptHash -> String
show = Text -> String
Text.unpack (Text -> String) -> (ScryptHash -> Text) -> ScryptHash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScryptHash -> Text
scryptHashToText

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

-- | Hash the password with the Scrypt 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: "$7$C6..../....dLONLMz8YfO/.EKvzwOeqWVVLmXg62MC.hL1m1sYtO/$X9eNjVxdD4jHAhOVid3OLzNkpv6ADJSAXygOxXqGHg7\NUL"
--
-- @since 0.0.1.0
scryptHashPassword :: StrictByteString -> IO ScryptHash
scryptHashPassword :: StrictByteString -> IO ScryptHash
scryptHashPassword StrictByteString
bytestring = do
  StrictByteString -> (CStringLen -> IO ScryptHash) -> IO ScryptHash
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO ScryptHash) -> IO ScryptHash)
-> (CStringLen -> IO ScryptHash) -> IO ScryptHash
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    hashForeignPtr <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashScryptSalsa208SHA256StrBytes)
    withForeignPtr hashForeignPtr $ \Ptr CChar
hashPtr ->
      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
cryptoPWHashScryptSalsa208SHA256Str
          Ptr CChar
hashPtr
          Ptr CChar
cString
          (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cStringLen)
          (CSize -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoPWHashScryptSalsa208SHA256OpsLimitInteractive)
          CSize
cryptoPWHashScryptSalsa208SHA256MemLimitInteractive
    pure $ ScryptHash hashForeignPtr

-- | Verify a hashed password against a password verification string.
-- This returns True if successful.
--
-- @since 0.0.1.0
scryptVerifyPassword :: StrictByteString -> ScryptHash -> IO Bool
scryptVerifyPassword :: StrictByteString -> ScryptHash -> IO Bool
scryptVerifyPassword StrictByteString
bytestring (ScryptHash ForeignPtr CChar
sh) = do
  StrictByteString -> (CStringLen -> IO Bool) -> IO Bool
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen StrictByteString
bytestring ((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
withForeignPtr ForeignPtr CChar
sh ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
scryptHash -> do
      result <-
        Ptr CChar -> Ptr CChar -> CULLong -> IO CInt
cryptoPWHashScryptSalsa208SHA256StrVerify
          Ptr CChar
scryptHash
          Ptr CChar
cString
          (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cStringLen)
      return (result == 0)

-- | Convert a 'ScryptHash' to a binary 'StrictByteString' in constant time.
--
-- @since 0.0.1.0
scryptHashToByteString :: ScryptHash -> StrictByteString
scryptHashToByteString :: ScryptHash -> StrictByteString
scryptHashToByteString (ScryptHash ForeignPtr CChar
fPtr) =
  ForeignPtr CUChar -> CSize -> StrictByteString
binaryToHex (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
fPtr) CSize
cryptoPWHashScryptSalsa208SHA256StrBytes

-- | Convert a 'ScryptHash' to a hexadecimal-encoded 'Text'.
--
-- @since 0.0.1.0
scryptHashToText :: ScryptHash -> Text
scryptHashToText :: ScryptHash -> Text
scryptHashToText = StrictByteString -> Text
Text.decodeASCII (StrictByteString -> Text)
-> (ScryptHash -> StrictByteString) -> ScryptHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScryptHash -> StrictByteString
scryptHashToByteString

-- | Convert an ASCII-encoded password hash to a 'ScryptHash'
--
-- This function does not perform ASCII validation.
--
-- @since 0.0.1.0
asciiByteStringToScryptHash :: StrictByteString -> ScryptHash
asciiByteStringToScryptHash :: StrictByteString -> ScryptHash
asciiByteStringToScryptHash StrictByteString
textualHash =
  let (ForeignPtr Word8
fPtr, Int
_length) = StrictByteString -> (ForeignPtr Word8, Int)
BS.toForeignPtr0 StrictByteString
textualHash
   in ForeignPtr CChar -> ScryptHash
ScryptHash (forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr @Word8 @CChar ForeignPtr Word8
fPtr)

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