{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings,
    RecordWildCards, NamedFieldPuns #-}

-- |Scrypt is a sequential memory-hard key derivation function. This module
--  provides low-level bindings to the 'scrypt' key derivation function as
--  well as a higher-level password-storage API. It is based on a fast C
--  implementation of scrypt, written by Colin Percival. For further
--  information see <http://www.tarsnap.com/scrypt.html>.
--
module Crypto.Scrypt (
    -- * Parameters to the @scrypt@ function
    -- $params
     ScryptParams, scryptParams, scryptParamsLen, defaultParams
    -- * Password Storage
    -- $password-storage
    , EncryptedPass(..), encryptPassIO, encryptPassIO'
    , newSalt, encryptPass, encryptPass'
    , verifyPass, verifyPass'
    -- * Low-level bindings to the @scrypt@ key derivation function
    -- $low-level
    , Pass(..), Salt(..), PassHash(..), scrypt, scrypt'
    ) where

import Control.Applicative
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Foreign (Ptr, Word8, Word32, Word64, allocaBytes, castPtr)
import Foreign.C
import System.Entropy (getEntropy)
import System.IO.Unsafe (unsafePerformIO)


newtype Pass          = Pass     { Pass -> ByteString
getPass :: B.ByteString } deriving (Int -> Pass -> ShowS
[Pass] -> ShowS
Pass -> String
(Int -> Pass -> ShowS)
-> (Pass -> String) -> ([Pass] -> ShowS) -> Show Pass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pass] -> ShowS
$cshowList :: [Pass] -> ShowS
show :: Pass -> String
$cshow :: Pass -> String
showsPrec :: Int -> Pass -> ShowS
$cshowsPrec :: Int -> Pass -> ShowS
Show, Pass -> Pass -> Bool
(Pass -> Pass -> Bool) -> (Pass -> Pass -> Bool) -> Eq Pass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pass -> Pass -> Bool
$c/= :: Pass -> Pass -> Bool
== :: Pass -> Pass -> Bool
$c== :: Pass -> Pass -> Bool
Eq)
newtype Salt          = Salt     { Salt -> ByteString
getSalt :: B.ByteString } deriving (Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> String
(Int -> Salt -> ShowS)
-> (Salt -> String) -> ([Salt] -> ShowS) -> Show Salt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Salt] -> ShowS
$cshowList :: [Salt] -> ShowS
show :: Salt -> String
$cshow :: Salt -> String
showsPrec :: Int -> Salt -> ShowS
$cshowsPrec :: Int -> Salt -> ShowS
Show, Salt -> Salt -> Bool
(Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c== :: Salt -> Salt -> Bool
Eq)
newtype PassHash      = PassHash { PassHash -> ByteString
getHash :: B.ByteString } deriving (Int -> PassHash -> ShowS
[PassHash] -> ShowS
PassHash -> String
(Int -> PassHash -> ShowS)
-> (PassHash -> String) -> ([PassHash] -> ShowS) -> Show PassHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PassHash] -> ShowS
$cshowList :: [PassHash] -> ShowS
show :: PassHash -> String
$cshow :: PassHash -> String
showsPrec :: Int -> PassHash -> ShowS
$cshowsPrec :: Int -> PassHash -> ShowS
Show, PassHash -> PassHash -> Bool
(PassHash -> PassHash -> Bool)
-> (PassHash -> PassHash -> Bool) -> Eq PassHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PassHash -> PassHash -> Bool
$c/= :: PassHash -> PassHash -> Bool
== :: PassHash -> PassHash -> Bool
$c== :: PassHash -> PassHash -> Bool
Eq)
newtype EncryptedPass =
    EncryptedPass { EncryptedPass -> ByteString
getEncryptedPass  :: B.ByteString } deriving (Int -> EncryptedPass -> ShowS
[EncryptedPass] -> ShowS
EncryptedPass -> String
(Int -> EncryptedPass -> ShowS)
-> (EncryptedPass -> String)
-> ([EncryptedPass] -> ShowS)
-> Show EncryptedPass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptedPass] -> ShowS
$cshowList :: [EncryptedPass] -> ShowS
show :: EncryptedPass -> String
$cshow :: EncryptedPass -> String
showsPrec :: Int -> EncryptedPass -> ShowS
$cshowsPrec :: Int -> EncryptedPass -> ShowS
Show, EncryptedPass -> EncryptedPass -> Bool
(EncryptedPass -> EncryptedPass -> Bool)
-> (EncryptedPass -> EncryptedPass -> Bool) -> Eq EncryptedPass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptedPass -> EncryptedPass -> Bool
$c/= :: EncryptedPass -> EncryptedPass -> Bool
== :: EncryptedPass -> EncryptedPass -> Bool
$c== :: EncryptedPass -> EncryptedPass -> Bool
Eq)

