diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,21 @@ # Changelog for password +## 2.0.0.0 + +- Complete overhaul of the library to include hashing and checking + passwords with not just `scrypt`, but also `PBKDF2`, `bcrypt` and + `Argon2`. + [#8](https://github.com/cdepillabout/password/pull/8) +- `cryptonite` is now used as a dependency, instead of the `scrypt` package. + [#8](https://github.com/cdepillabout/password/pull/8) +- Done away with abbreviating "password" (`Pass/pass` -> `Password/password`) + [#8](https://github.com/cdepillabout/password/pull/8) +- Removed `unsafeShowPasswordText` and changed `unsafeShowPassword` to be + `Password -> Text`. (Anyone who needs it to be a `String` knows where to + find `Data.Text.unpack`) + [#8](https://github.com/cdepillabout/password/pull/8) +- GHC versions < 8.2 are no longer actively supported. (Tested to work for GHC 8.2.2) + ## 1.0.0.0 - `hashPassWithSalt` has switched function arguments for better currying. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Dennis Gosnell (c) 2019 +Copyright (c) Dennis Gosnell, 2019; Felix Paulusma, 2020 All rights reserved. @@ -13,9 +13,9 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Dennis Gosnell nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. + * Neither the name of Dennis Gosnell, Felix Paulusma nor the names + of other contributors may be used to endorse or promote products + derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,20 @@ +# password + +[![Build Status](https://secure.travis-ci.org/cdepillabout/password.svg)](http://travis-ci.org/cdepillabout/password) +[![Hackage](https://img.shields.io/hackage/v/password.svg)](https://hackage.haskell.org/package/password) +[![Stackage LTS](http://stackage.org/package/password/badge/lts)](http://stackage.org/lts/package/password) +[![Stackage Nightly](http://stackage.org/package/password/badge/nightly)](http://stackage.org/nightly/package/password) +[![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](./LICENSE) + +This library provides datatypes and functions for working with passwords and +password hashes in Haskell. + +Currently supports the following algorithms: + +* `PBKDF2` +* `bcrypt` +* `scrypt` +* `Argon2` + +Also, see the [password-instances](https://hackage.haskell.org/package/password-instances) +package for instances for common typeclasses. diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,13 +0,0 @@ -# password - -[![Build Status](https://secure.travis-ci.org/cdepillabout/password.svg)](http://travis-ci.org/cdepillabout/password) -[![Hackage](https://img.shields.io/hackage/v/password.svg)](https://hackage.haskell.org/package/password) -[![Stackage LTS](http://stackage.org/package/password/badge/lts)](http://stackage.org/lts/package/password) -[![Stackage Nightly](http://stackage.org/package/password/badge/nightly)](http://stackage.org/nightly/package/password) -[![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](./LICENSE) - -This library provides datatypes and functions for working with passwords and -password hashes in Haskell. - -Also, see the [password-instances](../password-instances) package for instances -for common typeclasses. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,33 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wall #-} +module Main (main) where + +#ifndef MIN_VERSION_cabal_doctest +#define MIN_VERSION_cabal_doctest(x,y,z) 0 +#endif + +#if MIN_VERSION_cabal_doctest(1,0,0) + +import Distribution.Extra.Doctest ( defaultMainWithDoctests ) +main :: IO () +main = defaultMainWithDoctests "doctests" + +#else + +#ifdef MIN_VERSION_Cabal +-- If the macro is defined, we have new cabal-install, +-- but for some reason we don't have cabal-doctest in package-db +-- +-- Probably we are running cabal sdist, when otherwise using new-build +-- workflow +#warning You are configuring this package without cabal-doctest installed. \ + The doctests test-suite will not work as a result. \ + To fix this, install cabal-doctest before configuring. +#endif + import Distribution.Simple + +main :: IO () main = defaultMain + +#endif diff --git a/password.cabal b/password.cabal --- a/password.cabal +++ b/password.cabal @@ -1,22 +1,28 @@ cabal-version: 1.12 name: password -version: 1.0.0.0 +version: 2.0.0.0 category: Data -synopsis: plain-text password and hashed password datatypes and functions -description: A library providing types for working with plain-text and hashed passwords, generally for web applications. +synopsis: Hashing and checking of passwords +description: A library providing functionality for working with plain-text and hashed passwords with different types of algorithms. homepage: https://github.com/cdepillabout/password/password#readme bug-reports: https://github.com/cdepillabout/password/issues -author: Dennis Gosnell -maintainer: cdep.illabout@gmail.com -copyright: Copyright (c) 2019 Dennis Gosnell +author: Dennis Gosnell, Felix Paulusma +maintainer: cdep.illabout@gmail.com, felix.paulusma@gmail.com +copyright: Copyright (c) Dennis Gosnell, 2019; Felix Paulusma, 2020 license: BSD3 license-file: LICENSE -build-type: Simple +build-type: Custom extra-source-files: - README.md + README ChangeLog.md +custom-setup + setup-depends: + base + , Cabal + , cabal-doctest >=1.0.6 && <1.1 + source-repository head type: git location: https://github.com/cdepillabout/password @@ -26,18 +32,26 @@ src exposed-modules: Data.Password + Data.Password.Argon2 + Data.Password.Bcrypt + Data.Password.PBKDF2 + Data.Password.Scrypt other-modules: Paths_password + Data.Password.Internal build-depends: - base >=4.7 && <5 - , scrypt - , text + base >= 4.9 && < 5 + , base64 >= 0.3 && < 0.5 + , bytestring >= 0.10.8.1 && < 0.11 + , cryptonite >= 0.15.1 && < 0.27 + , memory >= 0.14 && < 0.16 + , text >= 1.2.2 && < 1.3 ghc-options: -Wall default-language: Haskell2010 -test-suite password-doctest +test-suite doctests type: exitcode-stdio-1.0 hs-source-dirs: @@ -45,16 +59,15 @@ main-is: doctest.hs ghc-options: - -threaded -rtsopts -with-rtsopts=-N + -threaded -O2 -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 - -- bytestring is used when actually running the doctests - , bytestring + base >=4.9 && <5 + , base-compat , doctest , password , QuickCheck , quickcheck-instances - , scrypt + , template-haskell default-language: Haskell2010 @@ -66,12 +79,20 @@ main-is: Spec.hs other-modules: - Paths_password + Argon2 + , Bcrypt + , Internal + , PBKDF2 + , Scrypt + , Paths_password ghc-options: - -threaded -rtsopts -with-rtsopts=-N + -threaded -O2 -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + base >=4.9 && <5 , password + , bytestring + , cryptonite + , memory , quickcheck-instances , scrypt , tasty diff --git a/src/Data/Password.hs b/src/Data/Password.hs --- a/src/Data/Password.hs +++ b/src/Data/Password.hs @@ -1,260 +1,75 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - {-| Module : Data.Password -Copyright : (c) Dennis Gosnell, 2019 +Copyright : (c) Dennis Gosnell, 2019; Felix Paulusma, 2020 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX -This module provides an easy way for interacting with passwords from Haskell. -It provides the types 'Pass' and 'PassHash', which correspond to plain-text and +This library provides an easy way for interacting with passwords from Haskell. +It provides the types 'Password' and 'PasswordHash', which correspond to plain-text and hashed passwords. -It also provides functions for hashing ('hashPass') and checking passwords -('checkPass'). +== API -The real benefit of this module is that there is a corresponding +Every supported hashing algorithm has its own module (e.g. "Data.Password.Bcrypt") +which exports its own @hashPassword@ and @checkPassword@ functions, as well as all the +types and functions in this module. If you are not sure about the specifics of an +algorithm you want to use, you can rest assured that by using the @hashPassword@ function +of the respective algorithm you are not making any big mistakes, security-wise. + +Of course, if you know what you're doing and you want more fine-grained control +over the hashing function, you can adjust it using the @hashPasswordWithParams@ +function of the respective algorithm. + +== Algorithms + +Generally, the most "secure" algorithm is believed to be @"Argon2"@, +then @"Scrypt"@, then @"Bcrypt"@, and lastly @"PBKDF2"@. @"Bcrypt"@ and @"PBKDF2"@ +are the most established algorithms, so they have been tried and tested, though +they both lack a memory cost, and therefore have a greater vulnerability to +specialized hardware attacks. + +When choosing an algorithm, and you have no idea which to pick, just go for +@"Bcrypt"@ if your password does not need the highest security possible. +It's still a fine way for hashing passwords, and the cost is easily adjustable if needed. +If your needs do require stronger protection, you should find someone who can advise you +on this topic. (And if you're already knowledgeable enough, you know what to do) + +== Special instances + +The real benefit of this module is that there is an accompanying -module that provides canonical typeclass instances for -'Pass' and 'PassHash' for many common typeclasses, like +package that provides canonical typeclass instances for +'Password' and 'PasswordHash' for many common typeclasses, like from , from , etc. -See the module for more information. +See the package for more information. -} -module Data.Password - ( - -- * Plaintext Password - Pass - , mkPass - -- * Hashed Password - , PassHash(..) +module Data.Password ( + -- * Plain-text Password + Password + , mkPassword + -- * Password Hashing + , PasswordHash(..) + , PasswordCheck(..) , Salt(..) - -- * Functions for Hashing Plaintext Passwords - , hashPass - , hashPassWithSalt , newSalt - -- * Functions for Checking Plaintext Passwords Against Hashed Passwords - , checkPass - , PassCheck(..) - -- * Unsafe Debugging Functions for Showing a Password + -- * Unsafe debugging function to show a Password , unsafeShowPassword - , unsafeShowPasswordText - , -- * Setup for doctests. - -- $setup ) where -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Crypto.Scrypt (EncryptedPass(..), Salt(..), defaultParams, encryptPass, - verifyPass') -import qualified Crypto.Scrypt as Scrypt -import Data.String (IsString(..)) -import Data.Text (Text, unpack) -import Data.Text.Encoding (decodeUtf8With, encodeUtf8) -import Data.Text.Encoding.Error (lenientDecode) - --- $setup --- >>> :set -XOverloadedStrings --- --- Import needed libraries. --- --- >>> import Data.ByteString (pack) --- >>> import Test.QuickCheck (Arbitrary(arbitrary), Blind(Blind), vector) --- >>> import Test.QuickCheck.Instances.ByteString () --- >>> import Test.QuickCheck.Instances.Text () --- --- 'Arbitrary' instances for types exported from this library. --- --- >>> instance Arbitrary Salt where arbitrary = Salt . pack <$> vector 32 --- >>> instance Arbitrary Pass where arbitrary = fmap Pass arbitrary --- >>> instance Arbitrary PassHash where arbitrary = hashPassWithSalt <$> arbitrary <*> arbitrary --- --- 'Arbitrary' instances for types exported from "Crypto.Scrypt". --- --- >>> instance Arbitrary Scrypt.Pass where arbitrary = fmap Scrypt.Pass arbitrary --- >>> instance Arbitrary EncryptedPass where arbitrary = encryptPass defaultParams <$> arbitrary <*> arbitrary - --- | A plain-text password. --- --- This represents a plain-text password that has /NOT/ been hashed. --- --- You should be careful with 'Pass'. Make sure not to write it to logs or --- store it in a database. --- --- You can construct a 'Pass' by using the 'mkPass' function or as literal strings together with the --- OverloadedStrings pragma (or manually, by using 'fromString' on a 'String'). --- Alternatively, you could also use some of the instances in the @password-instances@ library. -newtype Pass = Pass Text - deriving (IsString) - --- | CAREFUL: 'Show'-ing a 'Pass' will always print @"**PASSWORD**"@ --- --- >>> show $ mkPass "hello" --- "**PASSWORD**" --- --- @since 1.0.0.0 -instance Show Pass where - show _ = "**PASSWORD**" - --- | Construct a 'Pass' --- --- @since 1.0.0.0 -mkPass :: Text -> Pass -mkPass = Pass - --- | This is an unsafe function that shows a password in plain-text. --- --- >>> unsafeShowPasswordText $ mkPass "foobar" --- "foobar" --- --- You should generally not use this function. -unsafeShowPassword :: Pass -> String -unsafeShowPassword = unpack . unsafeShowPasswordText - --- | This is like 'unsafeShowPassword' but produces a 'Text' instead of a --- 'String'. -unsafeShowPasswordText :: Pass -> Text -unsafeShowPasswordText (Pass pass) = pass - --- | A hashed password. --- --- This represents a password that has been put through a hashing function. --- The hashed password can be stored in a database. -newtype PassHash = PassHash - { unPassHash :: Text - } deriving (Eq, Ord, Read, Show) - --- | Convert an "Crypto.Scrypt".'Scrypt.Pass' to our 'Pass' type. --- --- >>> passToScryptPass "foobar" --- Pass {getPass = "foobar"} -passToScryptPass :: Pass -> Scrypt.Pass -passToScryptPass (Pass pass) = Scrypt.Pass $ encodeUtf8 pass - --- Convert our 'Pass' type to an "Crypto.Scrypt".'Script.Pass'. --- --- Opposite of 'passToScryptPass'. --- --- >>> scryptPassToPass $ Scrypt.Pass "foobar" --- Pass {getPass = "foobar"} --- scryptPassToPass :: Scrypt.Pass -> Pass --- scryptPassToPass (Scrypt.Pass pass) = Pass $ decodeUtf8With lenientDecode pass - --- | Convert an "Crypto.Scrypt".'EncryptedPass' to our 'PassHash' type. --- --- This is the opposite of 'passHashToScryptEncryptedPass'. --- --- >>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345" --- >>> let pass = Scrypt.Pass "foobar" --- >>> let encryptedPass = encryptPass defaultParams salt pass --- >>> encryptedPass --- EncryptedPass {getEncryptedPass = "14|8|1|YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXowMTIzNDU=|nENDaqWBmPKapAqQ3//H0iBImweGjoTqn5SvBS8Mc9FPFbzq6w65maYPZaO+SPamVZRXQjARQ8Y+5rhuDhjIhw=="} --- >>> scryptEncryptedPassToPassHash encryptedPass --- PassHash {unPassHash = "14|8|1|YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXowMTIzNDU=|nENDaqWBmPKapAqQ3//H0iBImweGjoTqn5SvBS8Mc9FPFbzq6w65maYPZaO+SPamVZRXQjARQ8Y+5rhuDhjIhw=="} --- --- prop> scryptEncryptedPassToPassHash (passHashToScryptEncryptedPass passHash) == passHash -scryptEncryptedPassToPassHash :: EncryptedPass -> PassHash -scryptEncryptedPassToPassHash (EncryptedPass encPass) = - PassHash $ decodeUtf8With lenientDecode encPass - --- | Convert out 'PassHash' type to "Crypto.Scrypt".'EncryptedPass'. --- --- This is the opposite of 'scryptEncryptedPassToPassHash'. --- --- >>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345" --- >>> let pass = Scrypt.Pass "foobar" --- >>> let encryptedPass = encryptPass defaultParams salt pass --- >>> encryptedPass --- EncryptedPass {getEncryptedPass = "14|8|1|YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXowMTIzNDU=|nENDaqWBmPKapAqQ3//H0iBImweGjoTqn5SvBS8Mc9FPFbzq6w65maYPZaO+SPamVZRXQjARQ8Y+5rhuDhjIhw=="} --- >>> scryptEncryptedPassToPassHash encryptedPass --- PassHash {unPassHash = "14|8|1|YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXowMTIzNDU=|nENDaqWBmPKapAqQ3//H0iBImweGjoTqn5SvBS8Mc9FPFbzq6w65maYPZaO+SPamVZRXQjARQ8Y+5rhuDhjIhw=="} --- --- prop> passHashToScryptEncryptedPass (scryptEncryptedPassToPassHash encPass) == encPass -passHashToScryptEncryptedPass :: PassHash -> EncryptedPass -passHashToScryptEncryptedPass (PassHash passHash) = - EncryptedPass $ encodeUtf8 passHash - --- | Just like 'hashPassWithSalt', but generate a new 'Salt' everytime with a --- call to 'newSalt'. --- --- >>> hashPass $ mkPass "foobar" --- PassHash {unPassHash = "14|8|1|...|..."} -hashPass :: MonadIO m => Pass -> m PassHash -hashPass pass = do - salt <- liftIO newSalt - pure $ hashPassWithSalt salt pass - --- | Hash a password with the given 'Salt'. --- --- The resulting 'PassHash' has the parameters used to hash it, as well as the --- 'Salt' appended to it, separated by @|@. --- --- The input 'Salt' and resulting 'PassHash' are both byte-64 encoded. --- --- >>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345" --- >>> hashPassWithSalt salt (mkPass "foobar") --- PassHash {unPassHash = "14|8|1|YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXowMTIzNDU=|nENDaqWBmPKapAqQ3//H0iBImweGjoTqn5SvBS8Mc9FPFbzq6w65maYPZaO+SPamVZRXQjARQ8Y+5rhuDhjIhw=="} --- --- (Note that we use an explicit 'Salt' in the example above. This is so that the --- example is reproducible, but in general you should use 'hashPass'. 'hashPass' --- generates a new 'Salt' everytime it is called.) --- --- This function uses the hash function from the scrypt package: 'encryptPass'. -hashPassWithSalt :: Salt -> Pass -> PassHash -hashPassWithSalt salt pass = - scryptEncryptedPassToPassHash $ - encryptPass defaultParams salt (passToScryptPass pass) - --- | The result of a checking a password against a hashed version. This is --- returned by 'checkPass'. -data PassCheck - = PassCheckSuccess - -- ^ The password check was successful. The plain-text password matches the - -- hashed password. - | PassCheckFail - -- ^ The password check failed. The plain-text password does not match the - -- hashed password. - deriving (Eq, Read, Show) - --- | Check a 'Pass' against a 'PassHash'. --- --- Returns 'PassCheckSuccess' on success. --- --- >>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345" --- >>> let pass = mkPass "foobar" --- >>> let passHash = hashPassWithSalt salt pass --- >>> checkPass pass passHash --- PassCheckSuccess --- --- Returns 'PassCheckFail' If an incorrect 'Pass' or 'PassHash' is used. --- --- >>> let badpass = mkPass "incorrect-password" --- >>> checkPass badpass passHash --- PassCheckFail --- --- This should always fail if an incorrect password is given. --- --- prop> \(Blind badpass) -> let correctPassHash = hashPassWithSalt salt "foobar" in checkPass badpass correctPassHash == PassCheckFail -checkPass :: Pass -> PassHash -> PassCheck -checkPass pass passHash = - if verifyPass' (passToScryptPass pass) (passHashToScryptEncryptedPass passHash) - then PassCheckSuccess - else PassCheckFail - --- | Generate a random 32-byte salt. -newSalt :: MonadIO m => m Salt -newSalt = liftIO Scrypt.newSalt +import Data.Password.Internal --- TODO: Create code for checking that plaintext passwords conform to some sort of +-- TODO: Create code for checking that plain-text passwords conform to some sort of -- password policy. --- data PassPolicy = PassPolicy +-- data PasswordPolicy = PasswordPolicy -- { passPolicyLength :: Int -- , passPolicyCharReqs :: [PolicyCharReq] -- , passPolicyCharSet :: PolicyCharSet diff --git a/src/Data/Password/Argon2.hs b/src/Data/Password/Argon2.hs new file mode 100644 --- /dev/null +++ b/src/Data/Password/Argon2.hs @@ -0,0 +1,336 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-| +Module : Data.Password.Argon2 +Copyright : (c) Felix Paulusma, 2020 +License : BSD-style (see LICENSE file) +Maintainer : cdep.illabout@gmail.com +Stability : experimental +Portability : POSIX + += Argon2 + +@Argon2@ is probably the newest password algorithm out there. Argon2 was +selected as the winner of the Password Hashing Competition in July 2015. + +It has three variants, namely 'Argon2d', 'Argon2i' and 'Argon2id'. These protect +against GPU cracking attacks, side-channel attacks, and both, respectively. + +All three modes allow specification by three parameters that control: + +* execution time +* memory required +* degree of parallelism + +== Other algorithms + +In comparison to other algorithms, Argon2 is the least "battle-tested", +being the newest algorithm out there. + +It is, however, recommended over @"Scrypt"@ most of the time, +and it also seems like it might become the go-to password algorithm if no +vulnarabilities are discovered within the next couple of years. +-} + +-- I think the portability is broadened to +-- whatever, now that we use cryptonite... I think +module Data.Password.Argon2 ( + -- Algorithm + Argon2 + -- * Plain-text Password + , Password + , mkPassword + -- * Hash Passwords (Argon2) + , hashPassword + , PasswordHash(..) + -- * Verify Passwords (Argon2) + , checkPassword + , PasswordCheck(..) + -- * Hashing Manually (Argon2) + , hashPasswordWithParams + , defaultParams + , Argon2Params(..) + , Argon2.Variant(..) + , Argon2.Version(..) + -- ** Hashing with salt (DISADVISED) + -- + -- | Hashing with a set 'Salt' is almost never what you want + -- to do. Use 'hashPassword' or 'hashPasswordWithParams' to have + -- automatic generation of randomized salts. + , hashPasswordWithSalt + , newSalt + , Salt(..) + -- * Unsafe debugging function to show a Password + , unsafeShowPassword + , -- * Setup for doctests. + -- $setup + ) 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, 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) + + +-- | Phantom type for __Argon2__ +-- +-- @since 2.0.0.0 +data Argon2 + +-- $setup +-- >>> :set -XFlexibleInstances +-- >>> :set -XOverloadedStrings +-- +-- Import needed libraries. +-- +-- >>> import Data.Password +-- >>> import Data.ByteString (pack) +-- >>> import Test.QuickCheck (Arbitrary(arbitrary), Blind(Blind), vector) +-- >>> import Test.QuickCheck.Instances.Text () +-- +-- >>> instance Arbitrary (Salt a) where arbitrary = Salt . pack <$> vector 16 +-- >>> instance Arbitrary Password where arbitrary = fmap Password arbitrary +-- >>> let testParams = defaultParams {argon2TimeCost = 1} +-- >>> let salt = Salt "abcdefghijklmnop" + +-- -- >>> instance Arbitrary (PasswordHash Argon2) where arbitrary = hashPasswordWithSalt testParams <$> arbitrary <*> arbitrary + +-- | Hash the 'Password' using the 'Argon2' hash algorithm +-- +-- >>> hashPassword $ mkPassword "foobar" +-- PasswordHash {unPasswordHash = "$argon2id$v=19$m=65536,t=2,p=1$...$..."} +hashPassword :: MonadIO m => Password -> m (PasswordHash Argon2) +hashPassword = hashPasswordWithParams defaultParams + +-- | Parameters used in the 'Argon2' hashing algorithm. +-- +-- @since 2.0.0.0 +data Argon2Params = Argon2Params { + argon2Salt :: Word32, + -- ^ Bytes to randomly generate as a unique salt, default is __16__ + -- + -- Limits are min: @8@, and max: @(2 ^ 32) - 1@ + argon2Variant :: Argon2.Variant, + -- ^ Which variant of Argon2 to use, default is __'Argon2id'__ + argon2Version :: Argon2.Version, + -- ^ Which version of Argon2 to use, default is __'Version13'__ + argon2MemoryCost :: Word32, + -- ^ Memory cost, given in /kibibytes/, default is __65536__ (i.e. 64MB) + -- + -- Limits are min: @8 * 'argon2Parallelism'@, and max is addressing + -- space / 2, or @(2 ^ 32) - 1@, whichever is lower. + argon2TimeCost :: Word32, + -- ^ Amount of computation realized, default is __2__ + -- + -- Limits are min: @1@, and max: @(2 ^ 32) - 1@ + argon2Parallelism :: Word32, + -- ^ Parallelism factor, default is __1__ + -- + -- Limits are min: @1@, and max: @(2 ^ 24) - 1@ + argon2OutputLength :: Word32 + -- ^ Output key length in bytes, default is __32__ + -- + -- Limits are min: @4@, and max: @(2 ^ 32) - 1@ +} deriving (Eq, Show) + +-- | Default parameters for the 'Argon2' algorithm. +-- +-- >>> defaultParams +-- Argon2Params {argon2Salt = 16, argon2Variant = Argon2id, argon2Version = Version13, argon2MemoryCost = 65536, argon2TimeCost = 2, argon2Parallelism = 1, argon2OutputLength = 32} +-- +-- @since 2.0.0.0 +defaultParams :: Argon2Params +defaultParams = Argon2Params { + argon2Salt = 16, + argon2Variant = Argon2id, + argon2Version = Version13, + argon2MemoryCost = 2 ^ (16 :: Int), + argon2TimeCost = 2, + argon2Parallelism = 1, + argon2OutputLength = 32 +} + +-- | Hash a password with the given 'Argon2Params' and also with the given 'Salt' +-- instead of a random generated salt using 'argon2Salt' from 'Argon2Params'. (cf. 'hashPasswordWithParams') +-- Using 'hashPasswordWithSalt' is strongly __disadvised__ and 'hashPasswordWithParams' should be used instead. +-- /Never use a static salt in production applications!/ +-- +-- __N.B.__: The salt HAS to be 8 bytes or more, or this function will throw an error! +-- +-- >>> let salt = Salt "abcdefghijklmnop" +-- >>> hashPasswordWithSalt defaultParams salt (mkPassword "foobar") +-- PasswordHash {unPasswordHash = "$argon2id$v=19$m=65536,t=2,p=1$YWJjZGVmZ2hpamtsbW5vcA==$BztdyfEefG5V18ZNlztPrfZaU5duVFKZiI6dJeWht0o="} +-- +-- (Note that we use an explicit 'Salt' in the example above. This is so that the +-- example is reproducible, but in general you should use 'hashPassword'. 'hashPassword' +-- generates a new 'Salt' everytime it is called.) +hashPasswordWithSalt :: Argon2Params -> Salt Argon2 -> Password -> PasswordHash Argon2 +hashPasswordWithSalt params@Argon2Params{..} s@(Salt salt) pass = + PasswordHash . mappend "$argon2" $ T.intercalate "$" + [ variantToLetter argon2Variant + , "v=" <> versionToNum argon2Version + , parameters + , encodeBase64 salt + , encodeBase64 key + ] + where + parameters = T.intercalate "," + [ "m=" <> showT argon2MemoryCost + , "t=" <> showT argon2TimeCost + , "p=" <> showT argon2Parallelism + ] + key = hashPasswordWithSalt' params s pass + +-- | Only for internal use +hashPasswordWithSalt' :: Argon2Params -> Salt Argon2 -> Password -> ByteString +hashPasswordWithSalt' Argon2Params{..} (Salt salt) (Password pass) = + convert (argon2Hash :: Bytes) + where + argon2Hash = throwCryptoError $ + Argon2.hash options (toBytes pass) (convert salt :: Bytes) $ fromIntegral argon2OutputLength + options = Argon2.Options { + iterations = argon2TimeCost, + memory = argon2MemoryCost, + parallelism = argon2Parallelism, + variant = argon2Variant, + version = argon2Version + } + +-- | Hash a password using the 'Argon2' algorithm with the given 'Argon2Params'. +-- +-- __N.B.__: If you have any doubt in your knowledge of cryptography and/or the +-- 'Argon2' algorithm, please just use 'hashPassword'. +-- +-- Advice to set the parameters: +-- +-- * Figure out how many threads you can use, choose "parallelism" accordingly. +-- * Figure out how much memory you can use, choose "memory cost" accordingly. +-- * Decide on the maximum time @x@ you can spend on it, choose the largest +-- "time cost" such that it takes less than @x@ with your system and other +-- parameter choices. +-- +-- @since 2.0.0.0 +hashPasswordWithParams :: MonadIO m => Argon2Params -> Password -> m (PasswordHash Argon2) +hashPasswordWithParams params pass = liftIO $ do + salt <- Data.Password.Internal.newSalt . fromIntegral $ argon2Salt params + return $ hashPasswordWithSalt params salt pass + +-- TODO: Parse different kinds of hashes, not only the ones from this library. +-- e.g. hashes that miss the first $, or have 'argon2$' in front of the 'argon2id' part. + +-- | Check a 'Password' against a 'PasswordHash' 'Argon2'. +-- +-- Returns 'PasswordCheckSuccess' on success. +-- +-- >>> let pass = mkPassword "foobar" +-- >>> passHash <- hashPassword pass +-- >>> checkPassword pass passHash +-- PasswordCheckSuccess +-- +-- Returns 'PasswordCheckFail' if an incorrect 'Password' or 'PasswordHash' 'Argon2' is used. +-- +-- >>> let badpass = mkPassword "incorrect-password" +-- >>> checkPassword badpass passHash +-- PasswordCheckFail +-- +-- This should always fail if an incorrect password is given. +-- +-- prop> \(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt testParams salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail +checkPassword :: Password -> PasswordHash Argon2 -> PasswordCheck +checkPassword pass (PasswordHash passHash) = + fromMaybe PasswordCheckFail $ do + let paramList = T.split (== '$') passHash + guard $ length paramList == 6 + let [ _, + variantT, + versionT, + parametersT, + salt64, + hashedKey64 ] = paramList + argon2Variant <- parseVariant variantT + argon2Version <- parseVersion versionT + (argon2MemoryCost, argon2TimeCost, argon2Parallelism) <- parseParameters parametersT + salt <- from64 salt64 + hashedKey <- from64 hashedKey64 + let argon2OutputLength = fromIntegral $ C8.length hashedKey -- only here because of warnings + producedKey = hashPasswordWithSalt' Argon2Params{..} (Salt salt) pass + guard $ hashedKey == producedKey + return PasswordCheckSuccess + where + argon2Salt = 16 -- only here because of warnings + parseVariant = splitMaybe "argon2" letterToVariant + parseVersion = splitMaybe "v=" numToVersion + parseParameters params = do + let ps = T.split (== ',') params + guard $ length ps == 3 + go ps (Nothing, Nothing, Nothing) + where + go [] (Just m, Just t, Just p) = Just (m, t, p) + go [] _ = Nothing + go (x:xs) (m, t, p) = + case T.splitAt 2 x of + ("m=", i) -> go xs (readT i, t, p) + ("t=", i) -> go xs (m, readT i, p) + ("p=", i) -> go xs (m, t, readT i) + _ -> Nothing + splitMaybe :: Text -> (Text -> Maybe a) -> Text -> Maybe a + splitMaybe match f t = + case T.splitAt (T.length match) t of + (m, x) | m == match -> f x + _ -> Nothing + +-- | Generate a random 16-byte @Argon2@ salt +-- +-- @since 2.0.0.0 +newSalt :: MonadIO m => m (Salt Argon2) +newSalt = Data.Password.Internal.newSalt 16 + +-- | Makes a letter out of the variant +variantToLetter :: Argon2.Variant -> Text +variantToLetter = \case + Argon2i -> "i" + Argon2d -> "d" + Argon2id -> "id" + +-- | Parses the variant parameter in the encoded hash +letterToVariant :: Text -> Maybe Argon2.Variant +letterToVariant = \case + "i" -> Just Argon2i + "d" -> Just Argon2d + "id" -> Just Argon2id + _ -> Nothing + +-- | Parses the "v=" parameter in the encoded hash +numToVersion :: Text -> Maybe Argon2.Version +numToVersion "16" = Just Argon2.Version10 +numToVersion "19" = Just Argon2.Version13 +numToVersion _ = Nothing + +-- | Makes number for the "v=" parameter in the encoded hash +versionToNum :: Argon2.Version -> Text +versionToNum Version10 = "16" +versionToNum Version13 = "19" diff --git a/src/Data/Password/Bcrypt.hs b/src/Data/Password/Bcrypt.hs new file mode 100644 --- /dev/null +++ b/src/Data/Password/Bcrypt.hs @@ -0,0 +1,181 @@ +{-| +Module : Data.Password.Bcrypt +Copyright : (c) Felix Paulusma, 2020 +License : BSD-style (see LICENSE file) +Maintainer : cdep.illabout@gmail.com +Stability : experimental +Portability : POSIX + += bcrypt + +The @bcrypt@ algorithm is a popular way of hashing passwords. +It is based on the Blowfish cipher and fairly straightfoward +in its usage. It has a cost parameter that, when increased, +slows down the hashing speed. + +It is a straightforward and easy way to get decent protection +on passwords, it is also been around long enough to be battle-tested +and generally considered to provide a good amount of security. + +== Other algorithms + +@bcrypt@, together with @"PBKDF2"@, are only computationally intensive. +And to protect from specialized hardware, new algorithms have been +developed that are also resource intensive, like @"Scrypt"@ and +@"Argon2"@. Not having high resource demands, means an attacker with +specialized software could take less time to brute-force a password, +though with the default cost (10) and a decently long password, +the amount of time to brute-force would still be significant. + +This the algorithm to use if you're not sure about your needs, but +just want a decent, proven way to encrypt your passwords. +-} + +module Data.Password.Bcrypt ( + -- * Algorithm + Bcrypt + -- * Plain-text Password + , Password + , mkPassword + -- * Hash Passwords (bcrypt) + , hashPassword + , PasswordHash(..) + -- * Verify Passwords (bcrypt) + , checkPassword + , PasswordCheck(..) + -- * Hashing Manually (bcrypt) + , hashPasswordWithParams + -- ** Hashing with salt (DISADVISED) + -- + -- | Hashing with a set 'Salt' is almost never what you want + -- to do. Use 'hashPassword' or 'hashPasswordWithParams' to have + -- automatic generation of randomized salts. + , hashPasswordWithSalt + , newSalt + , Salt(..) + -- * Unsafe debugging function to show a Password + , unsafeShowPassword + , -- * Setup for doctests. + -- $setup + ) where + +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Crypto.KDF.BCrypt as Bcrypt hiding (hashPassword) +import Data.ByteArray (Bytes, convert) + +import Data.Password ( + PasswordCheck(..) + , PasswordHash(..) + , Salt(..) + , mkPassword + , unsafeShowPassword + ) +import Data.Password.Internal (Password(..), fromBytes, toBytes) +import qualified Data.Password.Internal (newSalt) + + +-- | Phantom type for __bcrypt__ +-- +-- @since 2.0.0.0 +data Bcrypt + +-- $setup +-- >>> :set -XFlexibleInstances +-- >>> :set -XOverloadedStrings +-- +-- Import needed libraries. +-- +-- >>> import Data.Password +-- >>> import Data.ByteString (pack) +-- >>> import Test.QuickCheck (Arbitrary(arbitrary), Blind(Blind), vector) +-- >>> import Test.QuickCheck.Instances.Text () +-- +-- >>> instance Arbitrary (Salt a) where arbitrary = Salt . pack <$> vector 16 +-- >>> instance Arbitrary Password where arbitrary = fmap Password arbitrary +-- >>> let salt = Salt "abcdefghijklmnop" + +-- -- >>> instance Arbitrary (PasswordHash Bcrypt) where arbitrary = hashPasswordWithSalt 8 <$> arbitrary <*> arbitrary + +-- | Hash the 'Password' using the /bcrypt/ hash algorithm. +-- +-- __N.B.__: @bcrypt@ has a limit of 72 bytes as input, so anything longer than that +-- will be cut off at the 72 byte point and thus any password that is 72 bytes +-- or longer will match as long as the first 72 bytes are the same. +-- +-- >>> hashPassword $ mkPassword "foobar" +-- PasswordHash {unPasswordHash = "$2b$10$..."} +hashPassword :: MonadIO m => Password -> m (PasswordHash Bcrypt) +hashPassword = hashPasswordWithParams 10 + +-- | Hash a password with the given cost and also with the given 'Salt' +-- instead of generating a random salt. Using 'hashPasswordWithSalt' is strongly __disadvised__, +-- and 'hashPasswordWithParams' should be used instead. /Never use a static salt/ +-- /in production applications!/ +-- +-- __N.B.__: The salt HAS to be 16 bytes or this function will throw an error! +-- +-- >>> let salt = Salt "abcdefghijklmnop" +-- >>> hashPasswordWithSalt 10 salt (mkPassword "foobar") +-- PasswordHash {unPasswordHash = "$2b$10$WUHhXETkX0fnYkrqZU3ta.N8Utt4U77kW4RVbchzgvBvBBEEdCD/u"} +-- +-- (Note that we use an explicit 'Salt' in the example above. This is so that the +-- example is reproducible, but in general you should use 'hashPassword'. 'hashPassword' +-- (and 'hashPasswordWithParams') generates a new 'Salt' everytime it is called.) +hashPasswordWithSalt + :: Int -- ^ The cost parameter. Should be between 4 and 31 (inclusive). Values which lie outside this range will be adjusted accordingly. + -> Salt Bcrypt -- ^ The salt. MUST be 16 bytes in length or an error will be raised. + -> Password -- ^ The password to be hashed. + -> PasswordHash Bcrypt -- ^ The bcrypt hash in standard format. +hashPasswordWithSalt cost (Salt salt) (Password pass) = + let hash = Bcrypt.bcrypt cost (convert salt :: Bytes) (toBytes pass) + in PasswordHash $ fromBytes hash + +-- | Hash a password using the /bcrypt/ algorithm with the given cost. +-- +-- The higher the cost, the longer 'hashPassword' and 'checkPassword' will take to run, +-- thus increasing the security, but taking longer and taking up more resources. +-- The optimal cost for generic user logins would be one that would take between +-- 0.05 - 0.5 seconds to check on the machine that will run it. +-- +-- __N.B.__: It is advised to use 'hashPassword' if you're unsure about the +-- implications that changing the cost brings with it. +-- +-- @since 2.0.0.0 +hashPasswordWithParams + :: MonadIO m + => Int -- ^ The cost parameter. Should be between 4 and 31 (inclusive). Values which lie outside this range will be adjusted accordingly. + -> Password -- ^ The password to be hashed. + -> m (PasswordHash Bcrypt) -- ^ The bcrypt hash in standard format. +hashPasswordWithParams cost pass = liftIO $ do + salt <- newSalt + return $ hashPasswordWithSalt cost salt pass + +-- | Check a 'Password' against a 'PasswordHash' 'Bcrypt'. +-- +-- Returns 'PasswordCheckSuccess' on success. +-- +-- >>> let pass = mkPassword "foobar" +-- >>> passHash <- hashPassword pass +-- >>> checkPassword pass passHash +-- PasswordCheckSuccess +-- +-- Returns 'PasswordCheckFail' if an incorrect 'Password' or 'PasswordHash' 'Bcrypt' is used. +-- +-- >>> let badpass = mkPassword "incorrect-password" +-- >>> checkPassword badpass passHash +-- PasswordCheckFail +-- +-- This should always fail if an incorrect password is given. +-- +-- prop> \(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt 8 salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail +checkPassword :: Password -> PasswordHash Bcrypt -> PasswordCheck +checkPassword (Password pass) (PasswordHash passHash) = + if Bcrypt.validatePassword (toBytes pass) (toBytes passHash) + then PasswordCheckSuccess + else PasswordCheckFail + +-- | Generate a random 16-byte @bcrypt@ salt +-- +-- @since 2.0.0.0 +newSalt :: MonadIO m => m (Salt Bcrypt) +newSalt = Data.Password.Internal.newSalt 16 diff --git a/src/Data/Password/Internal.hs b/src/Data/Password/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Password/Internal.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-| +Module : Data.Password.Internal +Copyright : (c) Dennis Gosnell, 2019; Felix Paulusma, 2020 +License : BSD-style (see LICENSE file) +Maintainer : cdep.illabout@gmail.com +Stability : experimental +Portability : POSIX +-} + +module Data.Password.Internal ( + -- * Global types + Password(..) + , mkPassword + , PasswordHash(..) + , PasswordCheck(..) + , Salt(..) + , newSalt + -- * Unsafe function + , unsafeShowPassword + -- * Utility + , toBytes + , fromBytes + , from64 + , readT + , showT + ) where + +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Crypto.Random (getRandomBytes) +import Data.ByteArray (Bytes, convert) +import Data.ByteString (ByteString) +import Data.ByteString.Base64 (decodeBase64) +import Data.String (IsString(..)) +import Data.Text as T (Text, pack, unpack) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Text.Read (readMaybe) + + +-- | A plain-text password. +-- +-- This represents a plain-text password that has /NOT/ been hashed. +-- +-- You should be careful with 'Password'. Make sure not to write it to logs or +-- store it in a database. +-- +-- You can construct a 'Password' by using the 'mkPassword' function or as literal +-- strings together with the OverloadedStrings pragma (or manually, by using +-- 'fromString' on a 'String'). Alternatively, you could also use some of the +-- instances in the +-- library. +newtype Password = Password Text + deriving (IsString) + +-- | CAREFUL: 'Show'-ing a 'Password' will always print @"**PASSWORD**"@ +-- +-- >>> show ("hello" :: Password) +-- "**PASSWORD**" +-- +-- @since 1.0.0.0 +instance Show Password where + show _ = "**PASSWORD**" + +-- | Construct a 'Password' +-- +-- @since 1.0.0.0 +mkPassword :: Text -> Password +mkPassword = Password +{-# INLINE mkPassword #-} + +-- | A salt used by a hashing algorithm. +-- +-- @since 2.0.0.0 +newtype Salt a = Salt ByteString + deriving (Eq, Show) + +-- | Generate a random x-byte-long salt. +-- +-- @since 2.0.0.0 +newSalt :: MonadIO m => Int -> m (Salt a) +newSalt i = liftIO $ Salt <$> getRandomBytes i +{-# INLINE newSalt #-} + +-- | This is an unsafe function that shows a password in plain-text. +-- +-- >>> unsafeShowPassword ("foobar" :: Password) +-- "foobar" +-- +-- You should generally not use this function. +unsafeShowPassword :: Password -> Text +unsafeShowPassword (Password pass) = pass +{-# INLINE unsafeShowPassword #-} + +-- | A hashed password. +-- +-- This represents a password that has been put through a hashing function. +-- The hashed password can be stored in a database. +newtype PasswordHash a = PasswordHash + { unPasswordHash :: Text + } deriving (Eq, Ord, Read, Show) + +-- | The result of checking a password against a hashed version. This is +-- returned by the @checkPassword@ functions. +data PasswordCheck + = PasswordCheckSuccess + -- ^ The password check was successful. The plain-text password matches the + -- hashed password. + | PasswordCheckFail + -- ^ The password check failed. The plain-text password does not match the + -- hashed password. + deriving (Eq, Read, Show) + +-- | Converting 'Text' to 'Bytes' +toBytes :: Text -> Bytes +toBytes = convert . encodeUtf8 +{-# INLINE toBytes #-} + +-- | Converting 'Bytes' to 'Text' +fromBytes :: Bytes -> Text +fromBytes = decodeUtf8 . convert +{-# INLINE fromBytes #-} + +-- | Decodes a base64 'Text' to a regular 'ByteString' (if possible) +from64 :: Text -> Maybe ByteString +from64 = toMaybe . decodeBase64 . encodeUtf8 + where + toMaybe = either (const Nothing) Just +{-# INLINE from64 #-} + +-- | Same as 'read' but works on 'Text' +readT :: forall a. Read a => Text -> Maybe a +readT = readMaybe . T.unpack +{-# INLINE readT #-} + +-- | Same as 'show' but works on 'Text' +showT :: forall a. Show a => a -> Text +showT = T.pack . show +{-# INLINE showT #-} + diff --git a/src/Data/Password/PBKDF2.hs b/src/Data/Password/PBKDF2.hs new file mode 100644 --- /dev/null +++ b/src/Data/Password/PBKDF2.hs @@ -0,0 +1,294 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-| +Module : Data.Password.PBKDF2 +Copyright : (c) Felix Paulusma, 2020 +License : BSD-style (see LICENSE file) +Maintainer : cdep.illabout@gmail.com +Stability : experimental +Portability : POSIX + += PBKDF2 + +The PBKDF2 algorithm is one of the oldest and most solid password +algorithms out there. It has also, however, been shown to be +the least secure out of all major password algorithms. The main +reason for this is that is doesn't make use of any memory cost +or other method of making it difficult for specialized hardware +attacks, like GPU cracking attacks. + +It is still, however used all over the world, since it has been +shown to be a very reliable way to encrypt passwords. Though it is +most definitely better than trying to develop a password algorithm +on your own, or god-forbid, not using /any/ encryption on your stored +passwords. + +== Other algorithms + +Seeing as PBKDF2 is shown to be very weak in terms of protection +against GPU cracking attacks, it is generally advised to go with +@"Bcrypt"@, if not @"Scrypt"@ or @"Argon2"@. When unsure, @"Bcrypt"@ +would probably be the safest option, as it has no memory cost which +could become a problem if not properly calibrated to the machine +doing the password verifications. +-} + +module Data.Password.PBKDF2 ( + -- Algorithm + PBKDF2 + -- * Plain-text Password + , Password + , mkPassword + -- * Hash Passwords (PBKDF2) + , hashPassword + , PasswordHash(..) + -- * Verify Passwords (PBKDF2) + , checkPassword + , PasswordCheck(..) + -- * Hashing Manually (PBKDF2) + , hashPasswordWithParams + , defaultParams + , PBKDF2Params(..) + , PBKDF2Algorithm(..) + -- ** Hashing with salt (DISADVISED) + -- + -- | Hashing with a set 'Salt' is almost never what you want + -- to do. Use 'hashPassword' or 'hashPasswordWithParams' to have + -- automatic generation of randomized salts. + , hashPasswordWithSalt + , newSalt + , Salt(..) + -- * Unsafe debugging function to show a Password + , unsafeShowPassword + , -- * Setup for doctests. + -- $setup + ) where + +import Control.Monad (guard) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Crypto.Hash.Algorithms as Crypto (MD5(..)) +import Crypto.KDF.PBKDF2 as PBKDF2 +import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.ByteString.Char8 as C8 (length) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T (intercalate, pack, split, stripPrefix) +import Data.Word (Word32) + +import Data.Password ( + PasswordCheck(..) + , PasswordHash(..) + , Salt(..) + , mkPassword + , unsafeShowPassword + ) +import Data.Password.Internal (Password(..), from64, readT, toBytes) +import qualified Data.Password.Internal (newSalt) + + +-- | Phantom type for __PBKDF2__ +-- +-- @since 2.0.0.0 +data PBKDF2 + +-- $setup +-- >>> :set -XFlexibleInstances +-- >>> :set -XOverloadedStrings +-- +-- Import needed libraries. +-- +-- >>> import Data.Password +-- >>> import Data.ByteString (pack) +-- >>> import Test.QuickCheck (Arbitrary(arbitrary), Blind(Blind), vector) +-- >>> import Test.QuickCheck.Instances.Text () +-- +-- >>> instance Arbitrary (Salt a) where arbitrary = Salt . pack <$> vector 16 +-- >>> instance Arbitrary Password where arbitrary = fmap Password arbitrary +-- >>> let testParams = defaultParams{ pbkdf2Iterations = 5000 } +-- >>> let salt = Salt "abcdefghijklmnop" + +-- -- >>> instance Arbitrary (PasswordHash PBKDF2) where arbitrary = hashPasswordWithSalt defaultParams <$> arbitrary <*> arbitrary + +-- | Hash the 'Password' using the 'PBKDF2' hash algorithm +-- +-- >>> hashPassword $ mkPassword "foobar" +-- PasswordHash {unPasswordHash = "sha512:25000:...:..."} +hashPassword :: MonadIO m => Password -> m (PasswordHash PBKDF2) +hashPassword = hashPasswordWithParams defaultParams + +-- TODO: Add way to parse the following: +-- $pbkdf2-md5$29000$...$... +-- $pbkdf2$25000$...$... (SHA1) +-- $pbkdf2-sha256$29000$x9h7j/Ge8x6DMEao1VqrdQ$kra3R1wEnY8mPdDWOpTqOTINaAmZvRMcYd8u5OBQP9A +-- $pbkdf2-sha512$25000$LyWE0HrP2RsjZCxlDGFMKQ$1vC5Ohk2mCS9b6akqsEfgeb4l74SF8XjH.SljXf3dMLHdlY1GK9ojcCKts6/asR4aPqBmk74nCDddU3tvSCJvw + +-- | Parameters used in the 'PBKDF2' hashing algorithm. +-- +-- @since 2.0.0.0 +data PBKDF2Params = PBKDF2Params { + pbkdf2Salt :: Word32, + -- ^ Bytes to randomly generate as a unique salt, default is __16__ + pbkdf2Algorithm :: PBKDF2Algorithm, + -- ^ Which algorithm to use for hashing, default is __'PBKDF2_SHA512'__ + pbkdf2Iterations :: Word32, + -- ^ Rounds to hash, default is __25,000__ + pbkdf2OutputLength :: Word32 + -- ^ Output key length in bytes, default is __64__ + -- + -- Limits are min: 1, max: /the amount of entropy of the hashing algorithm/. + -- This is limited automatically to __16, 20, 32, 64__ + -- for __MD5, SHA1, SHA256, SHA512__, respectively. +} deriving (Eq, Show) + +-- | Default parameters for the 'PBKDF2' algorithm. +-- +-- >>> defaultParams +-- PBKDF2Params {pbkdf2Salt = 16, pbkdf2Algorithm = PBKDF2_SHA512, pbkdf2Iterations = 25000, pbkdf2OutputLength = 64} +-- +-- @since 2.0.0.0 +defaultParams :: PBKDF2Params +defaultParams = PBKDF2Params { + pbkdf2Salt = 16, + pbkdf2Algorithm = PBKDF2_SHA512, + pbkdf2Iterations = 25 * 1000, + pbkdf2OutputLength = 64 +} + +-- | Hash a password with the given 'PBKDF2Params' and also with the given 'Salt' +-- instead of a randomly generated salt using 'pbkdf2Salt' from 'PBKDF2Params'. (cf. 'hashPasswordWithParams') +-- Using 'hashPasswordWithSalt' is strongly __disadvised__ and 'hashPasswordWithParams' should be used instead. +-- /Never use a static salt in production applications!/ +-- +-- >>> let salt = Salt "abcdefghijklmnop" +-- >>> hashPasswordWithSalt defaultParams salt (mkPassword "foobar") +-- PasswordHash {unPasswordHash = "sha512:25000:YWJjZGVmZ2hpamtsbW5vcA==:JRElYYrOMe9OIV4LDxaLTgO9ho8fFBVofXoQcdngi7AcuH6Amvmlj2B0y6y1UtQciXXBepSCS+rpy8/vDDQvoA=="} +-- +-- (Note that we use an explicit 'Salt' in the example above. This is so that the +-- example is reproducible, but in general you should use 'hashPassword'. 'hashPassword' +-- (and 'hashPasswordWithParams') generates a new 'Salt' everytime it is called.) +hashPasswordWithSalt :: PBKDF2Params -> Salt PBKDF2 -> Password -> PasswordHash PBKDF2 +hashPasswordWithSalt params@PBKDF2Params{..} s@(Salt salt) pass = + PasswordHash $ T.intercalate ":" + [ algToText pbkdf2Algorithm + , T.pack $ show pbkdf2Iterations + , b64 salt + , b64 key + ] + where + b64 = Base64.encodeBase64 + key = hashPasswordWithSalt' params s pass + +-- | Only for internal use +hashPasswordWithSalt' :: PBKDF2Params -> Salt PBKDF2 -> Password -> ByteString +hashPasswordWithSalt' PBKDF2Params{..} (Salt salt) (Password pass) = + convert (pbkdf2Hash :: Bytes) + where + pbkdf2Hash = algToFunc pbkdf2Algorithm params (toBytes pass) (convert salt :: Bytes) + params = PBKDF2.Parameters { + PBKDF2.iterCounts = fromIntegral pbkdf2Iterations, + PBKDF2.outputLength = fromIntegral $ maxOutputLength pbkdf2Algorithm pbkdf2OutputLength + } + +-- | Hash a password using the 'PBKDF2' algorithm with the given 'PBKDF2Params'. +-- +-- __N.B.__: If you have any doubt in your knowledge of cryptography and/or the +-- 'PBKDF2' algorithm, please just use 'hashPassword'. +-- +-- @since 2.0.0.0 +hashPasswordWithParams :: MonadIO m => PBKDF2Params -> Password -> m (PasswordHash PBKDF2) +hashPasswordWithParams params pass = liftIO $ do + salt <- Data.Password.Internal.newSalt . fromIntegral $ pbkdf2Salt params + return $ hashPasswordWithSalt params salt pass + +-- | Check a 'Password' against a 'PasswordHash' 'PBKDF2'. +-- +-- Returns 'PasswordCheckSuccess' on success. +-- +-- >>> let pass = mkPassword "foobar" +-- >>> passHash <- hashPassword pass +-- >>> checkPassword pass passHash +-- PasswordCheckSuccess +-- +-- Returns 'PasswordCheckFail' if an incorrect 'Password' or 'PasswordHash' 'PBKDF2' is used. +-- +-- >>> let badpass = mkPassword "incorrect-password" +-- >>> checkPassword badpass passHash +-- PasswordCheckFail +-- +-- This should always fail if an incorrect password is given. +-- +-- prop> \(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt testParams salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail +checkPassword :: Password -> PasswordHash PBKDF2 -> PasswordCheck +checkPassword pass (PasswordHash passHash) = + fromMaybe PasswordCheckFail $ do + -- This step makes it possible to also check the following format: + -- "pbkdf2:sha256:150000:etc.etc." + let passHash' = fromMaybe passHash $ "pbkdf2:" `T.stripPrefix` passHash + paramList = T.split (== ':') passHash' + guard $ length paramList == 4 + let [ algT, + iterationsT, + salt64, + hashedKey64 ] = paramList + pbkdf2Algorithm <- textToAlg algT + pbkdf2Iterations <- readT iterationsT + salt <- from64 salt64 + hashedKey <- from64 hashedKey64 + let pbkdf2OutputLength = fromIntegral $ C8.length hashedKey + producedKey = hashPasswordWithSalt' PBKDF2Params{..} (Salt salt) pass + guard $ hashedKey == producedKey + return PasswordCheckSuccess + where + pbkdf2Salt = 16 + + +-- | Type of algorithm to use for hashing PBKDF2 passwords. +-- +-- N.B.: 'PBKDF2_MD5' and 'PBKDF2_SHA1' are not considered very secure. +data PBKDF2Algorithm = + PBKDF2_MD5 + | PBKDF2_SHA1 + | PBKDF2_SHA256 + | PBKDF2_SHA512 + deriving (Eq, Show) + +-- | Depending on the given algorithm limits the output length. +maxOutputLength :: PBKDF2Algorithm -> Word32 -> Word32 +maxOutputLength = min . \case + PBKDF2_MD5 -> 16 + PBKDF2_SHA1 -> 20 + PBKDF2_SHA256 -> 32 + PBKDF2_SHA512 -> 64 + +algToText :: PBKDF2Algorithm -> Text +algToText = \case + PBKDF2_MD5 -> "md5" + PBKDF2_SHA1 -> "sha1" + PBKDF2_SHA256 -> "sha256" + PBKDF2_SHA512 -> "sha512" + +textToAlg :: Text -> Maybe PBKDF2Algorithm +textToAlg = \case + "md5" -> Just PBKDF2_MD5 + "sha1" -> Just PBKDF2_SHA1 + "sha256" -> Just PBKDF2_SHA256 + "sha512" -> Just PBKDF2_SHA512 + _ -> Nothing + +-- Which function to use, based on the given algorithm +algToFunc :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray hash) + => PBKDF2Algorithm -> PBKDF2.Parameters -> password -> salt -> hash +algToFunc = \case + PBKDF2_MD5 -> PBKDF2.generate (PBKDF2.prfHMAC Crypto.MD5) + PBKDF2_SHA1 -> PBKDF2.fastPBKDF2_SHA1 + PBKDF2_SHA256 -> PBKDF2.fastPBKDF2_SHA256 + PBKDF2_SHA512 -> PBKDF2.fastPBKDF2_SHA512 + +-- | Generate a random 16-byte @PBKDF2@ salt +-- +-- @since 2.0.0.0 +newSalt :: MonadIO m => m (Salt PBKDF2) +newSalt = Data.Password.Internal.newSalt 16 diff --git a/src/Data/Password/Scrypt.hs b/src/Data/Password/Scrypt.hs new file mode 100644 --- /dev/null +++ b/src/Data/Password/Scrypt.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-| +Module : Data.Password.Scrypt +Copyright : (c) Dennis Gosnell, 2019; Felix Paulusma, 2020 +License : BSD-style (see LICENSE file) +Maintainer : cdep.illabout@gmail.com +Stability : experimental +Portability : POSIX + += scrypt + +The @scrypt@ algorithm is a fairly new one. First published +in 2009, but published by the IETF in 2016 as . +Originally used for the Tarsnap backup service, it is +designed to be costly by requiring large amounts of memory. + +== Other algorithms + +@scrypt@ does increase the memory requirement in contrast to +@"Bcrypt"@ and @"PBKDF2"@, but it turns out it is not as optimal +as it could be, and thus others have set out to search for other +algorithms that do fulfill on their promises. @"Argon2"@ seems +to be the winner in that search. + +That is not to say using @scrypt@ somehow means your passwords +won't be properly protected. The cryptography is sound and +thus is fine for protection against brute-force attacks. +Because of the memory cost, it is generally advised to use +@"Bcrypt"@ if you're not sure this might be a +problem on your system. +-} + +module Data.Password.Scrypt ( + -- * Algorithm + Scrypt + -- * Plain-text Password + , Password + , mkPassword + -- * Hash Passwords (scrypt) + , hashPassword + , PasswordHash(..) + -- * Verify Passwords (scrypt) + , checkPassword + , PasswordCheck(..) + -- * Hashing Manually (scrypt) + , hashPasswordWithParams + , defaultParams + , ScryptParams(..) + -- ** Hashing with salt (DISADVISED) + -- + -- | Hashing with a set 'Salt' is almost never what you want + -- to do. Use 'hashPassword' or 'hashPasswordWithParams' to have + -- automatic generation of randomized salts. + , hashPasswordWithSalt + , newSalt + , Salt(..) + -- * Unsafe debugging function to show a Password + , unsafeShowPassword + , -- * Setup for doctests. + -- $setup + ) where + +import Control.Monad (guard) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Crypto.KDF.Scrypt as Scrypt +import Data.ByteArray (Bytes, convert) +import Data.ByteString (ByteString) +import Data.ByteString.Base64 (encodeBase64) +import qualified Data.ByteString.Char8 as C8 (length) +import Data.Maybe (fromMaybe) +import qualified Data.Text as T (intercalate, split) +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) + +-- | Phantom type for __Argon2__ +-- +-- @since 2.0.0.0 +data Scrypt + +-- $setup +-- >>> :set -XFlexibleInstances +-- >>> :set -XOverloadedStrings +-- +-- Import needed libraries. +-- +-- >>> import Data.Password +-- >>> import Data.ByteString (pack) +-- >>> import Test.QuickCheck (Arbitrary(arbitrary), Blind(Blind), vector) +-- >>> import Test.QuickCheck.Instances.Text () +-- +-- >>> instance Arbitrary (Salt a) where arbitrary = Salt . pack <$> vector 32 +-- >>> instance Arbitrary Password where arbitrary = fmap Password arbitrary +-- >>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345" +-- >>> let testParams = defaultParams {scryptRounds = 10} + +-- -- >>> instance Arbitrary (PasswordHash Scrypt) where arbitrary = hashPasswordWithSalt testParams <$> arbitrary <*> arbitrary + +-- | Hash the 'Password' using the 'Scrypt' hash algorithm +-- +-- >>> hashPassword $ mkPassword "foobar" +-- PasswordHash {unPasswordHash = "14|8|1|...|..."} +hashPassword :: MonadIO m => Password -> m (PasswordHash Scrypt) +hashPassword = hashPasswordWithParams defaultParams + +-- TODO: Add way to parse the following. From [https://hashcat.net/wiki/doku.php?id=example_hashes] +-- SCRYPT:1024:1:1:MDIwMzMwNTQwNDQyNQ==:5FW+zWivLxgCWj7qLiQbeC8zaNQ+qdO0NUinvqyFcfo= + +-- | Parameters used in the 'Scrypt' hashing algorithm. +-- +-- @since 2.0.0.0 +data ScryptParams = ScryptParams { + scryptSalt :: Word32, + -- ^ Bytes to randomly generate as a unique salt, default is __32__ + scryptRounds :: Word32, + -- ^ log2(N) rounds to hash, default is __14__ (i.e. 2^14 rounds) + scryptBlockSize :: Word32, + -- ^ Block size, default is __8__ + -- + -- Limits are min: @1@, and max: @scryptBlockSize * scryptParallelism < 2 ^ 30@ + scryptParallelism :: Word32, + -- ^ Parallelism factor, default is __1__ + -- + -- Limits are min: @0@, and max: @scryptBlockSize * scryptParallelism < 2 ^ 30@ + scryptOutputLength :: Word32 + -- ^ Output key length in bytes, default is __64__ +} deriving (Eq, Show) + +-- | Default parameters for the 'Scrypt' algorithm. +-- +-- >>> defaultParams +-- ScryptParams {scryptSalt = 32, scryptRounds = 14, scryptBlockSize = 8, scryptParallelism = 1, scryptOutputLength = 64} +-- +-- @since 2.0.0.0 +defaultParams :: ScryptParams +defaultParams = ScryptParams { + scryptSalt = 32, + scryptRounds = 14, + scryptBlockSize = 8, + scryptParallelism = 1, + scryptOutputLength = 64 +} + +-- | Hash a password with the given 'ScryptParams' and also with the given 'Salt' +-- instead of a randomly generated salt using 'scryptSalt' from 'ScryptParams'. +-- Using 'hashPasswordWithSalt' is strongly __disadvised__ and 'hashPasswordWithParams' +-- should be used instead. /Never use a static salt in production applications!/ +-- +-- The resulting 'PasswordHash' has the parameters used to hash it, as well as the +-- 'Salt' appended to it, separated by @|@. +-- +-- The input 'Salt' and resulting 'PasswordHash' are both base64 encoded. +-- +-- >>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345" +-- >>> hashPasswordWithSalt defaultParams salt (mkPassword "foobar") +-- PasswordHash {unPasswordHash = "14|8|1|YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXowMTIzNDU=|nENDaqWBmPKapAqQ3//H0iBImweGjoTqn5SvBS8Mc9FPFbzq6w65maYPZaO+SPamVZRXQjARQ8Y+5rhuDhjIhw=="} +-- +-- (Note that we use an explicit 'Salt' in the example above. This is so that the +-- example is reproducible, but in general you should use 'hashPassword'. 'hashPassword' +-- generates a new 'Salt' everytime it is called.) +hashPasswordWithSalt :: ScryptParams -> Salt Scrypt -> Password -> PasswordHash Scrypt +hashPasswordWithSalt params@ScryptParams{..} s@(Salt salt) pass = + PasswordHash $ T.intercalate "|" + [ showT scryptRounds + , showT scryptBlockSize + , showT scryptParallelism + , encodeBase64 salt + , encodeBase64 key + ] + where + key = hashPasswordWithSalt' params s pass + +-- | Only for internal use +hashPasswordWithSalt' :: ScryptParams -> Salt Scrypt -> Password -> ByteString +hashPasswordWithSalt' ScryptParams{..} (Salt salt) (Password pass) = + convert (scryptHash :: Bytes) + where + scryptHash = Scrypt.generate params (toBytes pass) (convert salt :: Bytes) + params = Scrypt.Parameters { + n = 2 ^ scryptRounds, + r = fromIntegral scryptBlockSize, + p = fromIntegral scryptParallelism, + outputLength = fromIntegral scryptOutputLength + } + + +-- | Hash a password using the 'Scrypt' algorithm with the given 'ScryptParams'. +-- +-- __N.B.__: If you have any doubt in your knowledge of cryptography and/or the +-- 'Scrypt' algorithm, please just use 'hashPassword'. +-- +-- Advice for setting the parameters: +-- +-- * Memory used is about: @(2 ^ 'scryptRounds') * 'scryptBlockSize' * 128@ +-- * Increasing 'scryptBlockSize' and 'scryptRounds' will increase CPU time +-- and memory used. +-- * Increasing 'scryptParallelism' will increase CPU time. (since this +-- implementation, like most, runs the 'scryptParallelism' parameter in +-- sequence, not in parallel) +-- +-- @since 2.0.0.0 +hashPasswordWithParams :: MonadIO m => ScryptParams -> Password -> m (PasswordHash Scrypt) +hashPasswordWithParams params pass = liftIO $ do + salt <- Data.Password.Internal.newSalt saltLength + return $ hashPasswordWithSalt params salt pass + where + saltLength = fromIntegral $ scryptSalt params + +-- | Check a 'Password' against a 'PasswordHash' 'Scrypt'. +-- +-- Returns 'PasswordCheckSuccess' on success. +-- +-- >>> let pass = mkPassword "foobar" +-- >>> passHash <- hashPassword pass +-- >>> checkPassword pass passHash +-- PasswordCheckSuccess +-- +-- Returns 'PasswordCheckFail' if an incorrect 'Password' or 'PasswordHash' 'Scrypt' is used. +-- +-- >>> let badpass = mkPassword "incorrect-password" +-- >>> checkPassword badpass passHash +-- PasswordCheckFail +-- +-- This should always fail if an incorrect password is given. +-- +-- prop> \(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt testParams salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail +checkPassword :: Password -> PasswordHash Scrypt -> PasswordCheck +checkPassword pass (PasswordHash passHash) = + fromMaybe PasswordCheckFail $ do + let paramList = T.split (== '|') passHash + guard $ length paramList == 5 + let [ scryptRoundsT, + scryptBlockSizeT, + scryptParallelismT, + salt64, + hashedKey64 ] = paramList + scryptRounds <- readT scryptRoundsT + scryptBlockSize <- readT scryptBlockSizeT + scryptParallelism <- readT scryptParallelismT + salt <- from64 salt64 + hashedKey <- from64 hashedKey64 + let scryptOutputLength = fromIntegral $ C8.length hashedKey + producedKey = hashPasswordWithSalt' ScryptParams{..} (Salt salt) pass + guard $ hashedKey == producedKey + return PasswordCheckSuccess + where + scryptSalt = 32 -- only here because of warnings + +-- | Generate a random 32-byte @scrypt@ salt +-- +-- @since 2.0.0.0 +newSalt :: MonadIO m => m (Salt Scrypt) +newSalt = Data.Password.Internal.newSalt 32 diff --git a/test/doctest/doctest.hs b/test/doctest/doctest.hs --- a/test/doctest/doctest.hs +++ b/test/doctest/doctest.hs @@ -1,7 +1,14 @@ - -module Main (main) where +module Main where -import Test.DocTest +import Build_doctests (flags, pkgs, module_sources) +-- import Data.Foldable (traverse_) +import System.Environment.Compat (unsetEnv) +import Test.DocTest (doctest) main :: IO () -main = doctest ["src"] +main = do + -- traverse_ putStrLn args + unsetEnv "GHC_ENVIRONMENT" + doctest args + where + args = flags ++ pkgs ++ module_sources diff --git a/test/tasty/Argon2.hs b/test/tasty/Argon2.hs new file mode 100644 --- /dev/null +++ b/test/tasty/Argon2.hs @@ -0,0 +1,29 @@ +module Argon2 where + +import Test.Tasty +import Test.QuickCheck.Instances.Text () + +import Data.Password.Argon2 + +import Internal + + +testArgon2 :: TestTree +testArgon2 = testGroup "Argon2" + [ testCorrectPassword "Argon2 (hashPassword)" hashFast checkPassword + , testIncorrectPassword "Argon2 (hashPassword) fail" hashFast checkPassword + , testWithSalt "Argon2 (hashPasswordWithSalt)" + (hashPasswordWithSalt fastParams) + checkPassword + , testWithParams "Argon2 (Argon2i)" $ fastParams{ argon2Variant = Argon2i } + , testWithParams "Argon2 (Argon2d)" $ fastParams{ argon2Variant = Argon2d } + ] + where + testWithParams s params = + testWithSalt s (hashPasswordWithSalt params) checkPassword + hashFast = hashPasswordWithParams fastParams + fastParams = + defaultParams{ + argon2MemoryCost = 2 ^ (8 :: Int), + argon2TimeCost = 1 + } diff --git a/test/tasty/Bcrypt.hs b/test/tasty/Bcrypt.hs new file mode 100644 --- /dev/null +++ b/test/tasty/Bcrypt.hs @@ -0,0 +1,19 @@ +module Bcrypt where + +import Data.Text (Text) +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.QuickCheck.Instances.Text () + +import Data.Password +import Data.Password.Bcrypt + +import Internal (testCorrectPassword, testIncorrectPassword_, testWithSalt) + + +testBcrypt :: TestTree +testBcrypt = testGroup "bcrypt" + [ testCorrectPassword "Bcrypt (hashPassword)" (hashPasswordWithParams 4) checkPassword + , testIncorrectPassword_ "Bcrypt (hashPassword) fail" (hashPasswordWithParams 4) checkPassword + , testWithSalt "Bcrypt (hashPasswordWithSalt)" (hashPasswordWithSalt 4) checkPassword + ] diff --git a/test/tasty/Internal.hs b/test/tasty/Internal.hs new file mode 100644 --- /dev/null +++ b/test/tasty/Internal.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Internal where + +import Data.ByteArray (pack) +import Data.Text (Text) +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.QuickCheck.Instances.Text () + +import Data.Password + + +testCorrectPassword :: String + -> (Password -> IO (PasswordHash a)) + -> (Password -> PasswordHash a -> PasswordCheck) + -> TestTree +testCorrectPassword s hashF checkF = testProperty s $ + \pass -> run10 $ do + let pw = mkPassword pass + hpw <- hashF pw + return $ checkF pw hpw === PasswordCheckSuccess + +testIncorrectPassword :: String + -> (Password -> IO (PasswordHash a)) + -> (Password -> PasswordHash a -> PasswordCheck) + -> TestTree +testIncorrectPassword s hashF checkF = + testProperty s $ testIncorrectPassword' hashF checkF + +-- Similar to 'testIncorrectPassword', but exempts the comparison of +-- "" and "\NUL", since 'bcrypt' and 'PBKDF2' match those as well. +testIncorrectPassword_ :: String + -> (Password -> IO (PasswordHash a)) + -> (Password -> PasswordHash a -> PasswordCheck) + -> TestTree +testIncorrectPassword_ s hashF checkF = + testProperty s $ \pass pass2 -> + not (all isEmpty [pass, pass2]) ==> + testIncorrectPassword' hashF checkF pass pass2 + where + isEmpty c = c `elem` ["", "\NUL"] + +testIncorrectPassword' :: (Password -> IO (PasswordHash a)) + -> (Password -> PasswordHash a -> PasswordCheck) + -> Text -> Text -> Property +testIncorrectPassword' hashF checkF pass pass2 = run10 $ do + let pw = mkPassword pass + pw2 = mkPassword pass2 + result = if pass == pass2 then PasswordCheckSuccess + else PasswordCheckFail + hpw <- hashF pw + return $ checkF pw2 hpw === result + +testWithSalt :: String + -> (Salt a -> Password -> PasswordHash a) + -> (Password -> PasswordHash a -> PasswordCheck) + -> TestTree +testWithSalt s hashWithSalt checkF = testProperty s $ + \pass salt -> withMaxSuccess 10 $ + let pw = mkPassword pass + hpw = hashWithSalt salt pw + in checkF pw hpw === PasswordCheckSuccess + +run10 :: Testable prop => IO prop -> Property +run10 = withMaxSuccess 10 . ioProperty + +instance Arbitrary (Salt a) where + arbitrary = Salt . pack <$> vector 16 diff --git a/test/tasty/PBKDF2.hs b/test/tasty/PBKDF2.hs new file mode 100644 --- /dev/null +++ b/test/tasty/PBKDF2.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module PBKDF2 where + +import Crypto.Hash.Algorithms as Crypto (HashAlgorithm, SHA1(..), SHA256(..), SHA512(..)) +import Crypto.KDF.PBKDF2 as PBKDF2 +import Data.ByteString (ByteString) +#if !MIN_VERSION_base(4,13,0) +import Data.Semigroup ((<>)) +#endif +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.QuickCheck.Instances.ByteString () +import Test.QuickCheck.Instances.Text () + +import Data.Password.PBKDF2 + +import Internal + +_10k :: Num a => a +_10k = 10 * 1000 + +testPBKDF2 :: TestTree +testPBKDF2 = testGroup "PBKDF2" + [ testIt "PBKDF2 (hashPassword)" $ _10k defaultParams -- This is PBKDF2_SHA512 + , testIncorrectPassword_ + "PBKDF2 (hashPassword) fail" + (hashPasswordWithParams $ _10k defaultParams) + checkPassword + , testWithSalt + "PBKDF2 (hashPasswordWithSalt)" + (hashPasswordWithSalt $ _10k defaultParams) + checkPassword + , testIt "PBKDF2 (md5)" (defaultParams{ pbkdf2Algorithm = PBKDF2_MD5, pbkdf2Iterations = 5000 }) + , testIt "PBKDF2 (sha1)" (_10k defaultParams{ pbkdf2Algorithm = PBKDF2_SHA1 }) + , testIt "PBKDF2 (sha256)" (_10k defaultParams{ pbkdf2Algorithm = PBKDF2_SHA256 }) + , testFast Crypto.SHA1 20 PBKDF2.fastPBKDF2_SHA1 + , testFast Crypto.SHA256 32 PBKDF2.fastPBKDF2_SHA256 + , testFast Crypto.SHA512 64 PBKDF2.fastPBKDF2_SHA512 + -- Check to see if a hash with "pbkdf2:" prefixed also works + , testCorrectPassword + "PBKDF2 (pbkdf2:sha-...)" + (hashPasswordWithParams $ _10k defaultParams) + (\pass (PasswordHash hash) -> checkPassword pass . PasswordHash $ "pbkdf2:" <> hash) + ] + where + testIt s params = testCorrectPassword s (hashPasswordWithParams params) checkPassword + _10k params = params{ pbkdf2Iterations = 10 * 1000 } + +testFast :: (HashAlgorithm a, Show a) + => a + -> Int + -> (Parameters -> ByteString -> ByteString -> ByteString) + -> TestTree +testFast alg i f = testProperty s $ \pass salt -> run10 $ + return $ f params pass salt === + PBKDF2.generate (PBKDF2.prfHMAC alg) params pass salt + where + params = cryptoParams i + s = sAlg ++ " HMAC == fast_" ++ sAlg + sAlg = show alg + +cryptoParams :: Int -> PBKDF2.Parameters +cryptoParams i = PBKDF2.Parameters { + PBKDF2.iterCounts = 5000, + PBKDF2.outputLength = i + } diff --git a/test/tasty/Scrypt.hs b/test/tasty/Scrypt.hs new file mode 100644 --- /dev/null +++ b/test/tasty/Scrypt.hs @@ -0,0 +1,37 @@ +module Scrypt where + +import Data.Maybe (fromJust) +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.QuickCheck.Instances.Text () + +import qualified Crypto.Scrypt as Scrypt +import Data.Password +import Data.Password.Scrypt + +import Internal + + +testScrypt :: TestTree +testScrypt = testGroup "scrypt" + [ testCorrectPassword "Scrypt (hashPassword)" hash8Rounds checkPassword + , testIncorrectPassword "Scrypt (hashPassword) fail" hash8Rounds checkPassword + , testWithSalt "Scrypt (hashPasswordWithSalt)" + (hashPasswordWithSalt defaultParams{ scryptRounds = 8 }) + checkPassword + , testProperty "scrypt <-> cryptonite" $ withMaxSuccess 10 checkScrypt + ] + where + hash8Rounds = hashPasswordWithParams defaultParams{ scryptRounds = 8 } + +checkScrypt :: Text -> Property +checkScrypt pass = ioProperty $ do + s@(Scrypt.Salt salt) <- Scrypt.newSalt + let params = fromJust $ Scrypt.scryptParams 8 8 1 + Scrypt.EncryptedPass scryptHash = + Scrypt.encryptPass params s $ Scrypt.Pass $ encodeUtf8 pass + PasswordHash ourHash = + hashPasswordWithSalt defaultParams{ scryptRounds = 8 } (Salt salt) $ mkPassword pass + return $ scryptHash === encodeUtf8 ourHash diff --git a/test/tasty/Spec.hs b/test/tasty/Spec.hs --- a/test/tasty/Spec.hs +++ b/test/tasty/Spec.hs @@ -1,27 +1,21 @@ -import Crypto.Scrypt (Salt(..)) -import Data.Text.Encoding (encodeUtf8) import Test.Tasty import Test.Tasty.QuickCheck -import Test.QuickCheck.Instances.Text () +import Test.Tasty.Runners (NumThreads(..)) import Data.Password +import Argon2 +import Bcrypt +import PBKDF2 +import Scrypt + main :: IO () -main = defaultMain $ testGroup "Password" - [ testProperty "Pass" $ \pass -> - unsafeShowPasswordText (mkPass pass) === pass - , testProperty "Scrypt (hashPass)" $ \pass -> ioProperty $ do - let pw = mkPass pass - hpw <- hashPass pw - return $ checkPass pw hpw === PassCheckSuccess - , testProperty "Scrypt (hashPass) fail" $ \pass pass2 -> ioProperty $ do - let pw = mkPass pass - pw2 = mkPass pass2 - result = if pass == pass2 then PassCheckSuccess else PassCheckFail - hpw <- hashPass pw - return $ checkPass pw2 hpw === result - , testProperty "Scrypt (hashPassWithSalt)" $ \pass salt -> - let pw = mkPass pass - hpw = hashPassWithSalt (Salt $ encodeUtf8 salt) pw - in checkPass pw hpw === PassCheckSuccess - ] +main = defaultMain $ localOption (NumThreads 1) $ + testGroup "Password" + [ testProperty "Password" $ \pass -> + unsafeShowPassword (mkPassword pass) === pass + , testArgon2 + , testBcrypt + , testPBKDF2 + , testScrypt + ]