{-# 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 (Argon2Variant -> Argon2Variant -> Bool
(Argon2Variant -> Argon2Variant -> Bool)
-> (Argon2Variant -> Argon2Variant -> Bool) -> Eq Argon2Variant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Argon2Variant -> Argon2Variant -> Bool
== :: Argon2Variant -> Argon2Variant -> Bool
$c/= :: Argon2Variant -> Argon2Variant -> Bool
/= :: Argon2Variant -> Argon2Variant -> Bool
Eq,Eq Argon2Variant
Eq Argon2Variant
-> (Argon2Variant -> Argon2Variant -> Ordering)
-> (Argon2Variant -> Argon2Variant -> Bool)
-> (Argon2Variant -> Argon2Variant -> Bool)
-> (Argon2Variant -> Argon2Variant -> Bool)
-> (Argon2Variant -> Argon2Variant -> Bool)
-> (Argon2Variant -> Argon2Variant -> Argon2Variant)
-> (Argon2Variant -> Argon2Variant -> Argon2Variant)
-> Ord Argon2Variant
Argon2Variant -> Argon2Variant -> Bool
Argon2Variant -> Argon2Variant -> Ordering
Argon2Variant -> Argon2Variant -> Argon2Variant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Argon2Variant -> Argon2Variant -> Ordering
compare :: Argon2Variant -> Argon2Variant -> Ordering
$c< :: Argon2Variant -> Argon2Variant -> Bool
< :: Argon2Variant -> Argon2Variant -> Bool
$c<= :: Argon2Variant -> Argon2Variant -> Bool
<= :: Argon2Variant -> Argon2Variant -> Bool
$c> :: Argon2Variant -> Argon2Variant -> Bool
> :: Argon2Variant -> Argon2Variant -> Bool
$c>= :: Argon2Variant -> Argon2Variant -> Bool
>= :: Argon2Variant -> Argon2Variant -> Bool
$cmax :: Argon2Variant -> Argon2Variant -> Argon2Variant
max :: Argon2Variant -> Argon2Variant -> Argon2Variant
$cmin :: Argon2Variant -> Argon2Variant -> Argon2Variant
min :: Argon2Variant -> Argon2Variant -> Argon2Variant
Ord,ReadPrec [Argon2Variant]
ReadPrec Argon2Variant
Int -> ReadS Argon2Variant
ReadS [Argon2Variant]
(Int -> ReadS Argon2Variant)
-> ReadS [Argon2Variant]
-> ReadPrec Argon2Variant
-> ReadPrec [Argon2Variant]
-> Read Argon2Variant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Argon2Variant
readsPrec :: Int -> ReadS Argon2Variant
$creadList :: ReadS [Argon2Variant]
readList :: ReadS [Argon2Variant]
$creadPrec :: ReadPrec Argon2Variant
readPrec :: ReadPrec Argon2Variant
$creadListPrec :: ReadPrec [Argon2Variant]
readListPrec :: ReadPrec [Argon2Variant]
Read,Int -> Argon2Variant -> ShowS
[Argon2Variant] -> ShowS
Argon2Variant -> String
(Int -> Argon2Variant -> ShowS)
-> (Argon2Variant -> String)
-> ([Argon2Variant] -> ShowS)
-> Show Argon2Variant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Argon2Variant -> ShowS
showsPrec :: Int -> Argon2Variant -> ShowS
$cshow :: Argon2Variant -> String
show :: Argon2Variant -> String
$cshowList :: [Argon2Variant] -> ShowS
showList :: [Argon2Variant] -> ShowS
Show,Argon2Variant
Argon2Variant -> Argon2Variant -> Bounded Argon2Variant
forall a. a -> a -> Bounded a
$cminBound :: Argon2Variant
minBound :: Argon2Variant
$cmaxBound :: Argon2Variant
maxBound :: Argon2Variant
Bounded,(forall x. Argon2Variant -> Rep Argon2Variant x)
-> (forall x. Rep Argon2Variant x -> Argon2Variant)
-> Generic Argon2Variant
forall x. Rep Argon2Variant x -> Argon2Variant
forall x. Argon2Variant -> Rep Argon2Variant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Argon2Variant -> Rep Argon2Variant x
from :: forall x. Argon2Variant -> Rep Argon2Variant x
$cto :: forall x. Rep Argon2Variant x -> Argon2Variant
to :: forall x. Rep Argon2Variant x -> Argon2Variant
Generic,Typeable,Int -> Argon2Variant
Argon2Variant -> Int
Argon2Variant -> [Argon2Variant]
Argon2Variant -> Argon2Variant
Argon2Variant -> Argon2Variant -> [Argon2Variant]
Argon2Variant -> Argon2Variant -> Argon2Variant -> [Argon2Variant]
(Argon2Variant -> Argon2Variant)
-> (Argon2Variant -> Argon2Variant)
-> (Int -> Argon2Variant)
-> (Argon2Variant -> Int)
-> (Argon2Variant -> [Argon2Variant])
-> (Argon2Variant -> Argon2Variant -> [Argon2Variant])
-> (Argon2Variant -> Argon2Variant -> [Argon2Variant])
-> (Argon2Variant
-> Argon2Variant -> Argon2Variant -> [Argon2Variant])
-> Enum Argon2Variant
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Argon2Variant -> Argon2Variant
succ :: Argon2Variant -> Argon2Variant
$cpred :: Argon2Variant -> Argon2Variant
pred :: Argon2Variant -> Argon2Variant
$ctoEnum :: Int -> Argon2Variant
toEnum :: Int -> Argon2Variant
$cfromEnum :: Argon2Variant -> Int
fromEnum :: Argon2Variant -> Int
$cenumFrom :: Argon2Variant -> [Argon2Variant]
enumFrom :: Argon2Variant -> [Argon2Variant]
$cenumFromThen :: Argon2Variant -> Argon2Variant -> [Argon2Variant]
enumFromThen :: Argon2Variant -> Argon2Variant -> [Argon2Variant]
$cenumFromTo :: Argon2Variant -> Argon2Variant -> [Argon2Variant]
enumFromTo :: Argon2Variant -> Argon2Variant -> [Argon2Variant]
$cenumFromThenTo :: Argon2Variant -> Argon2Variant -> Argon2Variant -> [Argon2Variant]
enumFromThenTo :: Argon2Variant -> Argon2Variant -> Argon2Variant -> [Argon2Variant]
Enum)
instance NFData Argon2Variant where rnf :: Argon2Variant -> ()
rnf !Argon2Variant
_ = ()
toArgon2Type :: Argon2Variant -> FFI.Argon2_type
toArgon2Type :: Argon2Variant -> Argon2_type
toArgon2Type Argon2Variant
Argon2i = Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.Argon2_i
toArgon2Type Argon2Variant
Argon2d = Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.Argon2_d
toArgon2Type Argon2Variant
Argon2id = Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.Argon2_id
data Argon2Version
= Argon2Version10
| Argon2Version13
deriving (Argon2Version -> Argon2Version -> Bool
(Argon2Version -> Argon2Version -> Bool)
-> (Argon2Version -> Argon2Version -> Bool) -> Eq Argon2Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Argon2Version -> Argon2Version -> Bool
== :: Argon2Version -> Argon2Version -> Bool
$c/= :: Argon2Version -> Argon2Version -> Bool
/= :: Argon2Version -> Argon2Version -> Bool
Eq,Eq Argon2Version
Eq Argon2Version
-> (Argon2Version -> Argon2Version -> Ordering)
-> (Argon2Version -> Argon2Version -> Bool)
-> (Argon2Version -> Argon2Version -> Bool)
-> (Argon2Version -> Argon2Version -> Bool)
-> (Argon2Version -> Argon2Version -> Bool)
-> (Argon2Version -> Argon2Version -> Argon2Version)
-> (Argon2Version -> Argon2Version -> Argon2Version)
-> Ord Argon2Version
Argon2Version -> Argon2Version -> Bool
Argon2Version -> Argon2Version -> Ordering
Argon2Version -> Argon2Version -> Argon2Version
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Argon2Version -> Argon2Version -> Ordering
compare :: Argon2Version -> Argon2Version -> Ordering
$c< :: Argon2Version -> Argon2Version -> Bool
< :: Argon2Version -> Argon2Version -> Bool
$c<= :: Argon2Version -> Argon2Version -> Bool
<= :: Argon2Version -> Argon2Version -> Bool
$c> :: Argon2Version -> Argon2Version -> Bool
> :: Argon2Version -> Argon2Version -> Bool
$c>= :: Argon2Version -> Argon2Version -> Bool
>= :: Argon2Version -> Argon2Version -> Bool
$cmax :: Argon2Version -> Argon2Version -> Argon2Version
max :: Argon2Version -> Argon2Version -> Argon2Version
$cmin :: Argon2Version -> Argon2Version -> Argon2Version
min :: Argon2Version -> Argon2Version -> Argon2Version
Ord,ReadPrec [Argon2Version]
ReadPrec Argon2Version
Int -> ReadS Argon2Version
ReadS [Argon2Version]
(Int -> ReadS Argon2Version)
-> ReadS [Argon2Version]
-> ReadPrec Argon2Version
-> ReadPrec [Argon2Version]
-> Read Argon2Version
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Argon2Version
readsPrec :: Int -> ReadS Argon2Version
$creadList :: ReadS [Argon2Version]
readList :: ReadS [Argon2Version]
$creadPrec :: ReadPrec Argon2Version
readPrec :: ReadPrec Argon2Version
$creadListPrec :: ReadPrec [Argon2Version]
readListPrec :: ReadPrec [Argon2Version]
Read,Int -> Argon2Version -> ShowS
[Argon2Version] -> ShowS
Argon2Version -> String
(Int -> Argon2Version -> ShowS)
-> (Argon2Version -> String)
-> ([Argon2Version] -> ShowS)
-> Show Argon2Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Argon2Version -> ShowS
showsPrec :: Int -> Argon2Version -> ShowS
$cshow :: Argon2Version -> String
show :: Argon2Version -> String
$cshowList :: [Argon2Version] -> ShowS
showList :: [Argon2Version] -> ShowS
Show,Argon2Version
Argon2Version -> Argon2Version -> Bounded Argon2Version
forall a. a -> a -> Bounded a
$cminBound :: Argon2Version
minBound :: Argon2Version
$cmaxBound :: Argon2Version
maxBound :: Argon2Version
Bounded,(forall x. Argon2Version -> Rep Argon2Version x)
-> (forall x. Rep Argon2Version x -> Argon2Version)
-> Generic Argon2Version
forall x. Rep Argon2Version x -> Argon2Version
forall x. Argon2Version -> Rep Argon2Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Argon2Version -> Rep Argon2Version x
from :: forall x. Argon2Version -> Rep Argon2Version x
$cto :: forall x. Rep Argon2Version x -> Argon2Version
to :: forall x. Rep Argon2Version x -> Argon2Version
Generic,Typeable,Int -> Argon2Version
Argon2Version -> Int
Argon2Version -> [Argon2Version]
Argon2Version -> Argon2Version
Argon2Version -> Argon2Version -> [Argon2Version]
Argon2Version -> Argon2Version -> Argon2Version -> [Argon2Version]
(Argon2Version -> Argon2Version)
-> (Argon2Version -> Argon2Version)
-> (Int -> Argon2Version)
-> (Argon2Version -> Int)
-> (Argon2Version -> [Argon2Version])
-> (Argon2Version -> Argon2Version -> [Argon2Version])
-> (Argon2Version -> Argon2Version -> [Argon2Version])
-> (Argon2Version
-> Argon2Version -> Argon2Version -> [Argon2Version])
-> Enum Argon2Version
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Argon2Version -> Argon2Version
succ :: Argon2Version -> Argon2Version
$cpred :: Argon2Version -> Argon2Version
pred :: Argon2Version -> Argon2Version
$ctoEnum :: Int -> Argon2Version
toEnum :: Int -> Argon2Version
$cfromEnum :: Argon2Version -> Int
fromEnum :: Argon2Version -> Int
$cenumFrom :: Argon2Version -> [Argon2Version]
enumFrom :: Argon2Version -> [Argon2Version]
$cenumFromThen :: Argon2Version -> Argon2Version -> [Argon2Version]
enumFromThen :: Argon2Version -> Argon2Version -> [Argon2Version]
$cenumFromTo :: Argon2Version -> Argon2Version -> [Argon2Version]
enumFromTo :: Argon2Version -> Argon2Version -> [Argon2Version]
$cenumFromThenTo :: Argon2Version -> Argon2Version -> Argon2Version -> [Argon2Version]
enumFromThenTo :: Argon2Version -> Argon2Version -> Argon2Version -> [Argon2Version]
Enum)
instance NFData Argon2Version where rnf :: Argon2Version -> ()
rnf !Argon2Version
_ = ()
toArgon2Ver :: Argon2Version -> FFI.Argon2_version
toArgon2Ver :: Argon2Version -> Argon2_type
toArgon2Ver Argon2Version
Argon2Version10 = Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.ARGON2_VERSION_10
toArgon2Ver Argon2Version
Argon2Version13 = Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.ARGON2_VERSION_13
data HashOptions =
HashOptions { HashOptions -> Argon2_type
hashIterations :: !Word32
, HashOptions -> Argon2_type
hashMemory :: !Word32
, HashOptions -> Argon2_type
hashParallelism :: !Word32
, HashOptions -> Argon2Variant
hashVariant :: !Argon2Variant
, HashOptions -> Argon2Version
hashVersion :: !Argon2Version
, HashOptions -> Argon2_type
hashLength :: !Word32
}
deriving (HashOptions -> HashOptions -> Bool
(HashOptions -> HashOptions -> Bool)
-> (HashOptions -> HashOptions -> Bool) -> Eq HashOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashOptions -> HashOptions -> Bool
== :: HashOptions -> HashOptions -> Bool
$c/= :: HashOptions -> HashOptions -> Bool
/= :: HashOptions -> HashOptions -> Bool
Eq,Eq HashOptions
Eq HashOptions
-> (HashOptions -> HashOptions -> Ordering)
-> (HashOptions -> HashOptions -> Bool)
-> (HashOptions -> HashOptions -> Bool)
-> (HashOptions -> HashOptions -> Bool)
-> (HashOptions -> HashOptions -> Bool)
-> (HashOptions -> HashOptions -> HashOptions)
-> (HashOptions -> HashOptions -> HashOptions)
-> Ord HashOptions
HashOptions -> HashOptions -> Bool
HashOptions -> HashOptions -> Ordering
HashOptions -> HashOptions -> HashOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HashOptions -> HashOptions -> Ordering
compare :: HashOptions -> HashOptions -> Ordering
$c< :: HashOptions -> HashOptions -> Bool
< :: HashOptions -> HashOptions -> Bool
$c<= :: HashOptions -> HashOptions -> Bool
<= :: HashOptions -> HashOptions -> Bool
$c> :: HashOptions -> HashOptions -> Bool
> :: HashOptions -> HashOptions -> Bool
$c>= :: HashOptions -> HashOptions -> Bool
>= :: HashOptions -> HashOptions -> Bool
$cmax :: HashOptions -> HashOptions -> HashOptions
max :: HashOptions -> HashOptions -> HashOptions
$cmin :: HashOptions -> HashOptions -> HashOptions
min :: HashOptions -> HashOptions -> HashOptions
Ord,ReadPrec [HashOptions]
ReadPrec HashOptions
Int -> ReadS HashOptions
ReadS [HashOptions]
(Int -> ReadS HashOptions)
-> ReadS [HashOptions]
-> ReadPrec HashOptions
-> ReadPrec [HashOptions]
-> Read HashOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HashOptions
readsPrec :: Int -> ReadS HashOptions
$creadList :: ReadS [HashOptions]
readList :: ReadS [HashOptions]
$creadPrec :: ReadPrec HashOptions
readPrec :: ReadPrec HashOptions
$creadListPrec :: ReadPrec [HashOptions]
readListPrec :: ReadPrec [HashOptions]
Read,Int -> HashOptions -> ShowS
[HashOptions] -> ShowS
HashOptions -> String
(Int -> HashOptions -> ShowS)
-> (HashOptions -> String)
-> ([HashOptions] -> ShowS)
-> Show HashOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashOptions -> ShowS
showsPrec :: Int -> HashOptions -> ShowS
$cshow :: HashOptions -> String
show :: HashOptions -> String
$cshowList :: [HashOptions] -> ShowS
showList :: [HashOptions] -> ShowS
Show,HashOptions
HashOptions -> HashOptions -> Bounded HashOptions
forall a. a -> a -> Bounded a
$cminBound :: HashOptions
minBound :: HashOptions
$cmaxBound :: HashOptions
maxBound :: HashOptions
Bounded,(forall x. HashOptions -> Rep HashOptions x)
-> (forall x. Rep HashOptions x -> HashOptions)
-> Generic HashOptions
forall x. Rep HashOptions x -> HashOptions
forall x. HashOptions -> Rep HashOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HashOptions -> Rep HashOptions x
from :: forall x. HashOptions -> Rep HashOptions x
$cto :: forall x. Rep HashOptions x -> HashOptions
to :: forall x. Rep HashOptions x -> HashOptions
Generic,Typeable)
instance NFData HashOptions where rnf :: HashOptions -> ()
rnf !HashOptions
_ = ()
defaultHashOptions :: HashOptions
defaultHashOptions :: HashOptions
defaultHashOptions = HashOptions
{ hashIterations :: Argon2_type
hashIterations = Argon2_type
3
, hashMemory :: Argon2_type
hashMemory = Argon2_type
2 Argon2_type -> Int -> Argon2_type
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
12 :: Int)
, hashParallelism :: Argon2_type
hashParallelism = Argon2_type
1
, hashVariant :: Argon2Variant
hashVariant = Argon2Variant
Argon2i
, hashVersion :: Argon2Version
hashVersion = Argon2Version
Argon2Version13
, hashLength :: Argon2_type
hashLength = Argon2_type
32
}
hash :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> Either Argon2Status BS.ByteString
hash :: HashOptions
-> ByteString -> ByteString -> Either Argon2Status ByteString
hash HashOptions
options ByteString
password ByteString
salt = IO (Either Argon2Status ByteString)
-> Either Argon2Status ByteString
forall a. IO a -> a
unsafePerformIO (IO (Either Argon2Status ByteString)
-> Either Argon2Status ByteString)
-> IO (Either Argon2Status ByteString)
-> Either Argon2Status ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO (Either Argon2Status ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either Argon2Status ByteString))
-> IO ByteString -> IO (Either Argon2Status ByteString)
forall a b. (a -> b) -> a -> b
$ HashOptions -> ByteString -> ByteString -> IO ByteString
hash' HashOptions
options ByteString
password ByteString
salt
hashEncoded :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> Either Argon2Status TS.ShortText
hashEncoded :: HashOptions
-> ByteString -> ByteString -> Either Argon2Status ShortText
hashEncoded HashOptions
options ByteString
password ByteString
salt = IO (Either Argon2Status ShortText) -> Either Argon2Status ShortText
forall a. IO a -> a
unsafePerformIO (IO (Either Argon2Status ShortText)
-> Either Argon2Status ShortText)
-> IO (Either Argon2Status ShortText)
-> Either Argon2Status ShortText
forall a b. (a -> b) -> a -> b
$ IO ShortText -> IO (Either Argon2Status ShortText)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ShortText -> IO (Either Argon2Status ShortText))
-> IO ShortText -> IO (Either Argon2Status ShortText)
forall a b. (a -> b) -> a -> b
$ HashOptions -> ByteString -> ByteString -> IO ShortText
hashEncoded' HashOptions
options ByteString
password ByteString
salt
verifyEncoded :: TS.ShortText -> BS.ByteString -> Argon2Status
verifyEncoded :: ShortText -> ByteString -> Argon2Status
verifyEncoded ShortText
encoded ByteString
password
| ShortText
"$argon2id$" ShortText -> ShortText -> Bool
`TS.isPrefixOf` ShortText
encoded = IO Argon2Status -> Argon2Status
forall a. IO a -> a
unsafePerformIO (IO Argon2Status -> Argon2Status)
-> IO Argon2Status -> Argon2Status
forall a b. (a -> b) -> a -> b
$ Argon2_type -> IO Argon2Status
go Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.Argon2_id
| ShortText
"$argon2i$" ShortText -> ShortText -> Bool
`TS.isPrefixOf` ShortText
encoded = IO Argon2Status -> Argon2Status
forall a. IO a -> a
unsafePerformIO (IO Argon2Status -> Argon2Status)
-> IO Argon2Status -> Argon2Status
forall a b. (a -> b) -> a -> b
$ Argon2_type -> IO Argon2Status
go Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.Argon2_i
| ShortText
"$argon2d$" ShortText -> ShortText -> Bool
`TS.isPrefixOf` ShortText
encoded = IO Argon2Status -> Argon2Status
forall a. IO a -> a
unsafePerformIO (IO Argon2Status -> Argon2Status)
-> IO Argon2Status -> Argon2Status
forall a b. (a -> b) -> a -> b
$ Argon2_type -> IO Argon2Status
go Argon2_type
forall {a}. (Eq a, Num a) => a
FFI.Argon2_d
| Bool
otherwise = Argon2Status
Argon2DecodingFail
where
go :: Argon2_type -> IO Argon2Status
go Argon2_type
v = ByteString -> (CString -> IO Argon2Status) -> IO Argon2Status
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
password ((CString -> IO Argon2Status) -> IO Argon2Status)
-> (CString -> IO Argon2Status) -> IO Argon2Status
forall a b. (a -> b) -> a -> b
$ \CString
pwd ->
ByteString -> (CString -> IO Argon2Status) -> IO Argon2Status
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (ShortText -> ByteString
TS.toByteString ShortText
encoded) ((CString -> IO Argon2Status) -> IO Argon2Status)
-> (CString -> IO Argon2Status) -> IO Argon2Status
forall a b. (a -> b) -> a -> b
$ \CString
enc ->
CInt -> Argon2Status
toArgon2Status (CInt -> Argon2Status) -> IO CInt -> IO Argon2Status
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> CString -> CSize -> Argon2_type -> IO CInt
forall a. CString -> Ptr a -> CSize -> Argon2_type -> IO CInt
FFI.argon2_verify CString
enc CString
pwd (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
password)) Argon2_type
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,Argon2Status -> Argon2Status -> Bool
(Argon2Status -> Argon2Status -> Bool)
-> (Argon2Status -> Argon2Status -> Bool) -> Eq Argon2Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Argon2Status -> Argon2Status -> Bool
== :: Argon2Status -> Argon2Status -> Bool
$c/= :: Argon2Status -> Argon2Status -> Bool
/= :: Argon2Status -> Argon2Status -> Bool
Eq,Eq Argon2Status
Eq Argon2Status
-> (Argon2Status -> Argon2Status -> Ordering)
-> (Argon2Status -> Argon2Status -> Bool)
-> (Argon2Status -> Argon2Status -> Bool)
-> (Argon2Status -> Argon2Status -> Bool)
-> (Argon2Status -> Argon2Status -> Bool)
-> (Argon2Status -> Argon2Status -> Argon2Status)
-> (Argon2Status -> Argon2Status -> Argon2Status)
-> Ord Argon2Status
Argon2Status -> Argon2Status -> Bool
Argon2Status -> Argon2Status -> Ordering
Argon2Status -> Argon2Status -> Argon2Status
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Argon2Status -> Argon2Status -> Ordering
compare :: Argon2Status -> Argon2Status -> Ordering
$c< :: Argon2Status -> Argon2Status -> Bool
< :: Argon2Status -> Argon2Status -> Bool
$c<= :: Argon2Status -> Argon2Status -> Bool
<= :: Argon2Status -> Argon2Status -> Bool
$c> :: Argon2Status -> Argon2Status -> Bool
> :: Argon2Status -> Argon2Status -> Bool
$c>= :: Argon2Status -> Argon2Status -> Bool
>= :: Argon2Status -> Argon2Status -> Bool
$cmax :: Argon2Status -> Argon2Status -> Argon2Status
max :: Argon2Status -> Argon2Status -> Argon2Status
$cmin :: Argon2Status -> Argon2Status -> Argon2Status
min :: Argon2Status -> Argon2Status -> Argon2Status
Ord,ReadPrec [Argon2Status]
ReadPrec Argon2Status
Int -> ReadS Argon2Status
ReadS [Argon2Status]
(Int -> ReadS Argon2Status)
-> ReadS [Argon2Status]
-> ReadPrec Argon2Status
-> ReadPrec [Argon2Status]
-> Read Argon2Status
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Argon2Status
readsPrec :: Int -> ReadS Argon2Status
$creadList :: ReadS [Argon2Status]
readList :: ReadS [Argon2Status]
$creadPrec :: ReadPrec Argon2Status
readPrec :: ReadPrec Argon2Status
$creadListPrec :: ReadPrec [Argon2Status]
readListPrec :: ReadPrec [Argon2Status]
Read,Int -> Argon2Status -> ShowS
[Argon2Status] -> ShowS
Argon2Status -> String
(Int -> Argon2Status -> ShowS)
-> (Argon2Status -> String)
-> ([Argon2Status] -> ShowS)
-> Show Argon2Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Argon2Status -> ShowS
showsPrec :: Int -> Argon2Status -> ShowS
$cshow :: Argon2Status -> String
show :: Argon2Status -> String
$cshowList :: [Argon2Status] -> ShowS
showList :: [Argon2Status] -> ShowS
Show,Int -> Argon2Status
Argon2Status -> Int
Argon2Status -> [Argon2Status]
Argon2Status -> Argon2Status
Argon2Status -> Argon2Status -> [Argon2Status]
Argon2Status -> Argon2Status -> Argon2Status -> [Argon2Status]
(Argon2Status -> Argon2Status)
-> (Argon2Status -> Argon2Status)
-> (Int -> Argon2Status)
-> (Argon2Status -> Int)
-> (Argon2Status -> [Argon2Status])
-> (Argon2Status -> Argon2Status -> [Argon2Status])
-> (Argon2Status -> Argon2Status -> [Argon2Status])
-> (Argon2Status -> Argon2Status -> Argon2Status -> [Argon2Status])
-> Enum Argon2Status
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Argon2Status -> Argon2Status
succ :: Argon2Status -> Argon2Status
$cpred :: Argon2Status -> Argon2Status
pred :: Argon2Status -> Argon2Status
$ctoEnum :: Int -> Argon2Status
toEnum :: Int -> Argon2Status
$cfromEnum :: Argon2Status -> Int
fromEnum :: Argon2Status -> Int
$cenumFrom :: Argon2Status -> [Argon2Status]
enumFrom :: Argon2Status -> [Argon2Status]
$cenumFromThen :: Argon2Status -> Argon2Status -> [Argon2Status]
enumFromThen :: Argon2Status -> Argon2Status -> [Argon2Status]
$cenumFromTo :: Argon2Status -> Argon2Status -> [Argon2Status]
enumFromTo :: Argon2Status -> Argon2Status -> [Argon2Status]
$cenumFromThenTo :: Argon2Status -> Argon2Status -> Argon2Status -> [Argon2Status]
enumFromThenTo :: Argon2Status -> Argon2Status -> Argon2Status -> [Argon2Status]
Enum,Argon2Status
Argon2Status -> Argon2Status -> Bounded Argon2Status
forall a. a -> a -> Bounded a
$cminBound :: Argon2Status
minBound :: Argon2Status
$cmaxBound :: Argon2Status
maxBound :: Argon2Status
Bounded)
instance NFData Argon2Status where rnf :: Argon2Status -> ()
rnf !Argon2Status
_ = ()
instance Exception Argon2Status
toArgon2Status :: CInt -> Argon2Status
toArgon2Status :: CInt -> Argon2Status
toArgon2Status = \case
CInt
FFI.ARGON2_OK -> Argon2Status
Argon2Ok
CInt
FFI.ARGON2_OUTPUT_PTR_NULL -> Argon2Status
Argon2OutputPtrNull
CInt
FFI.ARGON2_OUTPUT_TOO_SHORT -> Argon2Status
Argon2OutputTooShort
CInt
FFI.ARGON2_OUTPUT_TOO_LONG -> Argon2Status
Argon2OutputTooLong
CInt
FFI.ARGON2_PWD_TOO_SHORT -> Argon2Status
Argon2PwdTooShort
CInt
FFI.ARGON2_PWD_TOO_LONG -> Argon2Status
Argon2PwdTooLong
CInt
FFI.ARGON2_SALT_TOO_SHORT -> Argon2Status
Argon2SaltTooShort
CInt
FFI.ARGON2_SALT_TOO_LONG -> Argon2Status
Argon2SaltTooLong
CInt
FFI.ARGON2_AD_TOO_SHORT -> Argon2Status
Argon2AdTooShort
CInt
FFI.ARGON2_AD_TOO_LONG -> Argon2Status
Argon2AdTooLong
CInt
FFI.ARGON2_SECRET_TOO_SHORT -> Argon2Status
Argon2SecretTooShort
CInt
FFI.ARGON2_SECRET_TOO_LONG -> Argon2Status
Argon2SecretTooLong
CInt
FFI.ARGON2_TIME_TOO_SMALL -> Argon2Status
Argon2TimeTooSmall
CInt
FFI.ARGON2_TIME_TOO_LARGE -> Argon2Status
Argon2TimeTooLarge
CInt
FFI.ARGON2_MEMORY_TOO_LITTLE -> Argon2Status
Argon2MemoryTooLittle
CInt
FFI.ARGON2_MEMORY_TOO_MUCH -> Argon2Status
Argon2MemoryTooMuch
CInt
FFI.ARGON2_LANES_TOO_FEW -> Argon2Status
Argon2LanesTooFew
CInt
FFI.ARGON2_LANES_TOO_MANY -> Argon2Status
Argon2LanesTooMany
CInt
FFI.ARGON2_PWD_PTR_MISMATCH -> Argon2Status
Argon2PwdPtrMismatch
CInt
FFI.ARGON2_SALT_PTR_MISMATCH -> Argon2Status
Argon2SaltPtrMismatch
CInt
FFI.ARGON2_SECRET_PTR_MISMATCH -> Argon2Status
Argon2SecretPtrMismatch
CInt
FFI.ARGON2_AD_PTR_MISMATCH -> Argon2Status
Argon2AdPtrMismatch
CInt
FFI.ARGON2_MEMORY_ALLOCATION_ERROR -> Argon2Status
Argon2MemoryAllocationError
CInt
FFI.ARGON2_FREE_MEMORY_CBK_NULL -> Argon2Status
Argon2FreeMemoryCbkNull
CInt
FFI.ARGON2_ALLOCATE_MEMORY_CBK_NULL -> Argon2Status
Argon2AllocateMemoryCbkNull
CInt
FFI.ARGON2_INCORRECT_PARAMETER -> Argon2Status
Argon2IncorrectParameter
CInt
FFI.ARGON2_INCORRECT_TYPE -> Argon2Status
Argon2IncorrectType
CInt
FFI.ARGON2_OUT_PTR_MISMATCH -> Argon2Status
Argon2OutPtrMismatch
CInt
FFI.ARGON2_THREADS_TOO_FEW -> Argon2Status
Argon2ThreadsTooFew
CInt
FFI.ARGON2_THREADS_TOO_MANY -> Argon2Status
Argon2ThreadsTooMany
CInt
FFI.ARGON2_MISSING_ARGS -> Argon2Status
Argon2MissingArgs
CInt
FFI.ARGON2_ENCODING_FAIL -> Argon2Status
Argon2EncodingFail
CInt
FFI.ARGON2_DECODING_FAIL -> Argon2Status
Argon2DecodingFail
CInt
FFI.ARGON2_THREAD_FAIL -> Argon2Status
Argon2ThreadFail
CInt
FFI.ARGON2_DECODING_LENGTH_FAIL -> Argon2Status
Argon2DecodingLengthFail
CInt
FFI.ARGON2_VERIFY_MISMATCH -> Argon2Status
Argon2VerifyMismatch
CInt
_ -> Argon2Status
Argon2InternalError
hashEncoded' :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> IO TS.ShortText
hashEncoded' :: HashOptions -> ByteString -> ByteString -> IO ShortText
hashEncoded' HashOptions{Argon2_type
Argon2Version
Argon2Variant
hashIterations :: HashOptions -> Argon2_type
hashMemory :: HashOptions -> Argon2_type
hashParallelism :: HashOptions -> Argon2_type
hashVariant :: HashOptions -> Argon2Variant
hashVersion :: HashOptions -> Argon2Version
hashLength :: HashOptions -> Argon2_type
hashIterations :: Argon2_type
hashMemory :: Argon2_type
hashParallelism :: Argon2_type
hashVariant :: Argon2Variant
hashVersion :: Argon2Version
hashLength :: Argon2_type
..} ByteString
password ByteString
salt =
Int -> (CString -> IO ShortText) -> IO ShortText
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
outLen) ((CString -> IO ShortText) -> IO ShortText)
-> (CString -> IO ShortText) -> IO ShortText
forall a b. (a -> b) -> a -> b
$ \CString
out -> do
CInt
res <- ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
password ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
password' ->
ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
salt ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
salt' ->
Argon2_type
-> Argon2_type
-> Argon2_type
-> CString
-> CSize
-> CString
-> CSize
-> Ptr Any
-> CSize
-> CString
-> CSize
-> Argon2_type
-> Argon2_type
-> IO CInt
forall a b c.
Argon2_type
-> Argon2_type
-> Argon2_type
-> Ptr a
-> CSize
-> Ptr b
-> CSize
-> Ptr c
-> CSize
-> CString
-> CSize
-> Argon2_type
-> Argon2_type
-> IO CInt
FFI.argon2_hash
Argon2_type
hashIterations
Argon2_type
hashMemory
Argon2_type
hashParallelism
CString
password'
CSize
passwordLen
CString
salt'
(Argon2_type -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Argon2_type
saltLen)
Ptr Any
forall a. Ptr a
nullPtr
(Argon2_type -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Argon2_type
hashLength)
CString
out
CSize
outLen
(Argon2Variant -> Argon2_type
toArgon2Type Argon2Variant
hashVariant)
(Argon2Version -> Argon2_type
toArgon2Ver Argon2Version
hashVersion)
CInt -> IO ()
handleSuccessCode CInt
res
Maybe ShortText
res' <- ByteString -> Maybe ShortText
TS.fromByteString (ByteString -> Maybe ShortText)
-> IO ByteString -> IO (Maybe ShortText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
BS.packCString CString
out
case Maybe ShortText
res' of
Maybe ShortText
Nothing -> Argon2Status -> IO ShortText
forall e a. Exception e => e -> IO a
throwIO Argon2Status
Argon2InternalError
Just ShortText
t -> ShortText -> IO ShortText
forall a. a -> IO a
evaluate ShortText
t
where
!outLen :: CSize
outLen = Argon2_type
-> Argon2_type
-> Argon2_type
-> Argon2_type
-> Argon2_type
-> Argon2_type
-> CSize
FFI.argon2_encodedlen
Argon2_type
hashIterations
Argon2_type
hashMemory
Argon2_type
hashParallelism
Argon2_type
saltLen
Argon2_type
hashLength
(Argon2Variant -> Argon2_type
toArgon2Type Argon2Variant
hashVariant)
saltLen :: Argon2_type
saltLen = Int -> Argon2_type
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
salt)
passwordLen :: CSize
passwordLen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
password)
hash' :: HashOptions
-> BS.ByteString
-> BS.ByteString
-> IO BS.ByteString
hash' :: HashOptions -> ByteString -> ByteString -> IO ByteString
hash' HashOptions{Argon2_type
Argon2Version
Argon2Variant
hashIterations :: HashOptions -> Argon2_type
hashMemory :: HashOptions -> Argon2_type
hashParallelism :: HashOptions -> Argon2_type
hashVariant :: HashOptions -> Argon2Variant
hashVersion :: HashOptions -> Argon2Version
hashLength :: HashOptions -> Argon2_type
hashIterations :: Argon2_type
hashMemory :: Argon2_type
hashParallelism :: Argon2_type
hashVariant :: Argon2Variant
hashVersion :: Argon2Version
hashLength :: Argon2_type
..} ByteString
password ByteString
salt =
Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Argon2_type -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Argon2_type
hashLength) ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
out -> do
CInt
res <- ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
password ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
password' ->
ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
salt ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
salt' ->
Argon2_type
-> Argon2_type
-> Argon2_type
-> CString
-> CSize
-> CString
-> CSize
-> CString
-> CSize
-> CString
-> CSize
-> Argon2_type
-> Argon2_type
-> IO CInt
forall a b c.
Argon2_type
-> Argon2_type
-> Argon2_type
-> Ptr a
-> CSize
-> Ptr b
-> CSize
-> Ptr c
-> CSize
-> CString
-> CSize
-> Argon2_type
-> Argon2_type
-> IO CInt
FFI.argon2_hash
Argon2_type
hashIterations
Argon2_type
hashMemory
Argon2_type
hashParallelism
CString
password'
CSize
passwordLen
CString
salt'
CSize
saltLen
CString
out
(Argon2_type -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Argon2_type
hashLength)
CString
forall a. Ptr a
nullPtr
CSize
0
(Argon2Variant -> Argon2_type
toArgon2Type Argon2Variant
hashVariant)
(Argon2Version -> Argon2_type
toArgon2Ver Argon2Version
hashVersion)
CInt -> IO ()
handleSuccessCode CInt
res
ByteString -> IO ByteString
forall a. a -> IO a
evaluate (ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CStringLen -> IO ByteString
BS.packCStringLen (CString
out, Argon2_type -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Argon2_type
hashLength)
where
saltLen :: CSize
saltLen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
salt)
passwordLen :: CSize
passwordLen = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
password)
handleSuccessCode :: CInt -> IO ()
handleSuccessCode :: CInt -> IO ()
handleSuccessCode CInt
res = case CInt -> Argon2Status
toArgon2Status CInt
res of
Argon2Status
Argon2Ok -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Argon2Status
nok -> Argon2Status -> IO ()
forall e a. Exception e => e -> IO a
throwIO Argon2Status
nok