------------------------------------------------------------------------------
-- $params
--
-- Scrypt takes three tuning parameters: @N@, @r@ and @p@. They affect running
-- time and memory usage:
--
-- /Memory usage/ is approximately @128*r*N@ bytes. Note that the
-- 'scryptParams' function takes @log_2(N)@ as a parameter. As an example,
-- the 'defaultParams'
--
-- >   log_2(N) = 14, r = 8 and p = 1
--
-- lead to 'scrypt' using @128 * 8 * 2^14 = 16M@ bytes of memory.
--
-- /Running time/ is proportional to all of @N@, @r@ and @p@. Since it's
-- influence on memory usage is small, @p@ can be used to independently tune
-- the running time.

-- |Encapsulates the three tuning parameters to the 'scrypt' function: @N@,
-- @r@ and @p@ (see above) as well es the length of the derived key.
--
data ScryptParams = Params { ScryptParams -> Integer
logN, ScryptParams -> Integer
r, ScryptParams -> Integer
p, ScryptParams -> Integer
bufLen :: Integer} deriving (ScryptParams -> ScryptParams -> Bool
(ScryptParams -> ScryptParams -> Bool)
-> (ScryptParams -> ScryptParams -> Bool) -> Eq ScryptParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScryptParams -> ScryptParams -> Bool
$c/= :: ScryptParams -> ScryptParams -> Bool
== :: ScryptParams -> ScryptParams -> Bool
$c== :: ScryptParams -> ScryptParams -> Bool
Eq, Int -> ScryptParams -> ShowS
[ScryptParams] -> ShowS
ScryptParams -> String
(Int -> ScryptParams -> ShowS)
-> (ScryptParams -> String)
-> ([ScryptParams] -> ShowS)
-> Show ScryptParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScryptParams] -> ShowS
$cshowList :: [ScryptParams] -> ShowS
show :: ScryptParams -> String
$cshow :: ScryptParams -> String
showsPrec :: Int -> ScryptParams -> ShowS
$cshowsPrec :: Int -> ScryptParams -> ShowS
Show)

-- |Constructor function for 'ScryptParams' with default derived-key-length of
--  64 bytes.
scryptParams
    :: Integer
    -- ^ @log_2(N)@. Scrypt's @N@ parameter must be a power of two greater
    --   than one, thus it's logarithm to base two must be greater than zero.
    --   @128*r*N@ must be smaller than the available memory address space.
    -> Integer
    -- ^ @r@, must be greater than zero.
    -> Integer
    -- ^ @p@, must be greater than zero. @r@ and @p@
    --   must satisfy @r*p < 2^30@.
    -> Maybe ScryptParams
    -- ^ Returns 'Just' the parameter object for valid arguments,
    --   otherwise 'Nothing'.
    --
scryptParams :: Integer -> Integer -> Integer -> Maybe ScryptParams
scryptParams Integer
logN Integer
r Integer
p = Integer -> Integer -> Integer -> Integer -> Maybe ScryptParams
scryptParamsLen Integer
logN Integer
r Integer
p Integer
64

