{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Password.Argon2 (
Argon2
, Password
, mkPassword
, hashPassword
, PasswordHash(..)
, checkPassword
, PasswordCheck(..)
, hashPasswordWithParams
, defaultParams
, extractParams
, Argon2Params(..)
, Argon2.Variant(..)
, Argon2.Version(..)
, hashPasswordWithSalt
, newSalt
, Salt(..)
, unsafeShowPassword
,
) where
import Control.Monad (guard)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Crypto.Error (throwCryptoError)
import Crypto.KDF.Argon2 as Argon2 (Options (..), Variant (..), Version (..), hash)
import Data.ByteArray (Bytes, constEq, convert)
import Data.ByteString as B (ByteString, length)
import Data.ByteString.Base64 (encodeBase64)
import Data.Maybe (fromMaybe)
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T (dropWhileEnd, intercalate, split, splitAt, stripPrefix)
import Data.Word (Word32)
import Data.Password.Internal (
PasswordCheck (..),
from64,
readT,
showT,
toBytes,
unsafePad64,
)
import Data.Password.Types (
Password,
PasswordHash (..),
Salt (..),
mkPassword,
unsafeShowPassword,
)
import qualified Data.Password.Internal (newSalt)
data Argon2
hashPassword :: MonadIO m => Password -> m (PasswordHash Argon2)
hashPassword :: forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Argon2)
hashPassword = forall (m :: * -> *).
MonadIO m =>
Argon2Params -> Password -> m (PasswordHash Argon2)
hashPasswordWithParams Argon2Params
defaultParams
data Argon2Params = Argon2Params {
Argon2Params -> Word32
argon2Salt :: Word32,
Argon2Params -> Variant
argon2Variant :: Argon2.Variant,
Argon2Params -> Version
argon2Version :: Argon2.Version,
Argon2Params -> Word32
argon2MemoryCost :: Word32,
Argon2Params -> Word32
argon2TimeCost :: Word32,
Argon2Params -> Word32
argon2Parallelism :: Word32,
Argon2Params -> Word32
argon2OutputLength :: Word32
} deriving (Argon2Params -> Argon2Params -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Argon2Params -> Argon2Params -> Bool
$c/= :: Argon2Params -> Argon2Params -> Bool
== :: Argon2Params -> Argon2Params -> Bool
$c== :: Argon2Params -> Argon2Params -> Bool
Eq, Int -> Argon2Params -> ShowS
[Argon2Params] -> ShowS
Argon2Params -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Argon2Params] -> ShowS
$cshowList :: [Argon2Params] -> ShowS
show :: Argon2Params -> String
$cshow :: Argon2Params -> String
showsPrec :: Int -> Argon2Params -> ShowS
$cshowsPrec :: Int -> Argon2Params -> ShowS
Show)
defaultParams :: Argon2Params
defaultParams :: Argon2Params
defaultParams = Argon2Params {
argon2Salt :: Word32
argon2Salt = Word32
16,
argon2Variant :: Variant
argon2Variant = Variant
Argon2id,
argon2Version :: Version
argon2Version = Version
Version13,
argon2MemoryCost :: Word32
argon2MemoryCost = Word32
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
16 :: Int),
argon2TimeCost :: Word32
argon2TimeCost = Word32
2,
argon2Parallelism :: Word32
argon2Parallelism = Word32
1,
argon2OutputLength :: Word32
argon2OutputLength = Word32
32
}
hashPasswordWithSalt :: Argon2Params -> Salt Argon2 -> Password -> PasswordHash Argon2
hashPasswordWithSalt :: Argon2Params -> Salt Argon2 -> Password -> PasswordHash Argon2
hashPasswordWithSalt params :: Argon2Params
params@Argon2Params{Word32
Variant
Version
argon2OutputLength :: Word32
argon2Parallelism :: Word32
argon2TimeCost :: Word32
argon2MemoryCost :: Word32
argon2Version :: Version
argon2Variant :: Variant
argon2Salt :: Word32
argon2OutputLength :: Argon2Params -> Word32
argon2Parallelism :: Argon2Params -> Word32
argon2TimeCost :: Argon2Params -> Word32
argon2MemoryCost :: Argon2Params -> Word32
argon2Version :: Argon2Params -> Version
argon2Variant :: Argon2Params -> Variant
argon2Salt :: Argon2Params -> Word32
..} s :: Salt Argon2
s@(Salt ByteString
salt) Password
pass =
forall a. Text -> PasswordHash a
PasswordHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend Text
"$argon2" forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"$"
[ Variant -> Text
variantToLetter Variant
argon2Variant
, Text
"v=" forall a. Semigroup a => a -> a -> a
<> Version -> Text
versionToNum Version
argon2Version
, Text
parameters
, ByteString -> Text
encodeWithoutPadding ByteString
salt
, ByteString -> Text
encodeWithoutPadding ByteString
key
]
where
encodeWithoutPadding :: ByteString -> Text
encodeWithoutPadding = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'=') forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase64
parameters :: Text
parameters = Text -> [Text] -> Text
T.intercalate Text
","
[ Text
"m=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showT Word32
argon2MemoryCost
, Text
"t=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showT Word32
argon2TimeCost
, Text
"p=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showT Word32
argon2Parallelism
]
key :: ByteString
key = Argon2Params -> Salt Argon2 -> Password -> ByteString
hashPasswordWithSalt' Argon2Params
params Salt Argon2
s Password
pass
hashPasswordWithSalt' :: Argon2Params -> Salt Argon2 -> Password -> ByteString
hashPasswordWithSalt' :: Argon2Params -> Salt Argon2 -> Password -> ByteString
hashPasswordWithSalt' Argon2Params{Word32
Variant
Version
argon2OutputLength :: Word32
argon2Parallelism :: Word32
argon2TimeCost :: Word32
argon2MemoryCost :: Word32
argon2Version :: Version
argon2Variant :: Variant
argon2Salt :: Word32
argon2OutputLength :: Argon2Params -> Word32
argon2Parallelism :: Argon2Params -> Word32
argon2TimeCost :: Argon2Params -> Word32
argon2MemoryCost :: Argon2Params -> Word32
argon2Version :: Argon2Params -> Version
argon2Variant :: Argon2Params -> Variant
argon2Salt :: Argon2Params -> Word32
..} (Salt ByteString
salt) Password
pass =
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes
argon2Hash :: Bytes)
where
argon2Hash :: Bytes
argon2Hash = forall a. CryptoFailable a -> a
throwCryptoError forall a b. (a -> b) -> a -> b
$
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Options -> password -> salt -> Int -> CryptoFailable out
Argon2.hash
Options
options
(Text -> Bytes
toBytes forall a b. (a -> b) -> a -> b
$ Password -> Text
unsafeShowPassword Password
pass)
(forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
salt :: Bytes)
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
argon2OutputLength
options :: Options
options = Argon2.Options {
iterations :: Word32
iterations = Word32
argon2TimeCost,
memory :: Word32
memory = Word32
argon2MemoryCost,
parallelism :: Word32
parallelism = Word32
argon2Parallelism,
variant :: Variant
variant = Variant
argon2Variant,
version :: Version
version = Version
argon2Version
}
hashPasswordWithParams :: MonadIO m => Argon2Params -> Password -> m (PasswordHash Argon2)
hashPasswordWithParams :: forall (m :: * -> *).
MonadIO m =>
Argon2Params -> Password -> m (PasswordHash Argon2)
hashPasswordWithParams Argon2Params
params Password
pass = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Salt Argon2
salt <- forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Argon2Params -> Word32
argon2Salt Argon2Params
params
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Argon2Params -> Salt Argon2 -> Password -> PasswordHash Argon2
hashPasswordWithSalt Argon2Params
params Salt Argon2
salt Password
pass
checkPassword :: Password -> PasswordHash Argon2 -> PasswordCheck
checkPassword :: Password -> PasswordHash Argon2 -> PasswordCheck
checkPassword Password
pass PasswordHash Argon2
passHash =
forall a. a -> Maybe a -> a
fromMaybe PasswordCheck
PasswordCheckFail forall a b. (a -> b) -> a -> b
$ do
(Argon2Params
argon2Params, Salt Argon2
salt, ByteString
hashedKey) <- PasswordHash Argon2
-> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2PasswordHashParams PasswordHash Argon2
passHash
let producedKey :: ByteString
producedKey = Argon2Params -> Salt Argon2 -> Password -> ByteString
hashPasswordWithSalt' Argon2Params
argon2Params Salt Argon2
salt Password
pass
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString
hashedKey forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
producedKey
forall (m :: * -> *) a. Monad m => a -> m a
return PasswordCheck
PasswordCheckSuccess
parseArgon2PasswordHashParams :: PasswordHash Argon2 -> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2PasswordHashParams :: PasswordHash Argon2
-> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2PasswordHashParams (PasswordHash Text
passHash) =
[Text] -> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2Params forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'$') Text
passHash
parseArgon2Params :: [Text] -> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2Params :: [Text] -> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2Params (Text
_:Text
variantT:Text
vp:Text
ps:Text
sh:[Text]
rest) = do
Variant
variant <- Text -> Maybe Variant
parseVariant Text
variantT
case [Text]
rest of
[Text
hashedKey64] -> do
Version
version <- Text -> Maybe Version
parseVersion Text
vp
Variant
-> Version
-> Text
-> Text
-> Text
-> Maybe (Argon2Params, Salt Argon2, ByteString)
parseAll Variant
variant Version
version Text
ps Text
sh Text
hashedKey64
[] -> Variant
-> Version
-> Text
-> Text
-> Text
-> Maybe (Argon2Params, Salt Argon2, ByteString)
parseAll Variant
variant Version
Version10 Text
vp Text
ps Text
sh
[Text]
_ -> forall a. Maybe a
Nothing
where
parseVariant :: Text -> Maybe Variant
parseVariant = forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
"argon2" Text -> Maybe Variant
letterToVariant
parseVersion :: Text -> Maybe Version
parseVersion = forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
"v=" Text -> Maybe Version
numToVersion
parseArgon2Params [Text]
_ = forall a. Maybe a
Nothing
parseAll :: Argon2.Variant -> Argon2.Version -> Text -> Text -> Text -> Maybe (Argon2Params, Salt Argon2, ByteString)
parseAll :: Variant
-> Version
-> Text
-> Text
-> Text
-> Maybe (Argon2Params, Salt Argon2, ByteString)
parseAll Variant
argon2Variant Version
argon2Version Text
parametersT Text
salt64 Text
hashedKey64 = do
(Word32
argon2MemoryCost, Word32
argon2TimeCost, Word32
argon2Parallelism) <- forall {a} {b} {c}.
(Read a, Read b, Read c) =>
Text -> Maybe (a, b, c)
parseParameters Text
parametersT
ByteString
salt <- Text -> Maybe ByteString
from64 forall a b. (a -> b) -> a -> b
$ Text -> Text
unsafePad64 Text
salt64
ByteString
hashedKey <- Text -> Maybe ByteString
from64 forall a b. (a -> b) -> a -> b
$ Text -> Text
unsafePad64 Text
hashedKey64
let argon2OutputLength :: Word32
argon2OutputLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
hashedKey
argon2Salt :: Word32
argon2Salt = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
salt
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argon2Params{Word32
Variant
Version
argon2Salt :: Word32
argon2OutputLength :: Word32
argon2Parallelism :: Word32
argon2TimeCost :: Word32
argon2MemoryCost :: Word32
argon2Version :: Version
argon2Variant :: Variant
argon2OutputLength :: Word32
argon2Parallelism :: Word32
argon2TimeCost :: Word32
argon2MemoryCost :: Word32
argon2Version :: Version
argon2Variant :: Variant
argon2Salt :: Word32
..}, forall a. ByteString -> Salt a
Salt ByteString
salt, ByteString
hashedKey)
where
parseParameters :: Text -> Maybe (a, b, c)
parseParameters Text
paramsT = do
let paramsL :: [Text]
paramsL = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
',') Text
paramsT
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Text]
paramsL forall a. Eq a => a -> a -> Bool
== Int
3
forall {a} {b} {c}.
(Read a, Read b, Read c) =>
[Text] -> (Maybe a, Maybe b, Maybe c) -> Maybe (a, b, c)
go [Text]
paramsL (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
where
go :: [Text] -> (Maybe a, Maybe b, Maybe c) -> Maybe (a, b, c)
go [] (Just a
m, Just b
t, Just c
p) = forall a. a -> Maybe a
Just (a
m, b
t, c
p)
go [] (Maybe a, Maybe b, Maybe c)
_ = forall a. Maybe a
Nothing
go (Text
x:[Text]
xs) (Maybe a
m, Maybe b
t, Maybe c
p) =
case Int -> Text -> (Text, Text)
T.splitAt Int
2 Text
x of
(Text
"m=", Text
i) -> [Text] -> (Maybe a, Maybe b, Maybe c) -> Maybe (a, b, c)
go [Text]
xs (forall a. Read a => Text -> Maybe a
readT Text
i, Maybe b
t, Maybe c
p)
(Text
"t=", Text
i) -> [Text] -> (Maybe a, Maybe b, Maybe c) -> Maybe (a, b, c)
go [Text]
xs (Maybe a
m, forall a. Read a => Text -> Maybe a
readT Text
i, Maybe c
p)
(Text
"p=", Text
i) -> [Text] -> (Maybe a, Maybe b, Maybe c) -> Maybe (a, b, c)
go [Text]
xs (Maybe a
m, Maybe b
t, forall a. Read a => Text -> Maybe a
readT Text
i)
(Text, Text)
_ -> forall a. Maybe a
Nothing
extractParams :: PasswordHash Argon2 -> Maybe Argon2Params
PasswordHash Argon2
passHash =
(\(Argon2Params
params, Salt Argon2
_, ByteString
_) -> Argon2Params
params) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PasswordHash Argon2
-> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2PasswordHashParams PasswordHash Argon2
passHash
splitMaybe :: Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe :: forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
match Text -> Maybe a
f Text
t =
Text -> Text -> Maybe Text
T.stripPrefix Text
match Text
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
f
newSalt :: MonadIO m => m (Salt Argon2)
newSalt :: forall (m :: * -> *). MonadIO m => m (Salt Argon2)
newSalt = forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
16
variantToLetter :: Argon2.Variant -> Text
variantToLetter :: Variant -> Text
variantToLetter = \case
Variant
Argon2i -> Text
"i"
Variant
Argon2d -> Text
"d"
Variant
Argon2id -> Text
"id"
letterToVariant :: Text -> Maybe Argon2.Variant
letterToVariant :: Text -> Maybe Variant
letterToVariant = \case
Text
"i" -> forall a. a -> Maybe a
Just Variant
Argon2i
Text
"d" -> forall a. a -> Maybe a
Just Variant
Argon2d
Text
"id" -> forall a. a -> Maybe a
Just Variant
Argon2id
Text
_ -> forall a. Maybe a
Nothing
numToVersion :: Text -> Maybe Argon2.Version
numToVersion :: Text -> Maybe Version
numToVersion Text
"16" = forall a. a -> Maybe a
Just Version
Argon2.Version10
numToVersion Text
"19" = forall a. a -> Maybe a
Just Version
Argon2.Version13
numToVersion Text
_ = forall a. Maybe a
Nothing
versionToNum :: Argon2.Version -> Text
versionToNum :: Version -> Text
versionToNum Version
Version10 = Text
"16"
versionToNum Version
Version13 = Text
"19"