{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Trustworthy #-}
module Crypto.Argon2
(
hash
, hashEncoded
, verifyEncoded
, HashOptions(..)
, Argon2Variant(..)
, Argon2Version(..)
, defaultHashOptions
, Argon2Status(..)
) where
import Control.DeepSeq (NFData (rnf))
import Control.Exception
import qualified Crypto.Argon2.FFI as FFI
import qualified Data.ByteString as BS
import qualified Data.Text.Short as TS
import Data.Typeable
import Foreign
import Foreign.C
import GHC.Generics (Generic)
import System.IO.Unsafe (unsafePerformIO)
data Argon2Variant
= Argon2i
| Argon2d
| Argon2id
deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum)
instance NFData Argon2Variant where rnf !_ = ()
toArgon2Type :: Argon2Variant -> FFI.Argon2_type
toArgon2Type Argon2i = FFI.Argon2_i
toArgon2Type Argon2d = FFI.Argon2_d
toArgon2Type Argon2id = FFI.Argon2_id
data Argon2Version
= Argon2Version10
| Argon2Version13
deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum)
instance NFData Argon2Version where rnf !_ = ()
toArgon2Ver :: Argon2Version -> FFI.Argon2_version
toArgon2Ver Argon2Version10 = FFI.ARGON2_VERSION_10
toArgon2Ver Argon2Version13 = FFI.ARGON2_VERSION_13
data HashOptions =
HashOptions { hashIterations :: !Word32
, hashMemory :: !Word32
, hashParallelism :: !Word32
, hashVariant :: !Argon2Variant
, hashVersion :: !Argon2Version
, hashLength :: !Word32
}
deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable)
instance NFData HashOptions where rnf !_ = ()
defaultHashOptions :: HashOptions
defaultHashOptions = HashOptions
{ hashIterations = 3
, hashMemory = 2 ^ (12 :: Int)
, hashParallelism = 1
, hashVariant = Argon2i
, hashVersion = Argon2Version13
, hashLength = 32
}
hash :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> Either Argon2Status BS.ByteString
hash options password salt = unsafePerformIO $ try $ hash' options password salt
hashEncoded :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> Either Argon2Status TS.ShortText
hashEncoded options password salt = unsafePerformIO $ try $ hashEncoded' options password salt
verifyEncoded :: TS.ShortText -> BS.ByteString -> Argon2Status
verifyEncoded encoded password
| "$argon2id$" `TS.isPrefixOf` encoded = unsafePerformIO $ go FFI.Argon2_id
| "$argon2i$" `TS.isPrefixOf` encoded = unsafePerformIO $ go FFI.Argon2_i
| "$argon2d$" `TS.isPrefixOf` encoded = unsafePerformIO $ go FFI.Argon2_d
| otherwise = Argon2DecodingFail
where
go v = BS.useAsCString password $ \pwd ->
BS.useAsCString (TS.toByteString encoded) $ \enc ->
toArgon2Status <$> FFI.argon2_verify enc pwd (fromIntegral (BS.length password)) v
data Argon2Status
= Argon2Ok
| Argon2OutputPtrNull
| Argon2OutputTooShort
| Argon2OutputTooLong
| Argon2PwdTooShort
| Argon2PwdTooLong
| Argon2SaltTooShort
| Argon2SaltTooLong
| Argon2AdTooShort
| Argon2AdTooLong
| Argon2SecretTooShort
| Argon2SecretTooLong
| Argon2TimeTooSmall
| Argon2TimeTooLarge
| Argon2MemoryTooLittle
| Argon2MemoryTooMuch
| Argon2LanesTooFew
| Argon2LanesTooMany
| Argon2PwdPtrMismatch
| Argon2SaltPtrMismatch
| Argon2SecretPtrMismatch
| Argon2AdPtrMismatch
| Argon2MemoryAllocationError
| Argon2FreeMemoryCbkNull
| Argon2AllocateMemoryCbkNull
| Argon2IncorrectParameter
| Argon2IncorrectType
| Argon2OutPtrMismatch
| Argon2ThreadsTooFew
| Argon2ThreadsTooMany
| Argon2MissingArgs
| Argon2EncodingFail
| Argon2DecodingFail
| Argon2ThreadFail
| Argon2DecodingLengthFail
| Argon2VerifyMismatch
| Argon2InternalError
deriving (Typeable,Eq,Ord,Read,Show,Enum,Bounded)
instance NFData Argon2Status where rnf !_ = ()
instance Exception Argon2Status
toArgon2Status :: CInt -> Argon2Status
toArgon2Status = \case
FFI.ARGON2_OK -> Argon2Ok
FFI.ARGON2_OUTPUT_PTR_NULL -> Argon2OutputPtrNull
FFI.ARGON2_OUTPUT_TOO_SHORT -> Argon2OutputTooShort
FFI.ARGON2_OUTPUT_TOO_LONG -> Argon2OutputTooLong
FFI.ARGON2_PWD_TOO_SHORT -> Argon2PwdTooShort
FFI.ARGON2_PWD_TOO_LONG -> Argon2PwdTooLong
FFI.ARGON2_SALT_TOO_SHORT -> Argon2SaltTooShort
FFI.ARGON2_SALT_TOO_LONG -> Argon2SaltTooLong
FFI.ARGON2_AD_TOO_SHORT -> Argon2AdTooShort
FFI.ARGON2_AD_TOO_LONG -> Argon2AdTooLong
FFI.ARGON2_SECRET_TOO_SHORT -> Argon2SecretTooShort
FFI.ARGON2_SECRET_TOO_LONG -> Argon2SecretTooLong
FFI.ARGON2_TIME_TOO_SMALL -> Argon2TimeTooSmall
FFI.ARGON2_TIME_TOO_LARGE -> Argon2TimeTooLarge
FFI.ARGON2_MEMORY_TOO_LITTLE -> Argon2MemoryTooLittle
FFI.ARGON2_MEMORY_TOO_MUCH -> Argon2MemoryTooMuch
FFI.ARGON2_LANES_TOO_FEW -> Argon2LanesTooFew
FFI.ARGON2_LANES_TOO_MANY -> Argon2LanesTooMany
FFI.ARGON2_PWD_PTR_MISMATCH -> Argon2PwdPtrMismatch
FFI.ARGON2_SALT_PTR_MISMATCH -> Argon2SaltPtrMismatch
FFI.ARGON2_SECRET_PTR_MISMATCH -> Argon2SecretPtrMismatch
FFI.ARGON2_AD_PTR_MISMATCH -> Argon2AdPtrMismatch
FFI.ARGON2_MEMORY_ALLOCATION_ERROR -> Argon2MemoryAllocationError
FFI.ARGON2_FREE_MEMORY_CBK_NULL -> Argon2FreeMemoryCbkNull
FFI.ARGON2_ALLOCATE_MEMORY_CBK_NULL -> Argon2AllocateMemoryCbkNull
FFI.ARGON2_INCORRECT_PARAMETER -> Argon2IncorrectParameter
FFI.ARGON2_INCORRECT_TYPE -> Argon2IncorrectType
FFI.ARGON2_OUT_PTR_MISMATCH -> Argon2OutPtrMismatch
FFI.ARGON2_THREADS_TOO_FEW -> Argon2ThreadsTooFew
FFI.ARGON2_THREADS_TOO_MANY -> Argon2ThreadsTooMany
FFI.ARGON2_MISSING_ARGS -> Argon2MissingArgs
FFI.ARGON2_ENCODING_FAIL -> Argon2EncodingFail
FFI.ARGON2_DECODING_FAIL -> Argon2DecodingFail
FFI.ARGON2_THREAD_FAIL -> Argon2ThreadFail
FFI.ARGON2_DECODING_LENGTH_FAIL -> Argon2DecodingLengthFail
FFI.ARGON2_VERIFY_MISMATCH -> Argon2VerifyMismatch
_ -> Argon2InternalError
hashEncoded' :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> IO TS.ShortText
hashEncoded' HashOptions{..} password salt =
allocaBytes (fromIntegral outLen) $ \out -> do
res <- BS.useAsCString password $ \password' ->
BS.useAsCString salt $ \salt' ->
FFI.argon2_hash
hashIterations
hashMemory
hashParallelism
password'
passwordLen
salt'
(fromIntegral saltLen)
nullPtr
(fromIntegral hashLength)
out
outLen
(toArgon2Type hashVariant)
(toArgon2Ver hashVersion)
handleSuccessCode res
res' <- TS.fromByteString <$> BS.packCString out
case res' of
Nothing -> throwIO Argon2InternalError
Just t -> evaluate t
where
!outLen = FFI.argon2_encodedlen
hashIterations
hashMemory
hashParallelism
saltLen
hashLength
(toArgon2Type hashVariant)
saltLen = fromIntegral (BS.length salt)
passwordLen = fromIntegral (BS.length password)
hash' :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> IO BS.ByteString
hash' HashOptions{..} password salt =
allocaBytes (fromIntegral hashLength) $ \out -> do
res <- BS.useAsCString password $ \password' ->
BS.useAsCString salt $ \salt' ->
FFI.argon2_hash
hashIterations
hashMemory
hashParallelism
password'
passwordLen
salt'
saltLen
out
(fromIntegral hashLength)
nullPtr
0
(toArgon2Type hashVariant)
(toArgon2Ver hashVersion)
handleSuccessCode res
evaluate =<< BS.packCStringLen (out, fromIntegral hashLength)
where
saltLen = fromIntegral (BS.length salt)
passwordLen = fromIntegral (BS.length password)
handleSuccessCode :: CInt -> IO ()
handleSuccessCode res = case toArgon2Status res of
Argon2Ok -> return ()
nok -> throwIO nok