-- |Constructor function for 'ScryptParams' with an additional parameter to
--  control the length of the derived key. Only use this function if you are
--  sure you need control over the length of the derived key. Use 'scryptParams'
--  instead.
--
scryptParamsLen
    :: Integer -- ^ @log_2(N)@,
    -> Integer -- ^ @r@,
    -> Integer -- ^ @p@,
    -> Integer
    -- ^ Length of the derived key (the output of 'scrypt') in bytes.
    --   Must be greater than zero and less than or equal to @(2^32-1)*32@.
    -> Maybe ScryptParams
scryptParamsLen :: Integer -> Integer -> Integer -> Integer -> Maybe ScryptParams
scryptParamsLen Integer
logN Integer
r Integer
p Integer
bufLen
    | Bool
valid     = ScryptParams -> Maybe ScryptParams
forall a. a -> Maybe a
Just Params :: Integer -> Integer -> Integer -> Integer -> ScryptParams
Params { Integer
logN :: Integer
logN :: Integer
logN, Integer
r :: Integer
r :: Integer
r, Integer
p :: Integer
p :: Integer
p, Integer
bufLen :: Integer
bufLen :: Integer
bufLen }
    | Bool
otherwise = Maybe ScryptParams
forall a. Maybe a
Nothing
  where
    valid :: Bool
valid = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Integer
logN Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0, Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0, Integer
p Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
                , Integer
rInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
p Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
30 :: Int)
                , Integer
bufLen Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0, Integer
bufLen Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32 :: Int)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
32
                -- allocation fits into (virtual) memory
                , Integer
128Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
rInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
logN Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= CSize -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize
forall a. Bounded a => a
maxBound :: CSize)
                ]

-- |Default parameters as recommended in the scrypt paper:
--
--  >   N = 2^14, r = 8, p = 1
--
--  Equivalent to @'fromJust' ('scryptParams' 14 8 1)@.
--
defaultParams :: ScryptParams
defaultParams :: ScryptParams
defaultParams = Maybe ScryptParams -> ScryptParams
forall a. HasCallStack => Maybe a -> a
fromJust (Integer -> Integer -> Integer -> Maybe ScryptParams
scryptParams Integer
14 Integer
8 Integer
1)

