module Crypto.Argon2
(
hashEncoded, hash,
verify,
HashOptions(..), Argon2Variant(..), defaultHashOptions,
Argon2Exception(..))
where
import GHC.Generics (Generic)
import Control.Exception
import Data.Typeable
import Foreign
import Foreign.C
import Numeric.Natural
import System.IO.Unsafe (unsafePerformIO)
import qualified Crypto.Argon2.FFI as FFI
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
data Argon2Variant
= Argon2i
| Argon2d
deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum)
data HashOptions =
HashOptions {hashIterations :: !Word32
,hashMemory :: !Word32
,hashParallelism :: !Word32
,hashVariant :: !Argon2Variant
}
deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable)
defaultHashOptions :: HashOptions
defaultHashOptions =
HashOptions {hashIterations = 1
,hashMemory = 2 ^ 17
,hashParallelism = 4
,hashVariant = Argon2i}
hashEncoded :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> T.Text
hashEncoded options password salt =
unsafePerformIO
(hashEncoded' options password salt FFI.argon2i_hash_encoded FFI.argon2d_hash_encoded)
hash :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> BS.ByteString
hash options password salt =
unsafePerformIO (hash' options password salt FFI.argon2i_hash_raw FFI.argon2d_hash_raw)
variant :: a -> a -> Argon2Variant -> a
variant a _ Argon2i = a
variant _ b Argon2d = b
data Argon2Exception
=
Argon2PasswordLengthOutOfRange !CSize
|
Argon2SaltLengthOutOfRange !CSize
|
Argon2MemoryUseOutOfRange !Word32
|
Argon2IterationCountOutOfRange !Word32
|
Argon2ParallelismOutOfRange !Word32
|
Argon2Exception !Int32
deriving (Typeable, Show)
instance Exception Argon2Exception
type Argon2Encoded = Word32 -> Word32 -> Word32 -> CString -> CSize -> CString -> CSize -> CSize -> CString -> CSize -> IO Int32
hashEncoded' :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> Argon2Encoded
-> Argon2Encoded
-> IO T.Text
hashEncoded' options@HashOptions{..} password salt argon2i argon2d =
do let saltLen = fromIntegral (BS.length salt)
passwordLen = fromIntegral (BS.length password)
outLen <- fmap fromIntegral $ FFI.argon2_encodedlen
hashIterations
hashMemory
hashParallelism
saltLen
hashlen
out <- mallocBytes outLen
res <-
BS.useAsCString password $
\password' ->
BS.useAsCString salt $
\salt' ->
argon2 hashIterations
hashMemory
hashParallelism
password'
passwordLen
salt'
(fromIntegral saltLen)
(fromIntegral hashlen)
out
(fromIntegral outLen)
handleSuccessCode res options password salt
fmap T.decodeUtf8 (BS.packCString out)
where argon2 = variant argon2i argon2d hashVariant
hashlen = 64
type Argon2Unencoded = Word32 -> Word32 -> Word32 -> CString -> CSize -> CString -> CSize -> CString -> CSize -> IO Int32
hash' :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> Argon2Unencoded
-> Argon2Unencoded
-> IO BS.ByteString
hash' options@HashOptions{..} password salt argon2i argon2d =
do let saltLen = fromIntegral (BS.length salt)
passwordLen = fromIntegral (BS.length password)
outLen = 512
out <- mallocBytes outLen
res <-
BS.useAsCString password $
\password' ->
BS.useAsCString salt $
\salt' ->
argon2 hashIterations
hashMemory
hashParallelism
password'
passwordLen
salt'
saltLen
out
(fromIntegral outLen)
handleSuccessCode res options password salt
BS.packCStringLen (out, outLen)
where argon2 = variant argon2i argon2d hashVariant
handleSuccessCode :: Int32
-> HashOptions
-> BS.ByteString
-> BS.ByteString
-> IO ()
handleSuccessCode res HashOptions{..} password salt =
let saltLen = fromIntegral (BS.length salt)
passwordLen = fromIntegral (BS.length password)
in case res of
a
| a `elem` [FFI.ARGON2_OK] -> return ()
| a `elem` [FFI.ARGON2_SALT_TOO_SHORT,FFI.ARGON2_SALT_TOO_LONG] ->
throwIO (Argon2SaltLengthOutOfRange saltLen)
| a `elem` [FFI.ARGON2_PWD_TOO_SHORT,FFI.ARGON2_PWD_TOO_LONG] ->
throwIO (Argon2PasswordLengthOutOfRange passwordLen)
| a `elem` [FFI.ARGON2_TIME_TOO_SMALL,FFI.ARGON2_TIME_TOO_LARGE] ->
throwIO (Argon2IterationCountOutOfRange hashIterations)
| a `elem` [FFI.ARGON2_MEMORY_TOO_LITTLE,FFI.ARGON2_MEMORY_TOO_MUCH] ->
throwIO (Argon2MemoryUseOutOfRange hashMemory)
| a `elem`
[FFI.ARGON2_LANES_TOO_FEW
,FFI.ARGON2_LANES_TOO_MANY
,FFI.ARGON2_THREADS_TOO_FEW
,FFI.ARGON2_THREADS_TOO_MANY] ->
throwIO (Argon2ParallelismOutOfRange hashParallelism)
| otherwise -> throwIO (Argon2Exception a)
verify
:: T.Text -> BS.ByteString -> Bool
verify encoded password =
unsafePerformIO
(BS.useAsCString password $
\pwd ->
BS.useAsCString (T.encodeUtf8 encoded) $
\enc ->
do res <-
(variant FFI.argon2i_verify FFI.argon2d_verify v) enc
pwd
(fromIntegral (BS.length password))
return (res == FFI.ARGON2_OK))
where v | T.pack "$argon2i" `T.isPrefixOf` encoded = Argon2i
| otherwise = Argon2d