{-# 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 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 LibSodium.Bindings.Scrypt
import Sel.Internal
import System.IO.Unsafe (unsafeDupablePerformIO)

-- $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) =
    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
sh1 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) =
    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
sh1 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
    ForeignPtr CChar
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)
    ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
hashForeignPtr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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
    ScryptHash -> IO ScryptHash
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScryptHash -> IO ScryptHash) -> ScryptHash -> IO ScryptHash
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> ScryptHash
ScryptHash ForeignPtr CChar
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
      CInt
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)
      Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)

-- | Convert a 'ScryptHash' to a binary 'StrictByteString'.
--
-- @since 0.0.1.0
scryptHashToByteString :: ScryptHash -> StrictByteString
scryptHashToByteString :: ScryptHash -> StrictByteString
scryptHashToByteString (ScryptHash ForeignPtr CChar
fPtr) =
  ForeignPtr Word8 -> Int -> StrictByteString
BS.fromForeignPtr0 (ForeignPtr CChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr ForeignPtr CChar
fPtr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int 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