diff --git a/password-types/ChangeLog.md b/password-types/ChangeLog.md index be1dc19..3ab1b91 100644 --- a/password-types/ChangeLog.md +++ b/password-types/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for `password-types` +## 1.0.1.0 + +- Removed `memory` dependency by implementing `constEq` in this package. +- Exporting `constEquals` for reuse in other packages to minimize dependencies + on `memory` or `ram`. + ## 1.0.0.0 - Split out this package from the `password` package to not saddle up diff --git a/password-types/password-types.cabal b/password-types/password-types.cabal index fb378a9..a66a27a 100644 --- a/password-types/password-types.cabal +++ b/password-types/password-types.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: password-types -version: 1.0.0.0 +version: 1.0.1.0 category: Security synopsis: Types for handling passwords description: A library providing types for working with plain-text and hashed passwords. @@ -37,7 +37,6 @@ library build-depends: base >= 4.9 && < 5 , bytestring < 1 - , memory < 1 , text < 3 ghc-options: -Wall diff --git a/password-types/src/Data/Password/Types.hs b/password-types/src/Data/Password/Types.hs index 871feb8..bead995 100644 --- a/password-types/src/Data/Password/Types.hs +++ b/password-types/src/Data/Password/Types.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} + {-| Module : Data.Password.Types Copyright : (c) Dennis Gosnell, 2019; Felix Paulusma, 2020 @@ -48,14 +50,27 @@ module Data.Password.Types ( , unsafeShowPassword -- * Hashing salts , Salt (..) + -- * Utility functions + + -- | These functions might not be specific to passwords, but + -- can be useful when handling them. + , constEquals ) where -import Data.ByteArray (constEq) -import Data.ByteString (ByteString) +import Data.ByteString.Internal (ByteString (..)) import Data.Function (on) import Data.String (IsString(..)) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) +import Foreign ( + Word8, + Ptr, + Bits ((.|.), xor), + peekByteOff, + plusPtr, + withForeignPtr, + ) +import System.IO.Unsafe (unsafeDupablePerformIO) -- $setup -- >>> :set -XOverloadedStrings @@ -112,9 +127,46 @@ newtype PasswordHash a = PasswordHash } deriving (Ord, Read, Show) instance Eq (PasswordHash a) where - (==) = constEq `on` encodeUtf8 . unPasswordHash + (==) = constEquals `on` encodeUtf8 . unPasswordHash -- | A salt used by a hashing algorithm. newtype Salt a = Salt { getSalt :: ByteString } deriving (Eq, Show) + +-- The below is somewhat copied over from the 'memory'(/ram) package(s) + +-- | Checking two 'ByteString's for equality without short-circuiting on the +-- first byte that is different. This is used in the definition of '==' for +-- 'PasswordHash'es, to mitigate timing attacks. +-- +-- It _will_ give an early 'False' if the length of the 'ByteString's aren't +-- the same, but this does not help in timing attacks since that means the +-- comparison is being done between two hashes of different hash functions. +-- Which only happens if the implementation is comparing the wrong hashes. +constEquals :: ByteString -> ByteString -> Bool +constEquals (PS fptr1 off1 l1) (PS fptr2 off2 l2) + -- This is used to compare hashes of passwords, which should be equal length + -- if they compare the same type of algorithm with the same settings, so it's + -- fine to do an early return on bad hash comparisons. + | l1 /= l2 = False + | otherwise = + unsafeDupablePerformIO $ + withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + -- Using the 'offset' for backwards compatibility (bytestring < 0.11) + memConstEqual (ptr1 `plusPtr` off1) (ptr2 `plusPtr` off2) l1 + +-- | This function MUST take two memory buffers of equal length, +-- or it will have undefined behaviour. +memConstEqual :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool +memConstEqual p1 p2 n = + loop 0 0 + where + loop :: Int -> Word8 -> IO Bool + loop i !acc + | i == n = pure $! acc == 0 + | otherwise = do + w1 <- peekByteOff p1 i + w2 <- peekByteOff p2 i + loop (i + 1) (acc .|. xor w1 w2) diff --git a/password-types/test/tasty/Spec.hs b/password-types/test/tasty/Spec.hs index 2b7b7e0..b0f1f39 100644 --- a/password-types/test/tasty/Spec.hs +++ b/password-types/test/tasty/Spec.hs @@ -2,11 +2,17 @@ module Main where import Data.String (fromString) import Data.Text (pack) -import Test.QuickCheck.Instances() -import Test.Tasty ( defaultMain, testGroup ) -import Test.Tasty.QuickCheck ( (===), testProperty ) +import Data.Text.Encoding (encodeUtf8) +import Test.QuickCheck.Instances () +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.QuickCheck ((===), testProperty) -import Data.Password.Types ( mkPassword, unsafeShowPassword ) +import Data.Password.Types ( + PasswordHash (..), + constEquals, + mkPassword, + unsafeShowPassword, + ) main :: IO () main = defaultMain $ @@ -17,4 +23,13 @@ main = defaultMain $ show (mkPassword pass) === "**PASSWORD**" , testProperty "fromString works" $ \pass -> unsafeShowPassword (fromString pass) === pack pass + , testProperty "constEquals works identical to '=='" $ \t1 t2 -> + let b1 = encodeUtf8 t1 + b2 = encodeUtf8 t2 + in (b1 `constEquals` b2) == (b1 == b2) + , testProperty "constEquals is True on the same input" $ \t1 -> + let b1 = encodeUtf8 t1 + in b1 `constEquals` b1 + , testProperty "comparing 'PasswordHash'es works" $ \t1 -> + PasswordHash t1 === PasswordHash t1 ]