------------------------------------------------------------------------------
-- $password-storage
--
-- To allow storing encrypted passwords conveniently in a single database
-- column, the password storage API provides the data type 'EncryptedPass'. It
-- combines a 'Pass' as well as the 'Salt' and 'ScryptParams' used to compute
-- it into a single 'ByteString', separated by pipe (\"|\") characters. The
-- 'Salt' and 'PassHash' are base64-encoded. Storing the 'ScryptParams' with 
-- the password allows to gradually strengthen password encryption in case of
-- changing security requirements.
--
-- A usage example is given below, showing encryption, verification and
-- changing 'ScryptParams':
--
-- > >>> encrypted <- encryptPassIO defaultParams (Pass "secret")
-- > >>> print encrypted
-- > EncryptedPass {getEncryptedPass = "14|8|1|Wn5x[SNIP]nM=|Zl+p[SNIP]g=="}
-- > >>> print $ verifyPass defaultParams (Pass "secret") encrypted
-- > (True,Nothing)
-- > >>> print $ verifyPass defaultParams (Pass "wrong") encrypted
-- > (False,Nothing)
-- > >>> let newParams = fromJust $ scryptParams 16 8 1
-- > >>> print $ verifyPass newParams (Pass "secret") encrypted
-- > (True,Just (EncryptedPass {getEncryptedPass = "16|8|1|Wn5x[SNIP]nM=|ZmWw[SNIP]Q=="}))
--

combine :: ScryptParams -> Salt -> PassHash -> EncryptedPass
combine :: ScryptParams -> Salt -> PassHash -> EncryptedPass
combine Params{Integer
bufLen :: Integer
p :: Integer
r :: Integer
logN :: Integer
bufLen :: ScryptParams -> Integer
p :: ScryptParams -> Integer
r :: ScryptParams -> Integer
logN :: ScryptParams -> Integer
..} (Salt ByteString
salt) (PassHash ByteString
passHash) =
    ByteString -> EncryptedPass
EncryptedPass (ByteString -> EncryptedPass) -> ByteString -> EncryptedPass
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"|"
        [ Integer -> ByteString
showBS Integer
logN, Integer -> ByteString
showBS Integer
r, Integer -> ByteString
showBS Integer
p
        , ByteString -> ByteString
Base64.encode ByteString
salt, ByteString -> ByteString
Base64.encode ByteString
passHash]
  where
    showBS :: Integer -> ByteString
showBS = String -> ByteString
B.pack (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

separate :: EncryptedPass -> Maybe (ScryptParams, Salt, PassHash)
separate :: EncryptedPass -> Maybe (ScryptParams, Salt, PassHash)
separate = [ByteString] -> Maybe (ScryptParams, Salt, PassHash)
go ([ByteString] -> Maybe (ScryptParams, Salt, PassHash))
-> (EncryptedPass -> [ByteString])
-> EncryptedPass
-> Maybe (ScryptParams, Salt, PassHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
B.split Char
'|' (ByteString -> [ByteString])
-> (EncryptedPass -> ByteString) -> EncryptedPass -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncryptedPass -> ByteString
getEncryptedPass
  where
    go :: [ByteString] -> Maybe (ScryptParams, Salt, PassHash)
go [ByteString
logN', ByteString
r', ByteString
p', ByteString
salt', ByteString
hash'] = do
        [ByteString
salt, ByteString
hash] <- (ByteString -> Maybe ByteString)
-> [ByteString] -> Maybe [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Maybe ByteString
decodeBase64 [ByteString
salt', ByteString
hash']
        [Integer
logN, Integer
r, Integer
p] <- (ByteString -> Maybe Integer) -> [ByteString] -> Maybe [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Integer, ByteString) -> Integer)
-> Maybe (Integer, ByteString) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, ByteString) -> Integer
forall a b. (a, b) -> a
fst (Maybe (Integer, ByteString) -> Maybe Integer)
-> (ByteString -> Maybe (Integer, ByteString))
-> ByteString
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Integer, ByteString)
B.readInteger) [ByteString
logN', ByteString
r', ByteString
p']
        let bufLen :: Integer
bufLen = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
hash)
        ScryptParams
params       <- Integer -> Integer -> Integer -> Integer -> Maybe ScryptParams
scryptParamsLen Integer
logN Integer
r Integer
p Integer
bufLen
        (ScryptParams, Salt, PassHash)
-> Maybe (ScryptParams, Salt, PassHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScryptParams
params, ByteString -> Salt
Salt ByteString
salt, ByteString -> PassHash
PassHash ByteString
hash)
    go [ByteString]
_         = Maybe (ScryptParams, Salt, PassHash)
forall a. Maybe a
Nothing
    decodeBase64 :: ByteString -> Maybe ByteString
decodeBase64 = (String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base64.decode

-- |Generate a random 32-byte salt.
--
newSalt :: IO Salt
newSalt :: IO Salt
newSalt = ByteString -> Salt
Salt (ByteString -> Salt) -> IO ByteString -> IO Salt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
getEntropy Int
32

-- |Encrypt the password with the given parameters and a random 32-byte salt.
-- The salt is read from @\/dev\/urandom@ on Unix systems or @CryptoAPI@ on
-- Windows.
--
encryptPassIO :: ScryptParams -> Pass -> IO EncryptedPass
encryptPassIO :: ScryptParams -> Pass -> IO EncryptedPass
encryptPassIO ScryptParams
params Pass
pass = do
    Salt
salt <- IO Salt
newSalt
    EncryptedPass -> IO EncryptedPass
forall (m :: * -> *) a. Monad m => a -> m a
return (EncryptedPass -> IO EncryptedPass)
-> EncryptedPass -> IO EncryptedPass
forall a b. (a -> b) -> a -> b
$ ScryptParams -> Salt -> Pass -> EncryptedPass
encryptPass ScryptParams
params Salt
salt Pass
pass

-- |Equivalent to @encryptPassIO defaultParams@.
--
encryptPassIO' :: Pass -> IO EncryptedPass
encryptPassIO' :: Pass -> IO EncryptedPass
encryptPassIO' = ScryptParams -> Pass -> IO EncryptedPass
encryptPassIO ScryptParams
defaultParams

-- |Encrypt the password with the given parameters and salt.
--
encryptPass :: ScryptParams -> Salt -> Pass -> EncryptedPass
encryptPass :: ScryptParams -> Salt -> Pass -> EncryptedPass
encryptPass ScryptParams
params Salt
salt Pass
pass = ScryptParams -> Salt -> PassHash -> EncryptedPass
combine ScryptParams
params Salt
salt (ScryptParams -> Salt -> Pass -> PassHash
scrypt ScryptParams
params Salt
salt Pass
pass)

-- |Equivalent to @encryptPass defaultParams@.
--
encryptPass' :: Salt -> Pass -> EncryptedPass
encryptPass' :: Salt -> Pass -> EncryptedPass
encryptPass' = ScryptParams -> Salt -> Pass -> EncryptedPass
encryptPass ScryptParams
defaultParams

-- |Verify a 'Pass' against an 'EncryptedPass'. The function also takes
--  'ScryptParams' meeting your current security requirements. In case the
--  'EncryptedPass' was generated with different parameters, the function
--  returns an updated 'EncryptedPass', generated with the given 
--  'ScryptParams'. The 'Salt' is kept from the given 'EncryptedPass'.
--
verifyPass
    :: ScryptParams
    -- ^ Parameters to use for updating the 'EncryptedPass'.
    -> Pass
    -- ^ The candidate 'Pass'.
    -> EncryptedPass
    -- ^ The 'EncryptedPass' to check against.
    -> (Bool, Maybe EncryptedPass)
    -- ^ Returns a pair of
    --
    --     * 'Bool' indicating verification success or failure.
    --
    --     * 'Just' a /new/ 'EncryptedPass' if the given 'ScryptParams' are
    --      different from those encapsulated in the /given/ 'EncryptedPass',
    --      otherwise 'Nothing'.
    --
verifyPass :: ScryptParams
-> Pass -> EncryptedPass -> (Bool, Maybe EncryptedPass)
verifyPass ScryptParams
newParams Pass
candidate EncryptedPass
encrypted =
    (Bool, Maybe EncryptedPass)
-> ((ScryptParams, Salt, PassHash) -> (Bool, Maybe EncryptedPass))
-> Maybe (ScryptParams, Salt, PassHash)
-> (Bool, Maybe EncryptedPass)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False, Maybe EncryptedPass
forall a. Maybe a
Nothing) (ScryptParams, Salt, PassHash) -> (Bool, Maybe EncryptedPass)
verify (EncryptedPass -> Maybe (ScryptParams, Salt, PassHash)
separate EncryptedPass
encrypted)
  where
    verify :: (ScryptParams, Salt, PassHash) -> (Bool, Maybe EncryptedPass)
verify (ScryptParams
params,Salt
salt,PassHash
hash) =
        let valid :: Bool
valid   = ScryptParams -> Salt -> Pass -> PassHash
scrypt ScryptParams
params Salt
salt Pass
candidate PassHash -> PassHash -> Bool
forall a. Eq a => a -> a -> Bool
== PassHash
hash
            newHash :: PassHash
newHash = ScryptParams -> Salt -> Pass -> PassHash
scrypt ScryptParams
newParams Salt
salt Pass
candidate
            newEncr :: Maybe EncryptedPass
newEncr = if Bool -> Bool
not Bool
valid Bool -> Bool -> Bool
|| ScryptParams
params ScryptParams -> ScryptParams -> Bool
forall a. Eq a => a -> a -> Bool
== ScryptParams
newParams
                        then Maybe EncryptedPass
forall a. Maybe a
Nothing
                        else EncryptedPass -> Maybe EncryptedPass
forall a. a -> Maybe a
Just (ScryptParams -> Salt -> PassHash -> EncryptedPass
combine ScryptParams
newParams Salt
salt PassHash
newHash)
        in (Bool
valid, Maybe EncryptedPass
newEncr)

-- |Check the 'Pass' against the 'EncryptedPass', using the 'ScryptParams'
--  encapsulated in the 'EncryptedPass'.
--
verifyPass' :: Pass -> EncryptedPass -> Bool
-- We never evaluate an eventual new 'EncryptedPass' from 'verifyPass', so it is
-- safe to pass 'undefined' to verifyPass.
verifyPass' :: Pass -> EncryptedPass -> Bool
verifyPass' Pass
pass EncryptedPass
encrypted = (Bool, Maybe EncryptedPass) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Maybe EncryptedPass) -> Bool)
-> (Bool, Maybe EncryptedPass) -> Bool
forall a b. (a -> b) -> a -> b
$ ScryptParams
-> Pass -> EncryptedPass -> (Bool, Maybe EncryptedPass)
verifyPass ScryptParams
forall a. HasCallStack => a
undefined Pass
pass EncryptedPass
encrypted

