{-# 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
import Data.ByteArray (Bytes, constEq, convert)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (encodeBase64)
import qualified Data.ByteString.Char8 as C8 (length)
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, length, split, splitAt)
import Data.Word (Word32)
import Data.Password (
PasswordCheck(..)
, PasswordHash(..)
, Salt(..)
, mkPassword
, unsafeShowPassword
)
import Data.Password.Internal (Password(..), from64, readT, showT, toBytes)
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
encodeBase64 ByteString
salt
, ByteString -> Text
encodeBase64 ByteString
key
]
where
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 Text
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
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
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
length [Text]
paramList Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6
let [ Text
_,
Text
variantT,
Text
versionT,
Text
parametersT,
Text
salt64,
Text
hashedKey64 ] = [Text]
paramList
Variant
argon2Variant <- Text -> Maybe Variant
parseVariant Text
variantT
Version
argon2Version <- Text -> Maybe Version
parseVersion Text
versionT
(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
salt64
ByteString
hashedKey <- Text -> Maybe ByteString
from64 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
C8.length ByteString
hashedKey
producedKey :: ByteString
producedKey = Argon2Params -> Salt Argon2 -> Password -> ByteString
hashPasswordWithSalt' 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) 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
where
argon2Salt :: Word32
argon2Salt = Word32
16
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
parseParameters :: Text -> Maybe (a, b, c)
parseParameters Text
params = do
let ps :: [Text]
ps = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
params
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
length [Text]
ps 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]
ps (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 =
case Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
match) Text
t of
(Text
m, Text
x) | Text
m Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
match -> Text -> Maybe a
f Text
x
(Text, Text)
_ -> Maybe a
forall a. Maybe a
Nothing
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"