From f31b48a708afa55f3d7806d0b944d64380083e3f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Oct 2016 22:13:32 -0400 Subject: Remove embedded copy of argon2 binding, depend on fixed version of package. Test suite passes. This commit was sponsored by Ignacio on Patreon --- CHANGELOG | 6 ++ Crypto/Argon2.hs | 280 -------------------------------------------------- Crypto/Argon2/FFI.hsc | 127 ----------------------- keysafe.cabal | 7 +- stack.yaml | 1 + 5 files changed, 8 insertions(+), 413 deletions(-) delete mode 100644 Crypto/Argon2.hs delete mode 100644 Crypto/Argon2/FFI.hsc diff --git a/CHANGELOG b/CHANGELOG index 1a0cd23..b1184fd 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +keysafe (0.20160928) UNRELEASED; urgency=medium + + * Remove embedded copy of argon2 binding, depend on fixed version of package. + + -- Joey Hess Wed, 05 Oct 2016 20:54:51 -0400 + keysafe (0.20160927) unstable; urgency=medium * Makefile: Avoid rebuilding on make install, so that sudo make install works. diff --git a/Crypto/Argon2.hs b/Crypto/Argon2.hs deleted file mode 100644 index a320354..0000000 --- a/Crypto/Argon2.hs +++ /dev/null @@ -1,280 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE RecordWildCards #-} - -{-| - -"Crypto.Argon2" provides bindings to the - of Argon2, -the password-hashing function that won the -. - -The main entry points to this module are 'hashEncoded', which produces a -crypt-like ASCII output; and 'hash' which produces a 'BS.ByteString' (a stream -of bytes). Argon2 is a configurable hash function, and can be configured by -supplying a particular set of 'HashOptions' - 'defaultHashOptions' should provide -a good starting point. See 'HashOptions' for more documentation on the particular -parameters that can be adjusted. - -For access directly to the C interface, see "Crypto.Argon2.FFI". - --} - -{- - -Copyright (c) 2016, Ollie Charles - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Ollie Charles 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 -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - - -} - -module Crypto.Argon2 - ( -- * Computing hashes - hashEncoded, hash, - -- * Verification - verify, - -- * Configuring hashing - HashOptions(..), Argon2Variant(..), defaultHashOptions, - -- * Exceptions - Argon2Exception(..)) - where - -import GHC.Generics (Generic) -import Control.Exception -import Data.Typeable -import Foreign -import Foreign.C -import System.IO.Unsafe (unsafePerformIO) -import qualified Crypto.Argon2.FFI as FFI -import qualified Data.ByteString as BS -import qualified Data.Text as T -import qualified Data.Text.Encoding as T - --- | Which variant of Argon2 to use. You should choose the variant that is most --- applicable to your intention to hash inputs. -data Argon2Variant - = Argon2i -- ^ Argon2i uses data-independent memory access, which is preferred - -- for password hashing and password-based key derivation. Argon2i - -- is slower as it makes more passes over the memory to protect from - -- tradeoff attacks. - | Argon2d -- ^ Argon2d is faster and uses data-depending memory access, which - -- makes it suitable for cryptocurrencies and applications with no - -- threats from side-channel timing attacks. - deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum) - --- | Parameters that can be adjusted to change the runtime performance of the --- hashing. -data HashOptions = - HashOptions {hashIterations :: !Word32 -- ^ The time cost, which defines the amount of computation realized and therefore the execution time, given in number of iterations. - -- - -- 'FFI.ARGON2_MIN_TIME' <= 'hashIterations' <= 'FFI.ARGON2_MAX_TIME' - ,hashMemory :: !Word32 -- ^ The memory cost, which defines the memory usage, given in kibibytes. - -- - -- max 'FFI.ARGON2_MIN_MEMORY' (8 * 'hashParallelism') <= 'hashMemory' <= 'FFI.ARGON2_MAX_MEMORY' - ,hashParallelism :: !Word32 -- ^ A parallelism degree, which defines the number of parallel threads. - -- - -- 'FFI.ARGON2_MIN_LANES' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_LANES' && 'FFI.ARGON_MIN_THREADS' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_THREADS' - ,hashVariant :: !Argon2Variant -- ^ Which version of Argon2 to use. - } - deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable) - --- | A set of default 'HashOptions', taken from the @argon2@ executable. --- --- @ --- 'defaultHashOptions' :: 'HashOptions' --- 'defaultHashOptions' = --- 'HashOptions' {'hashIterations' = 1 --- ,'hashMemory' = 2 ^ 17 --- ,'hashParallelism' = 4 --- ,'hashVariant' = 'Argon2i'} --- @ -defaultHashOptions :: HashOptions -defaultHashOptions = - HashOptions {hashIterations = 1 - ,hashMemory = 2 ^ (17 :: Integer) - ,hashParallelism = 4 - ,hashVariant = Argon2i} - --- | Encode a password with a given salt and 'HashOptions' and produce a textual --- encoding of the result. -hashEncoded :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate. - -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes. - -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes. - -> T.Text -- ^ The encoded password hash. -hashEncoded options password salt = - unsafePerformIO - (hashEncoded' options password salt FFI.argon2i_hash_encoded FFI.argon2d_hash_encoded) - --- | Encode a password with a given salt and 'HashOptions' and produce a stream --- of bytes. -hash :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate. - -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes. - -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes. - -> BS.ByteString -- ^ The un-encoded password hash. -hash options password salt = - unsafePerformIO (hash' options password salt FFI.argon2i_hash_raw FFI.argon2d_hash_raw) - -variant :: a -> a -> Argon2Variant -> a -variant a _ Argon2i = a -variant _ b Argon2d = b -{-# INLINE variant #-} - --- | Not all 'HashOptions' can necessarily be used to compute hashes. If you --- supply invalid 'HashOptions' (or hashing otherwise fails) a 'Argon2Exception' --- will be throw. -data Argon2Exception - = -- | The length of the supplied password is outside the range supported by @libargon2@. - Argon2PasswordLengthOutOfRange !CSize -- ^ The erroneous length. - | -- | The length of the supplied salt is outside the range supported by @libargon2@. - Argon2SaltLengthOutOfRange !CSize -- ^ The erroneous length. - | -- | Either too much or too little memory was requested via 'hashMemory'. - Argon2MemoryUseOutOfRange !Word32 -- ^ The erroneous 'hashMemory' value. - | -- | Either too few or too many iterations were requested via 'hashIterations'. - Argon2IterationCountOutOfRange !Word32 -- ^ The erroneous 'hashIterations' value. - | -- | Either too much or too little parallelism was requested via 'hasParallelism'. - Argon2ParallelismOutOfRange !Word32 -- ^ The erroneous 'hashParallelism' value. - | -- | An unexpected exception was throw. Please ! - Argon2Exception !Int32 -- ^ The =libargon2= error code. - deriving (Typeable, Show) - -instance Exception Argon2Exception - -type Argon2Encoded = Word32 -> Word32 -> Word32 -> CString -> CSize -> CString -> CSize -> CSize -> CString -> CSize -> IO Int32 - -hashEncoded' :: HashOptions - -> BS.ByteString - -> BS.ByteString - -> Argon2Encoded - -> Argon2Encoded - -> IO T.Text -hashEncoded' options@HashOptions{..} password salt argon2i argon2d = - do let saltLen = fromIntegral (BS.length salt) - passwordLen = fromIntegral (BS.length password) - outLen = - (BS.length salt * 4 + 32 * 4 + - length ("$argon2x$m=,t=,p=$$" :: String) + - 3 * 3) - out <- mallocBytes outLen - res <- - BS.useAsCString password $ - \password' -> - BS.useAsCString salt $ - \salt' -> - argon2 hashIterations - hashMemory - hashParallelism - password' - passwordLen - salt' - saltLen - 64 - out - (fromIntegral outLen) - handleSuccessCode res options password salt - fmap T.decodeUtf8 (BS.packCString out) - where argon2 = variant argon2i argon2d hashVariant - -type Argon2Unencoded = Word32 -> Word32 -> Word32 -> CString -> CSize -> CString -> CSize -> CString -> CSize -> IO Int32 - -hash' :: HashOptions - -> BS.ByteString - -> BS.ByteString - -> Argon2Unencoded - -> Argon2Unencoded - -> IO BS.ByteString -hash' options@HashOptions{..} password salt argon2i argon2d = - do let saltLen = fromIntegral (BS.length salt) - passwordLen = fromIntegral (BS.length password) - outLen = 512 - out <- mallocBytes outLen - res <- - BS.useAsCString password $ - \password' -> - BS.useAsCString salt $ - \salt' -> - argon2 hashIterations - hashMemory - hashParallelism - password' - passwordLen - salt' - saltLen - out - (fromIntegral outLen) - handleSuccessCode res options password salt - BS.packCString out - where argon2 = variant argon2i argon2d hashVariant - -handleSuccessCode :: Int32 - -> HashOptions - -> BS.ByteString - -> BS.ByteString - -> IO () -handleSuccessCode res HashOptions{..} password salt = - let saltLen = fromIntegral (BS.length salt) - passwordLen = fromIntegral (BS.length password) - in case res of - a - | a `elem` [FFI.ARGON2_OK] -> return () - | a `elem` [FFI.ARGON2_SALT_TOO_SHORT,FFI.ARGON2_SALT_TOO_LONG] -> - throwIO (Argon2SaltLengthOutOfRange saltLen) - | a `elem` [FFI.ARGON2_PWD_TOO_SHORT,FFI.ARGON2_PWD_TOO_LONG] -> - throwIO (Argon2PasswordLengthOutOfRange passwordLen) - | a `elem` [FFI.ARGON2_TIME_TOO_SMALL,FFI.ARGON2_TIME_TOO_LARGE] -> - throwIO (Argon2IterationCountOutOfRange hashIterations) - | a `elem` [FFI.ARGON2_MEMORY_TOO_LITTLE,FFI.ARGON2_MEMORY_TOO_MUCH] -> - throwIO (Argon2MemoryUseOutOfRange hashMemory) - | a `elem` - [FFI.ARGON2_LANES_TOO_FEW - ,FFI.ARGON2_LANES_TOO_MANY - ,FFI.ARGON2_THREADS_TOO_FEW - ,FFI.ARGON2_THREADS_TOO_MANY] -> - throwIO (Argon2ParallelismOutOfRange hashParallelism) - | otherwise -> throwIO (Argon2Exception a) - --- | Verify that a given password could result in a given hash output. --- Automatically determines the correct 'HashOptions' based on the --- encoded hash (as produced by 'hashEncoded'). -verify - :: T.Text -> BS.ByteString -> Bool -verify encoded password = - unsafePerformIO - (BS.useAsCString password $ - \pwd -> - BS.useAsCString (T.encodeUtf8 encoded) $ - \enc -> - do res <- - (variant FFI.argon2i_verify FFI.argon2d_verify v) enc - pwd - (fromIntegral (BS.length password)) - return (res == FFI.ARGON2_OK)) - where v | T.pack "$argon2i" `T.isPrefixOf` encoded = Argon2i - | otherwise = Argon2d diff --git a/Crypto/Argon2/FFI.hsc b/Crypto/Argon2/FFI.hsc deleted file mode 100644 index 810a9a0..0000000 --- a/Crypto/Argon2/FFI.hsc +++ /dev/null @@ -1,127 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE PatternSynonyms #-} - -module Crypto.Argon2.FFI where - -#include -#include - -{- - -Copyright (c) 2016, Ollie Charles - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Ollie Charles 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 -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - - -} - -import Foreign -import Foreign.C - -foreign import ccall unsafe "argon2.h argon2i_hash_encoded" argon2i_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> CSize -> CString -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2i_hash_raw" argon2i_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> Ptr c -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2d_hash_encoded" argon2d_hash_encoded :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> CSize -> CString -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2d_hash_raw" argon2d_hash_raw :: (#type const uint32_t) -> (#type const uint32_t) -> (#type const uint32_t) -> Ptr a -> CSize -> Ptr b -> CSize -> Ptr c -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2i_verify" argon2i_verify :: CString -> Ptr a -> CSize -> IO (#type int) - -foreign import ccall unsafe "argon2.h argon2d_verify" argon2d_verify :: CString -> Ptr a -> CSize -> IO (#type int) - -pattern ARGON2_OK = (#const ARGON2_OK) -pattern ARGON2_OUTPUT_PTR_NULL = (#const ARGON2_OUTPUT_PTR_NULL) -pattern ARGON2_OUTPUT_TOO_SHORT = (#const ARGON2_OUTPUT_TOO_SHORT) -pattern ARGON2_OUTPUT_TOO_LONG = (#const ARGON2_OUTPUT_TOO_LONG) -pattern ARGON2_PWD_TOO_SHORT = (#const ARGON2_PWD_TOO_SHORT) -pattern ARGON2_PWD_TOO_LONG = (#const ARGON2_PWD_TOO_LONG) -pattern ARGON2_SALT_TOO_SHORT = (#const ARGON2_SALT_TOO_SHORT) -pattern ARGON2_SALT_TOO_LONG = (#const ARGON2_SALT_TOO_LONG) -pattern ARGON2_AD_TOO_SHORT = (#const ARGON2_AD_TOO_SHORT) -pattern ARGON2_AD_TOO_LONG = (#const ARGON2_AD_TOO_LONG) -pattern ARGON2_SECRET_TOO_SHORT = (#const ARGON2_SECRET_TOO_SHORT) -pattern ARGON2_SECRET_TOO_LONG = (#const ARGON2_SECRET_TOO_LONG) -pattern ARGON2_TIME_TOO_SMALL = (#const ARGON2_TIME_TOO_SMALL) -pattern ARGON2_TIME_TOO_LARGE = (#const ARGON2_TIME_TOO_LARGE) -pattern ARGON2_MEMORY_TOO_LITTLE = (#const ARGON2_MEMORY_TOO_LITTLE) -pattern ARGON2_MEMORY_TOO_MUCH = (#const ARGON2_MEMORY_TOO_MUCH) -pattern ARGON2_LANES_TOO_FEW = (#const ARGON2_LANES_TOO_FEW) -pattern ARGON2_LANES_TOO_MANY = (#const ARGON2_LANES_TOO_MANY) -pattern ARGON2_PWD_PTR_MISMATCH = (#const ARGON2_PWD_PTR_MISMATCH) -pattern ARGON2_SALT_PTR_MISMATCH = (#const ARGON2_SALT_PTR_MISMATCH) -pattern ARGON2_SECRET_PTR_MISMATCH = (#const ARGON2_SECRET_PTR_MISMATCH) -pattern ARGON2_AD_PTR_MISMATCH = (#const ARGON2_AD_PTR_MISMATCH) -pattern ARGON2_MEMORY_ALLOCATION_ERROR = (#const ARGON2_MEMORY_ALLOCATION_ERROR) -pattern ARGON2_FREE_MEMORY_CBK_NULL = (#const ARGON2_FREE_MEMORY_CBK_NULL) -pattern ARGON2_ALLOCATE_MEMORY_CBK_NULL = (#const ARGON2_ALLOCATE_MEMORY_CBK_NULL) -pattern ARGON2_INCORRECT_PARAMETER = (#const ARGON2_INCORRECT_PARAMETER) -pattern ARGON2_INCORRECT_TYPE = (#const ARGON2_INCORRECT_TYPE) -pattern ARGON2_OUT_PTR_MISMATCH = (#const ARGON2_OUT_PTR_MISMATCH) -pattern ARGON2_THREADS_TOO_FEW = (#const ARGON2_THREADS_TOO_FEW) -pattern ARGON2_THREADS_TOO_MANY = (#const ARGON2_THREADS_TOO_MANY) -pattern ARGON2_MISSING_ARGS = (#const ARGON2_MISSING_ARGS) -pattern ARGON2_ENCODING_FAIL = (#const ARGON2_ENCODING_FAIL) -pattern ARGON2_DECODING_FAIL = (#const ARGON2_DECODING_FAIL) - -pattern ARGON2_MIN_LANES = (#const ARGON2_MIN_LANES) -pattern ARGON2_MAX_LANES = (#const ARGON2_MAX_LANES) - -pattern ARGON2_MIN_THREADS = (#const ARGON2_MIN_THREADS) -pattern ARGON2_MAX_THREADS = (#const ARGON2_MAX_THREADS) - -pattern ARGON2_SYNC_POINTS = (#const ARGON2_SYNC_POINTS) - -pattern ARGON2_MIN_OUTLEN = (#const ARGON2_MIN_OUTLEN) -pattern ARGON2_MAX_OUTLEN = (#const ARGON2_MAX_OUTLEN) - -pattern ARGON2_MIN_MEMORY = (#const ARGON2_MIN_MEMORY) - -pattern ARGON2_MAX_MEMORY_BITS = (#const ARGON2_MAX_MEMORY_BITS) -pattern ARGON2_MAX_MEMORY = (#const ARGON2_MAX_MEMORY) - -pattern ARGON2_MIN_TIME = (#const ARGON2_MIN_TIME) -pattern ARGON2_MAX_TIME = (#const ARGON2_MAX_TIME) - -pattern ARGON2_MIN_PWD_LENGTH = (#const ARGON2_MIN_PWD_LENGTH) -pattern ARGON2_MAX_PWD_LENGTH = (#const ARGON2_MAX_PWD_LENGTH) - -pattern ARGON2_MIN_AD_LENGTH = (#const ARGON2_MIN_AD_LENGTH) -pattern ARGON2_MAX_AD_LENGTH = (#const ARGON2_MAX_AD_LENGTH) - -pattern ARGON2_MIN_SALT_LENGTH = (#const ARGON2_MIN_SALT_LENGTH) -pattern ARGON2_MAX_SALT_LENGTH = (#const ARGON2_MAX_SALT_LENGTH) - -pattern ARGON2_MIN_SECRET = (#const ARGON2_MIN_SECRET) -pattern ARGON2_MAX_SECRET = (#const ARGON2_MAX_SECRET) - -pattern ARGON2_FLAG_CLEAR_PASSWORD = (#const ARGON2_FLAG_CLEAR_PASSWORD) -pattern ARGON2_FLAG_CLEAR_SECRET = (#const ARGON2_FLAG_CLEAR_SECRET) -pattern ARGON2_FLAG_CLEAR_MEMORY = (#const ARGON2_FLAG_CLEAR_MEMORY) -pattern ARGON2_DEFAULT_FLAGS = (#const ARGON2_DEFAULT_FLAGS) diff --git a/keysafe.cabal b/keysafe.cabal index 8df941b..6f28227 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -74,17 +74,12 @@ Executable keysafe , exceptions == 0.8.* , random-shuffle == 0.0.* , MonadRandom == 0.4.* - -- Temporarily inlined due to FTBFS bug - -- https://github.com/ocharles/argon2/issues/2 - -- argon2 == 1.1.* - Extra-Libraries: argon2 + , argon2 == 1.2.* Other-Modules: AutoStart BackupLog Benchmark ByteStrings - Crypto.Argon2.FFI - Crypto.Argon2 CmdLine Cost Encryption diff --git a/stack.yaml b/stack.yaml index 639d7e1..2658ab6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -12,4 +12,5 @@ extra-deps: - servant-server-0.7.1 - servant-client-0.7.1 - token-bucket-0.1.0.1 + - argon2-1.2.0 explicit-setup-deps: -- cgit v1.2.3