diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,26 @@ +# Version 0.2 + +* COMPILER ASSISTED BACKWARDS INCOMPATIBLE CHANGE: Drop the `BLAKE3.Raw` module + in favor of `BLAKE.IO`. Re-export internals from there. + +* COMPILER ASSISTED BACKWARDS INCOMPATIBLE CHANGE: Drop `HasherInternal` and + related functions in favor of `Ptr Hasher`. + +* COMPILER ASSISTED BACKWARDS INCOMPATIBLE CHANGE: Drop `allocRetHasher`, + `allocRetKey`, `allocRetDigest`. + +* Added `Eq`, `Show`, `Storable`, `ByteArrayAccess` and `ByteArrayN` instances + for `Hasher`, `Key` and `Digest`. + +* Added `ByteArrayAccess` instance for `Context`. + +* Added `finalizeSeek`, `modifyHasher`, `digest`. + +* More tests. + +* Documentation improvements. + + # Version 0.1.1 * Enabled AVX-512, AVX2 and SSE-4.1 support. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,14 @@ # Haskell BLAKE3 -Haskell bindings to the official C implementation at -[https://github.com/BLAKE3-team/BLAKE3](https://github.com/BLAKE3-team/BLAKE3). +Bindings to +the [official fast BLAKE3 implementations in assembly and C](https://github.com/BLAKE3-team/BLAKE3), +with support for AVX-512, AVX2 and SSE 4.1. +# Development + +* Build with `nix-build -A ghc865` (or `ghc883`). + +* Enter into a development environment with `nix-shell -A ghc865` (or `ghc883`). + From this environment, you can build with `cabal new-build blake3`, test with + `cabal new-test blake3`, render documentation with `cabal new-haddock blake3`, + etc. diff --git a/blake3.cabal b/blake3.cabal --- a/blake3.cabal +++ b/blake3.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: blake3 -version: 0.1.1 +version: 0.2 license: Apache-2.0 license-file: LICENSE extra-source-files: README.md CHANGELOG.md @@ -48,7 +48,6 @@ exposed-modules: BLAKE3 BLAKE3.IO - BLAKE3.Raw cc-options: -O3 include-dirs: cbits/ c-sources: @@ -78,7 +77,7 @@ else cc-options: -DBLAKE3_NO_AVX2 - -- AVX2 support + -- SSE 4.1 support if flag(sse41) if arch(x86_64) && (os(linux) || os(darwin)) c-sources: cbits/blake3_sse41_x86-64_unix.S diff --git a/lib/BLAKE3.hs b/lib/BLAKE3.hs --- a/lib/BLAKE3.hs +++ b/lib/BLAKE3.hs @@ -21,6 +21,7 @@ ( -- * Hashing hash , BIO.Digest + , BIO.digest -- * Keyed hashing , hashKeyed , BIO.Key @@ -35,6 +36,7 @@ , hasherKeyed , update , finalize + , finalizeSeek -- * Constants , BIO.KEY_LEN , BIO.BLOCK_SIZE @@ -43,6 +45,9 @@ where import qualified Data.ByteArray as BA +import qualified Data.ByteArray.Sized as BAS +import Data.Proxy +import Data.Word import GHC.TypeLits import System.IO.Unsafe (unsafeDupablePerformIO) @@ -61,16 +66,17 @@ :: forall len bin . (KnownNat len, BA.ByteArrayAccess bin) => [bin] -- ^ Data to hash. - -> BIO.Digest len -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. -hash bins = unsafeDupablePerformIO $ do - fmap fst $ BIO.allocRetHasher $ \ph -> do - BIO.init ph - BIO.update ph bins - BIO.finalize ph + -> BIO.Digest len + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. +hash = unsafeDupablePerformIO . BIO.hash {-# NOINLINE hash #-} -- | BLAKE3 hashing with a 'BIO.Key'. -- +-- This can be used for MAC (message authentication code), PRF (pseudo random +-- function) and SHO (stateful hash object) purposes. +-- -- For incremental hashing, see 'hasherKeyed', 'update' and 'finalize': -- -- @ @@ -81,40 +87,45 @@ . (KnownNat len, BA.ByteArrayAccess bin) => BIO.Key -> [bin] -- ^ Data to hash. - -> BIO.Digest len -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -> BIO.Digest len + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. hashKeyed key0 bins = unsafeDupablePerformIO $ do - fmap fst $ BIO.allocRetHasher $ \ph -> do + (dig, _ :: BIO.Hasher) <- BAS.allocRet Proxy $ \ph -> do BIO.initKeyed ph key0 BIO.update ph bins BIO.finalize ph + pure dig {-# NOINLINE hashKeyed #-} -- | BLAKE3 key derivation. +-- +-- This can be used for KDF (key derivation function) purposes. derive :: forall len ikm . (KnownNat len, BA.ByteArrayAccess ikm) => BIO.Context -> [ikm] -- ^ Input key material. - -> BIO.Digest len -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. -derive ctx ikms = unsafeDupablePerformIO $ - fmap fst $ BIO.allocRetHasher $ \ph -> do + -> BIO.Digest len + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. +derive ctx ikms = unsafeDupablePerformIO $ do + (dig, _ :: BIO.Hasher) <- BAS.allocRet Proxy $ \ph -> do BIO.initDerive ph ctx BIO.update ph ikms BIO.finalize ph + pure dig {-# NOINLINE derive #-} -- | Initial 'BIO.Hasher' for incremental hashing. hasher :: BIO.Hasher -- ^ -hasher = unsafeDupablePerformIO $ - fmap snd $ BIO.allocRetHasher BIO.init -{-# NOINLINE hasher #-} +hasher = BAS.allocAndFreeze BIO.init -- | Initial 'BIO.Hasher' for incremental /keyed/ hashing. hasherKeyed :: BIO.Key -> BIO.Hasher -- ^ -hasherKeyed key0 = unsafeDupablePerformIO $ - fmap snd $ BIO.allocRetHasher $ \ph -> +hasherKeyed key0 = + BAS.allocAndFreeze $ \ph -> BIO.initKeyed ph key0 -{-# NOINLINE hasherKeyed #-} -- | Update 'BIO.Hasher' with new data. update @@ -123,21 +134,41 @@ => BIO.Hasher -> [bin] -- ^ New data to hash. -> BIO.Hasher -update h0 bins = unsafeDupablePerformIO $ do - h1 <- BIO.copyHasher h0 - BIO.withHasherInternal h1 $ \ph1 -> do - BIO.update ph1 bins - pure h1 -{-# NOINLINE update #-} +update h0 bins = + BAS.copyAndFreeze h0 $ \ph1 -> + BIO.update ph1 bins -- | Finish hashing and obtain a 'BIO.Digest' of the specified @len@gth. finalize :: forall len . KnownNat len - => BIO.Hasher -- ^ + => BIO.Hasher -> BIO.Digest len + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. finalize h0 = unsafeDupablePerformIO $ do - h1 <- BIO.copyHasher h0 - BIO.withHasherInternal h1 $ \ph1 -> - BIO.finalize ph1 + (dig, _ :: BIO.Hasher) <- BAS.copyRet h0 BIO.finalize + pure dig {-# NOINLINE finalize #-} + +-- | Finalize incremental hashing and obtain a 'Digest' of length @len@ /after/ +-- the specified number of bytes of BLAKE3 output. +-- +-- @ +-- 'finalize' h = 'finalizeSeek' h 0 +-- @ +finalizeSeek + :: forall len + . KnownNat len + => BIO.Hasher + -> Word64 -- ^ Number of bytes to skip before obtaning the digest output. + -> BIO.Digest len + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. +finalizeSeek h0 pos = unsafeDupablePerformIO $ do + (dig, _ :: BIO.Hasher) <- BAS.copyRet h0 $ \ph -> BIO.finalizeSeek ph pos + pure dig +{-# NOINLINE finalizeSeek #-} + +-------------------------------------------------------------------------------- + diff --git a/lib/BLAKE3/IO.hs b/lib/BLAKE3/IO.hs --- a/lib/BLAKE3/IO.hs +++ b/lib/BLAKE3/IO.hs @@ -1,113 +1,125 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +-- | IO and low level tools. module BLAKE3.IO ( -- * Hashing - init + hash + , init , update , finalize - , Hasher - , allocRetHasher + , finalizeSeek + -- * Digest , Digest - , allocRetDigest - -- ** Memory - , Raw.HasherInternal - , copyHasher - , withHasherInternal - -- * Keyed hashing + , digest + -- * Keyed hashing , Key , key - , allocRetKey , initKeyed - -- * Key derivation + -- * Key derivation , Context , context , initDerive - -- * Constants - , Raw.HASHER_ALIGNMENT - , Raw.HASHER_SIZE - , Raw.KEY_LEN - , Raw.BLOCK_SIZE - , Raw.DEFAULT_DIGEST_LEN + -- * Hasher + , Hasher + , modifyHasher + -- * Constants + , HASHER_ALIGNMENT + , HASHER_SIZE + , KEY_LEN + , BLOCK_SIZE + , DEFAULT_DIGEST_LEN + , CHUNK_LEN + , MAX_DEPTH + , MAX_SIMD_DEGREE + -- * Low-level C bindings + , c_init + , c_init_keyed + , c_init_derive_key + , c_update + , c_finalize + , c_finalize_seek ) where import Control.Monad (guard) -import qualified Data.ByteArray as BA -import qualified Data.ByteArray.Encoding as BA import Data.Foldable -import qualified Data.Memory.PtrMethods as BA import Data.Proxy import Data.String import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Array (copyArray) import Foreign.Ptr import Foreign.Storable import GHC.TypeLits import Prelude hiding (init) - -import qualified BLAKE3.Raw as Raw +import qualified Data.ByteArray as BA +import qualified Data.ByteArray.Sized as BAS +import qualified Data.ByteArray.Encoding as BA +import qualified Data.Memory.PtrMethods as BA -------------------------------------------------------------------------------- --- | Immutable BLAKE3 hashing state. +-- | Output from BLAKE3 algorithm, of @len@ bytes. -- --- Obtain with 'BLAKE3.hasher' or 'BLAKE3.hasherKeyed'. -newtype Hasher = Hasher BA.ScrubbedBytes - -- deriving newtype (BA.ByteArrayAccess) +-- The default digest length for BLAKE3 is 'DEFAULT_DIGEST_LEN'. +data Digest (len :: Nat) where + -- | We store things this way to avoid unnecessary conversions between + -- different 'BA.ByteArrayAccess' when using 'digest' for reading a 'Digest' + -- from a third party source. + -- + -- Digest produced by this library are always allocated with 'BAS.allocRet'. + Digest :: BA.ByteArrayAccess x => x -> Digest len --- | Allocate 'Hasher'. +-- | Obtain a digest containing bytes from a third-party source. -- --- The 'Hasher' is wiped and freed as soon as it becomes unused. -allocRetHasher - :: forall a - . (Ptr Raw.HasherInternal -> IO a) -- ^ Initialize 'Raw.HASHER_SIZE' bytes. - -> IO (a, Hasher) -allocRetHasher g = do - let size = fromIntegral (natVal (Proxy @Raw.HASHER_SIZE)) - (a, bs) <- BA.allocRet size g - pure (a, Hasher bs) - --- | Mutate the given 'Hasher'. -withHasherInternal - :: Hasher - -> (Ptr Raw.HasherInternal -> IO a) -- ^ Read or write. - -> IO a -withHasherInternal (Hasher x) = BA.withByteArray x - --- | Copy an inmutable 'Hasher'. -copyHasher :: Hasher -> IO Hasher -- ^ -copyHasher (Hasher x) = fmap Hasher $ BA.copy x (const (pure ())) - --------------------------------------------------------------------------------- +-- This is useful if you want to use the 'Digest' datatype in your programs, but +-- you are loading the pre-calculated digests from a database or similar. +digest + :: forall len bin + . (KnownNat len, BA.ByteArrayAccess bin) + => bin -- ^ Raw digest bytes. Must have length @len@. + -> Maybe (Digest len) -- ^ +digest bin + | BA.length bin /= fromIntegral (natVal (Proxy @len)) = Nothing + | otherwise = Just (Digest bin) --- | Output from BLAKE3 algorithm, of @len@ bytes. --- --- The default digest length for BLAKE3 is 'Raw.DEFAULT_DIGEST_LEN'. -newtype Digest (len :: Nat) = Digest BA.ScrubbedBytes - deriving newtype ( Eq -- ^ Constant time. - , BA.ByteArrayAccess) +-- | Constant time. +instance Eq (Digest len) where + Digest a == Digest b = BA.constEq a b -- | Base 16 (hexadecimal). instance Show (Digest len) where show (Digest x) = showBase16 x +instance BA.ByteArrayAccess (Digest len) where + length (Digest x) = BA.length x + withByteArray (Digest x) = BA.withByteArray x + -- | Allocate a 'Digest'. --- --- The 'Digest' is wiped and freed as soon as it becomes unused. -allocRetDigest - :: forall len a - . KnownNat len - => (Ptr Word8 -> IO a) -- ^ Initialize @len@ bytes. - -> IO (a, Digest len) -allocRetDigest g = do - let size = fromIntegral (natVal (Proxy @len)) - (a, bs) <- BA.allocRet size g - pure (a, Digest bs) +-- The memory is wiped and freed as soon the 'Digest' becomes unused. +instance KnownNat len => BAS.ByteArrayN len (Digest len) where + allocRet prx g = do + let size = fromIntegral (natVal prx) + (a, bs :: BA.ScrubbedBytes) <- BA.allocRet size g + pure (a, Digest bs) +-- | When allocating a 'Digest', prefer to use 'BAS.alloc', which +-- wipes and releases the memory as soon it becomes unused. +instance forall len. KnownNat len => Storable (Digest len) where + sizeOf _ = fromIntegral (natVal (Proxy @len)) + alignment _ = 8 -- Not sure. + peek ps = BAS.alloc $ \pd -> copyArray pd ps 1 + poke pd src = BA.withByteArray src $ \ps -> copyArray pd ps 1 + -------------------------------------------------------------------------------- -- | Key used for keyed hashing mode. @@ -115,51 +127,72 @@ -- Obtain with 'BLAKE3.key'. -- -- See 'BLAKE3.hashKeyed'. -newtype Key = Key BA.ScrubbedBytes - deriving newtype ( Eq -- ^ Constant time. - , BA.ByteArrayAccess) +data Key where + -- | We store things this way to avoid unnecessary conversions between + -- different 'BA.ByteArrayAccess' when using 'key' for reading a 'Key' + -- from a third party source. + Key :: BA.ByteArrayAccess x => x -> Key +-- | Constant time. +instance Eq Key where + Key a == Key b = BA.constEq a b + -- | Base 16 (hexadecimal). instance Show Key where show (Key x) = showBase16 x -keyLen :: Int -keyLen = fromIntegral (natVal (Proxy @Raw.KEY_LEN)) +-- | Length is 'KEY_LEN'. +instance BA.ByteArrayAccess Key where + length (Key x) = BA.length x + withByteArray (Key x) = BA.withByteArray x +-- | Allocate a 'Key'. +-- The memory is wiped and freed as soon as the 'Key' becomes unused. +instance BAS.ByteArrayN KEY_LEN Key where + allocRet _ g = do + (a, bs :: BA.ScrubbedBytes) <- BA.allocRet keyLen g + pure (a, Key bs) + +-- | When allocating a 'Key', prefer to use 'BAS.alloc', which +-- wipes and releases the memory as soon it becomes unused. +instance Storable Key where + sizeOf _ = keyLen + alignment _ = 8 -- Not sure. + peek ps = BAS.alloc $ \pd -> copyArray pd ps 1 + poke pd src = BA.withByteArray src $ \ps -> copyArray pd ps 1 + -- | Obtain a 'Key' for use in BLAKE3 keyed hashing. -- -- See 'BLAKE3.hashKeyed'. key :: BA.ByteArrayAccess bin - => bin -- ^ Key bytes. Must have length 'Raw.KEY_LEN'. + => bin -- ^ Key bytes. Must have length 'KEY_LEN'. -> Maybe Key -- ^ -key bin | BA.length bin == keyLen = Just (Key (BA.convert bin)) - | otherwise = Nothing - --- | Allocate a 'Key'. --- --- The 'Key' is wiped and freed as soon as it becomes unused. -allocRetKey - :: forall a - . (Ptr Word8 -> IO a) -- ^ Initialize 'Raw.KEY_LEN' bytes. - -> IO (a, Key) -allocRetKey g = do - (a, bs) <- BA.allocRet keyLen g - pure (a, Key bs) +key bin | BA.length bin /= keyLen = Nothing + | otherwise = Just (Key bin) -------------------------------------------------------------------------------- -- | Context for BLAKE3 key derivation. Obtain with 'context'. -newtype Context = Context BA.Bytes -- ^ NUL-terminated 'CString'. +newtype Context + = Context BA.Bytes + -- ^ NUL-terminated 'CString'. We store things this way so as to avoid + -- re-creating the 'CString' each time we need to use this 'Context' in + -- 'c_init_derive_key'. We never expose the NUL-terminating byte to users + -- of this library. deriving newtype (Eq) +-- We exclude the NUL-terminating byte. That's internal. +instance BA.ByteArrayAccess Context where + length (Context x) = max 0 (BA.length x - 1) + withByteArray c@(Context x) = BA.withByteArray (BA.takeView x (BA.length c)) + -- | Base 16 (hexadecimal). instance Show Context where - show (Context x) = showBase16 (BA.takeView x (BA.length x - 1)) + show = showBase16 -- | 'fromString' is a /partial/ function that fails if the given 'String' --- contains 'Char's outside the range @['toEnum' 1 .. 'toEnum' 255]@. --- +-- contains 'Char's outside the range @['toEnum' 1 .. 'toEnum' 255]@. -- See 'context' for more details. instance IsString Context where fromString s = case traverse charToWord8 s of @@ -204,59 +237,219 @@ -------------------------------------------------------------------------------- --- | Initialize a 'Raw.HasherInternal'. +showBase16 :: BA.ByteArrayAccess x => x -> String +showBase16 = fmap (toEnum . fromIntegral) + . BA.unpack @BA.ScrubbedBytes + . BA.convertToBase BA.Base16 + +-------------------------------------------------------------------------------- + +-- | BLAKE3 hashing. +hash + :: forall len bin + . (KnownNat len, BA.ByteArrayAccess bin) + => [bin] + -- ^ Data to hash. + -> IO (Digest len) + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. +hash bins = do + (dig, _ :: Hasher) <- BAS.allocRet Proxy $ \ph -> do + init ph + update ph bins + finalize ph + pure dig + +-- | Initialize a 'Hasher'. init - :: Ptr Raw.HasherInternal -- ^ Will be mutated. + :: Ptr Hasher -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated. -> IO () -init = Raw.init +init = c_init --- | Initialize a 'Raw.HasherInternal' in keyed mode. +-- | Initialize a 'Hasher' in keyed mode. initKeyed - :: Ptr Raw.HasherInternal -- ^ Will be mutated. + :: Ptr Hasher -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated. -> Key - -> IO () -- ^ + -> IO () initKeyed ph key0 = BA.withByteArray key0 $ \pkey -> - Raw.init_keyed ph pkey + c_init_keyed ph pkey --- | Initialize a 'Raw.HasherInternal' in derivation mode. +-- | Initialize a 'Hasher' in derivation mode. -- -- The input key material must be provided afterwards, using 'update'. initDerive - :: Ptr Raw.HasherInternal -- ^ Will be mutated. + :: Ptr Hasher -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated. -> Context -> IO () initDerive ph (Context ctx) = BA.withByteArray ctx $ \pc -> - Raw.init_derive_key ph pc + c_init_derive_key ph pc --- | Update 'Raw.HasherInternal' state with new data. +-- | Update 'Hasher' state with new data. update :: forall bin . BA.ByteArrayAccess bin - => Ptr Raw.HasherInternal -- ^ Will be mutated. + => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated. -> [bin] - -> IO () -- ^ + -> IO () update ph bins = for_ bins $ \bin -> BA.withByteArray bin $ \pbin -> - Raw.update ph pbin (fromIntegral (BA.length bin)) + c_update ph pbin (fromIntegral (BA.length bin)) --- | Finalize 'Raw.HasherInternal' state and obtain a digest. --- --- The 'Raw.HasherInternal' is mutated. +-- | Finalize incremental hashin and obtain a 'Digest'. finalize :: forall len . KnownNat len - => Ptr Raw.HasherInternal -- ^ Will be mutated. - -> IO (Digest len) -- ^ + => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated. + -> IO (Digest len) + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. finalize ph = - fmap snd $ allocRetDigest $ \pd -> - Raw.finalize ph pd (fromIntegral (natVal (Proxy @len))) + BAS.alloc $ \pd -> + c_finalize ph pd (fromIntegral (natVal (Proxy @len))) +-- | Finalize incremental hashing and obtain a 'Digest' of length @len@ /after/ +-- the specified number of bytes of BLAKE3 output. +-- +-- @ +-- 'finalize' h = 'finalizeSeek' h 0 +-- @ +finalizeSeek + :: forall len + . KnownNat len + => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated. + -> Word64 -- ^ Number of bytes to skip before obtaning the digest output. + -> IO (Digest len) + -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'. + -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused. +finalizeSeek ph pos = + BAS.alloc $ \pd -> + c_finalize_seek ph pos pd (fromIntegral (natVal (Proxy @len))) + -------------------------------------------------------------------------------- -showBase16 :: BA.ByteArrayAccess x => x -> String -showBase16 = fmap (toEnum . fromIntegral) - . BA.unpack @BA.ScrubbedBytes - . BA.convertToBase BA.Base16 +type HASHER_ALIGNMENT = 8 + +-- | In bytes. +type HASHER_SIZE = 1912 + +hasherSize :: Int +hasherSize = fromIntegral (natVal (Proxy @HASHER_SIZE)) + +-- | In bytes. +type KEY_LEN = 32 + +keyLen :: Int +keyLen = fromIntegral (natVal (Proxy @KEY_LEN)) + +-- | In bytes. +type DEFAULT_DIGEST_LEN = 32 + +-- | In bytes. +type BLOCK_SIZE = 64 + +type CHUNK_LEN = 1024 +type MAX_DEPTH = 54 +type MAX_SIMD_DEGREE = 16 + +-------------------------------------------------------------------------------- + +-- | BLAKE3 internal state. +-- +-- Obtain with 'BLAKE3.hasher', 'BLAKE3.hasherKeyed'. +newtype Hasher = Hasher (BAS.SizedByteArray HASHER_SIZE BA.ScrubbedBytes) + deriving newtype + ( BA.ByteArrayAccess + -- ^ Length is 'HASHER_SIZE'. + , BAS.ByteArrayN HASHER_SIZE + -- ^ Allocate a 'Hasher'. + -- The memory is wiped and freed as soon as the 'Hasher' becomes unused. + ) + +instance Eq Hasher where + (==) = BA.eq + +-- | Base 16 (hexadecimal). +instance Show Hasher where + show = showBase16 + +-- | Obtain a @'Ptr' 'Hasher'@ to use with functions like 'initDerive', etc. +modifyHasher + :: Hasher + -> (Ptr Hasher -> IO a) -- ^ 'HASHER_SIZE' bytes. + -> IO a +modifyHasher = BA.withByteArray + +-- | When allocating a 'Hasher', prefer to use 'BAS.alloc', which +-- wipes and releases the memory as soon it becomes unused. +instance Storable Hasher where + sizeOf _ = hasherSize + alignment _ = fromIntegral (natVal (Proxy @HASHER_ALIGNMENT)) + peek ps = BAS.alloc $ \pd -> copyArray pd ps 1 + poke pd src = BA.withByteArray src $ \ps -> copyArray pd ps 1 + +-------------------------------------------------------------------------------- + +-- | @void blake3_hasher_init(blake3_hasher *self)@ +foreign import ccall unsafe + "blake3.h blake3_hasher_init" + c_init + :: Ptr Hasher -- ^ You can obtain with 'BAS.alloc'. + -- Otherwise, any chunk of 'HASHER_SIZE' bytes aligned to + -- 'HASHER_ALIGNMENT' will do. + -> IO () + +-- | @void blake3_hasher_init_keyed(blake3_hasher *self, const uint8_t key['KEY_LEN'])@ +foreign import ccall unsafe + "blake3.h blake3_hasher_init_keyed" + c_init_keyed + :: Ptr Hasher -- ^ You can obtain with 'BAS.alloc'. + -- Otherwise, any chunk of 'HASHER_SIZE' bytes aligned to + -- 'HASHER_ALIGNMENT' will do. + -> Ptr Word8 -- ^ You can obtain with 'BAS.alloc'. + -- Otherwise, any chunk of length 'KEY_LEN' will do. + -> IO () + +-- | @void blake3_hasher_init_derive_key(blake3_hasher *self, const char *context)@ +foreign import ccall unsafe + "blake3.h blake3_hasher_init_derive_key" + c_init_derive_key + :: Ptr Hasher -- ^ You can obtain with 'BAS.alloc'. + -- Otherwise, any chunk of 'HASHER_SIZE' bytes aligned to + -- 'HASHER_ALIGNMENT' will do. + -> CString -- ^ Context. + -> IO () + +-- | @void blake3_hasher_update(blake3_hasher *self, const void *input, size_t input_len)@ +foreign import ccall unsafe + "blake3.h blake3_hasher_update" + c_update + :: Ptr Hasher -- ^ Must have been previously initializedi. See 'c_init', + -- 'c_init_keyed', 'c_init_derive_key'. + -> Ptr Word8 -- ^ Data. + -> CSize -- ^ Data length. + -> IO () + +-- | @void blake3_hasher_finalize(const blake3_hasher *self, uint8_t *out, size_t out_len)@ +foreign import ccall unsafe + "blake3.h blake3_hasher_finalize" + c_finalize + :: Ptr Hasher -- ^ Must have been previously initializedi. See 'c_init', + -- 'c_init_keyed', 'c_init_derive_key'. + -> Ptr Word8 -- ^ Out. + -> CSize -- ^ Out length. + -> IO () + +-- | @void blake3_hasher_finalize_seek(const blake3_hasher *self, uint64_t seek, uint8_t *out, size_t out_len)@ +foreign import ccall unsafe + "blake3.h blake3_hasher_finalize_seek" + c_finalize_seek + :: Ptr Hasher -- ^ Must have been previously initializedi. See 'c_init', + -- 'c_init_keyed', 'c_init_derive_key'. + -> Word64 -- ^ Seek position. + -> Ptr Word8 -- ^ Out. + -> CSize -- ^ Out length. + -> IO () + diff --git a/lib/BLAKE3/Raw.hs b/lib/BLAKE3/Raw.hs deleted file mode 100644 --- a/lib/BLAKE3/Raw.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# OPTIONS_HADDOCK hide not_home #-} - -module BLAKE3.Raw where - -import Data.Word -import Foreign.C.Types -import Foreign.C.String -import Foreign.Ptr -import Prelude hiding (init) - --------------------------------------------------------------------------------- - -type HASHER_ALIGNMENT = 8 --- | In bytes. -type HASHER_SIZE = 1912 --- | In bytes. -type KEY_LEN = 32 --- | In bytes. -type DEFAULT_DIGEST_LEN = 32 --- | In bytes. -type BLOCK_SIZE = 64 - -type CHUNK_LEN = 1024 -type MAX_DEPTH = 54 -type MAX_SIMD_DEGREE = 16 - --- | Opaque datatype of size 'HASHER_SIZE' and alignment 'HASHER_ALIGNMENT'. --- --- Obtain with 'BLAKE3.IO.withHasherInternal'. -data HasherInternal - --- | @void blake3_hasher_init(blake3_hasher *self)@ -foreign import ccall unsafe - "blake3.h blake3_hasher_init" - init - :: Ptr HasherInternal - -> IO () -- ^ - --- | @void blake3_hasher_init_keyed(blake3_hasher *self, const uint8_t key['KEY_LEN'])@ -foreign import ccall unsafe - "blake3.h blake3_hasher_init_keyed" - init_keyed - :: Ptr HasherInternal - -> Ptr Word8 -- ^ Key of length 'KEY_LEN'. - -> IO () - --- | @void blake3_hasher_init_derive_key(blake3_hasher *self, const char *context)@ -foreign import ccall unsafe - "blake3.h blake3_hasher_init_derive_key" - init_derive_key - :: Ptr HasherInternal - -> CString -- ^ Context. - -> IO () -- ^ - --- | @void blake3_hasher_update(blake3_hasher *self, const void *input, size_t input_len)@ -foreign import ccall unsafe - "blake3.h blake3_hasher_update" - update - :: Ptr HasherInternal - -> Ptr Word8 -- ^ Data. - -> CSize -- ^ Data length. - -> IO () -- ^ - --- | @void blake3_hasher_finalize(const blake3_hasher *self, uint8_t *out, size_t out_len)@ -foreign import ccall unsafe - "blake3.h blake3_hasher_finalize" - finalize - :: Ptr HasherInternal - -> Ptr Word8 -- ^ Out. - -> CSize -- ^ Out length. - -> IO () -- ^ - --- | @void blake3_hasher_finalize_seek(const blake3_hasher *self, uint64_t seek, uint8_t *out, size_t out_len)@ -foreign import ccall unsafe - "blake3.h blake3_hasher_finalize" - finalize_seek - :: Ptr HasherInternal - -> Word64 -- ^ Seek. - -> Ptr Word8 -- ^ Out. - -> CSize -- ^ Out length. - -> IO () -- ^ diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -5,9 +5,11 @@ module Main (main) where import qualified Data.ByteArray as BA +import qualified Data.ByteArray.Sized as BAS import qualified Data.List as List import Data.Proxy import Data.Word +import Foreign.Storable import GHC.TypeLits import qualified Test.Tasty as Tasty import qualified Test.Tasty.Runners as Tasty @@ -30,6 +32,7 @@ , tt_context , tt_key , tt_hasher + , tt_digest ] @@ -107,8 +110,34 @@ "92b2b75604ed3c761f9d" @=? show (B.finalize @10 h1) "f46255baa87a3280d644" @=? show (B.finalize @10 h2) "b5ee60b5d89ac7e1289b" @=? show (B.finalize @10 h3) + + , testCase "finalize vs finalizeSeek: zero" $ do + let dig0 :: B.Digest 50 = B.finalize B.hasher + let dig1 :: B.Digest 50 = B.finalizeSeek B.hasher 0 + dig0 @=? dig1 + + , testCase "finalize vs finalizeSeek: non-zero" $ do + let dig0 :: B.Digest 2050 = B.finalize B.hasher + let dig1 :: B.Digest 50 = B.finalizeSeek B.hasher 2000 + BA.drop 2000 (BA.convert dig0) @=? (BA.convert dig1 :: BA.Bytes) + + , testCase "Storable" $ do + let h1 = B.hasher + h2 <- BAS.alloc $ \ph2 -> poke ph2 h1 + h1 @=? h2 + h3 <- BA.withByteArray h1 peek + h1 @=? h3 ] +tt_digest :: TestTree +tt_digest = testGroup "Digest" + [ testCase "Storable" $ do + let d1 :: B.Digest 400 = B.hash ([] :: [BA.Bytes]) + d2 <- BAS.alloc $ \pd2 -> poke pd2 d1 + d1 @=? d2 + d3 <- BA.withByteArray d1 peek + d1 @=? d3 + ] testVector_context :: B.Context testVector_context = "BLAKE3 2019-12-27 16:29:52 test vectors context" @@ -122,6 +151,10 @@ , testCase "has null" $ do Nothing @=? B.context ("\NUL" :: BA.ScrubbedBytes) Nothing @=? B.context ("hi\NUL" :: BA.ScrubbedBytes) + , testCase "fromString" $ do + Just "" @=? B.context ("" :: BA.ScrubbedBytes) + Just "a" @=? B.context ("a" :: BA.ScrubbedBytes) + Just "ab" @=? B.context ("ab" :: BA.ScrubbedBytes) ] tt_testVectors :: TestTree @@ -147,6 +180,12 @@ @=? show testVector_key , testCase "long" $ do Nothing @=? B.key (BA.replicate 100 0 :: BA.Bytes) + , testCase "Storable" $ do + let k1 = testVector_key + k2 <- BAS.alloc $ \pk2 -> poke pk2 k1 + k1 @=? k2 + k3 <- BA.withByteArray k1 peek + k1 @=? k3 ] data TestVector = TestVector