{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Password.Argon2 (
Argon2
, Password
, mkPassword
, hashPassword
, PasswordHash(..)
, checkPassword
, PasswordCheck(..)
, hashPasswordWithParams
, defaultParams
, 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 (intercalate, split, splitAt, stripPrefix)
import Data.Word (Word32)
import Data.Password.Internal (
PasswordCheck (..),
from64,
readT,
showT,
toBytes,
unsafePad64,
unsafeRemovePad64,
)
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 :: Password -> m (PasswordHash Argon2)
hashPassword = Argon2Params -> Password -> m (PasswordHash Argon2)
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
(Argon2Params -> Argon2Params -> Bool)
-> (Argon2Params -> Argon2Params -> Bool) -> Eq Argon2Params
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
(Int -> Argon2Params -> ShowS)
-> (Argon2Params -> String)
-> ([Argon2Params] -> ShowS)
-> Show Argon2Params
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 :: Word32
-> Variant
-> Version
-> Word32
-> Word32
-> Word32
-> Word32
-> Argon2Params
Argon2Params {
argon2Salt :: Word32
argon2Salt = Word32
16,
argon2Variant :: Variant
argon2Variant = Variant
Argon2id,
argon2Version :: Version
argon2Version = Version
Version13,
argon2MemoryCost :: Word32
argon2MemoryCost = Word32
2 Word32 -> Int -> Word32
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 =
Text -> PasswordHash Argon2
forall a. Text -> PasswordHash a
PasswordHash (Text -> PasswordHash Argon2)
-> (Text -> Text) -> Text -> PasswordHash Argon2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"$argon2" (Text -> PasswordHash Argon2) -> Text -> PasswordHash Argon2
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"$"
[ Variant -> Text
variantToLetter Variant
argon2Variant
, Text
"v=" Text -> Text -> Text
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 ByteString
bs =
Int -> Text -> Text
unsafeRemovePad64 (ByteString -> Int
B.length ByteString
bs) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeBase64 ByteString
bs
parameters :: Text
parameters = Text -> [Text] -> Text
T.intercalate Text
","
[ Text
"m=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Word32
argon2MemoryCost
, Text
"t=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Word32
argon2TimeCost
, Text
"p=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
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 =
Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes
argon2Hash :: Bytes)
where
argon2Hash :: Bytes
argon2Hash = CryptoFailable Bytes -> Bytes
forall a. CryptoFailable a -> a
throwCryptoError (CryptoFailable Bytes -> Bytes) -> CryptoFailable Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$
Options -> Bytes -> Bytes -> Int -> CryptoFailable Bytes
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Options -> password -> salt -> Int -> CryptoFailable out
Argon2.hash
Options
options
(Text -> Bytes
toBytes (Text -> Bytes) -> Text -> Bytes
forall a b. (a -> b) -> a -> b
$ Password -> Text
unsafeShowPassword Password
pass)
(ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
salt :: Bytes)
(Int -> CryptoFailable Bytes) -> Int -> CryptoFailable Bytes
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
argon2OutputLength
options :: Options
options = Options :: Word32 -> Word32 -> Word32 -> Variant -> Version -> 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 :: Argon2Params -> Password -> m (PasswordHash Argon2)
hashPasswordWithParams Argon2Params
params Password
pass = IO (PasswordHash Argon2) -> m (PasswordHash Argon2)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PasswordHash Argon2) -> m (PasswordHash Argon2))
-> IO (PasswordHash Argon2) -> m (PasswordHash Argon2)
forall a b. (a -> b) -> a -> b
$ do
Salt Argon2
salt <- Int -> IO (Salt Argon2)
forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt (Int -> IO (Salt Argon2))
-> (Word32 -> Int) -> Word32 -> IO (Salt Argon2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> IO (Salt Argon2)) -> Word32 -> IO (Salt Argon2)
forall a b. (a -> b) -> a -> b
$ Argon2Params -> Word32
argon2Salt Argon2Params
params
PasswordHash Argon2 -> IO (PasswordHash Argon2)
forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordHash Argon2 -> IO (PasswordHash Argon2))
-> PasswordHash Argon2 -> IO (PasswordHash Argon2)
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 Text
passHash) =
PasswordCheck -> Maybe PasswordCheck -> PasswordCheck
forall a. a -> Maybe a -> a
fromMaybe PasswordCheck
PasswordCheckFail (Maybe PasswordCheck -> PasswordCheck)
-> Maybe PasswordCheck -> PasswordCheck
forall a b. (a -> b) -> a -> b
$ do
let paramList :: [Text]
paramList = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$') Text
passHash
(Argon2Params
argon2Params, Salt Argon2
salt, ByteString
hashedKey) <- [Text] -> Maybe (Argon2Params, Salt Argon2, ByteString)
parseArgon2Params [Text]
paramList
let producedKey :: ByteString
producedKey = Argon2Params -> Salt Argon2 -> Password -> ByteString
hashPasswordWithSalt' Argon2Params
argon2Params Salt Argon2
salt Password
pass
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
hashedKey ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
producedKey
PasswordCheck -> Maybe PasswordCheck
forall (m :: * -> *) a. Monad m => a -> m a
return PasswordCheck
PasswordCheckSuccess
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]
_ -> Maybe (Argon2Params, Salt Argon2, ByteString)
forall a. Maybe a
Nothing
where
parseVariant :: Text -> Maybe Variant
parseVariant = Text -> (Text -> Maybe Variant) -> Text -> Maybe Variant
forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
"argon2" Text -> Maybe Variant
letterToVariant
parseVersion :: Text -> Maybe Version
parseVersion = Text -> (Text -> Maybe Version) -> Text -> Maybe Version
forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
"v=" Text -> Maybe Version
numToVersion
parseArgon2Params [Text]
_ = Maybe (Argon2Params, Salt Argon2, ByteString)
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) <- Text -> Maybe (Word32, Word32, Word32)
forall a b c. (Read a, Read b, Read c) => Text -> Maybe (a, b, c)
parseParameters Text
parametersT
ByteString
salt <- Text -> Maybe ByteString
from64 (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
unsafePad64 Text
salt64
ByteString
hashedKey <- Text -> Maybe ByteString
from64 (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
unsafePad64 Text
hashedKey64
let argon2OutputLength :: Word32
argon2OutputLength = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
hashedKey
argon2Salt :: Word32
argon2Salt = Word32
16
(Argon2Params, Salt Argon2, ByteString)
-> Maybe (Argon2Params, Salt Argon2, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argon2Params :: Word32
-> Variant
-> Version
-> Word32
-> Word32
-> Word32
-> Word32
-> Argon2Params
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
..}, ByteString -> Salt Argon2
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
paramsT
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Text]
paramsL Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
[Text] -> (Maybe a, Maybe b, Maybe c) -> Maybe (a, b, c)
forall a b c.
(Read a, Read b, Read c) =>
[Text] -> (Maybe a, Maybe b, Maybe c) -> Maybe (a, b, c)
go [Text]
paramsL (Maybe a
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing, Maybe c
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) = (a, b, c) -> Maybe (a, b, c)
forall a. a -> Maybe a
Just (a
m, b
t, c
p)
go [] (Maybe a, Maybe b, Maybe c)
_ = Maybe (a, b, 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 (Text -> Maybe a
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, Text -> Maybe b
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, Text -> Maybe c
forall a. Read a => Text -> Maybe a
readT Text
i)
(Text, Text)
_ -> Maybe (a, b, c)
forall a. Maybe a
Nothing
splitMaybe :: Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe :: 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 Maybe Text -> (Text -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
f
newSalt :: MonadIO m => m (Salt Argon2)
newSalt :: m (Salt Argon2)
newSalt = Int -> m (Salt Argon2)
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" -> Variant -> Maybe Variant
forall a. a -> Maybe a
Just Variant
Argon2i
Text
"d" -> Variant -> Maybe Variant
forall a. a -> Maybe a
Just Variant
Argon2d
Text
"id" -> Variant -> Maybe Variant
forall a. a -> Maybe a
Just Variant
Argon2id
Text
_ -> Maybe Variant
forall a. Maybe a
Nothing
numToVersion :: Text -> Maybe Argon2.Version
numToVersion :: Text -> Maybe Version
numToVersion Text
"16" = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
Argon2.Version10
numToVersion Text
"19" = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
Argon2.Version13
numToVersion Text
_ = Maybe Version
forall a. Maybe a
Nothing
versionToNum :: Argon2.Version -> Text
versionToNum :: Version -> Text
versionToNum Version
Version10 = Text
"16"
versionToNum Version
Version13 = Text
"19"