------------------------------------------------------------------------------
-- $low-level
--
-- Bindings to a fast C implementation of 'scrypt'. For password storage,
-- consider using the more convenient higher-level API above.
--

-- |Calculates a hash from the given password, salt and parameters.
--
scrypt :: ScryptParams -> Salt -> Pass -> PassHash
scrypt :: ScryptParams -> Salt -> Pass -> PassHash
scrypt Params{Integer
bufLen :: Integer
p :: Integer
r :: Integer
logN :: Integer
bufLen :: ScryptParams -> Integer
p :: ScryptParams -> Integer
r :: ScryptParams -> Integer
logN :: ScryptParams -> Integer
..} (Salt ByteString
salt) (Pass ByteString
pass) =
    ByteString -> PassHash
PassHash (ByteString -> PassHash)
-> (IO ByteString -> ByteString) -> IO ByteString -> PassHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> PassHash) -> IO ByteString -> PassHash
forall a b. (a -> b) -> a -> b
$
        ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
salt ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
saltPtr, Int
saltLen) ->
        ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
pass ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
passPtr, Int
passLen) ->
        Int -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bufLen) ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bufPtr -> do
            String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"crypto_scrypt" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Word64
-> Word32
-> Word32
-> Ptr Word8
-> CSize
-> IO CInt
crypto_scrypt
                (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen)
                (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
saltPtr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
saltLen)
                (Word64
2Word64 -> Integer -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
logN) (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r) (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
p)
                Ptr Word8
bufPtr (Integer -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bufLen)
            CStringLen -> IO ByteString
B.packCStringLen (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
bufPtr, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
bufLen)

foreign import ccall unsafe crypto_scrypt
    :: Ptr Word8 -> CSize         -- password
    -> Ptr Word8 -> CSize         -- salt
    -> Word64 -> Word32 -> Word32 -- N, r, p
    -> Ptr Word8 -> CSize         -- result buffer
    -> IO CInt

-- |Note the prime symbol (\'). Calls 'scrypt' with 'defaultParams'.
--
scrypt' :: Salt -> Pass -> PassHash
scrypt' :: Salt -> Pass -> PassHash
scrypt' = ScryptParams -> Salt -> Pass -> PassHash
scrypt ScryptParams
defaultParams