Core: Internal: add module Truncation

hnix-store-core/hnix-store-core.cabal

@@ -33,9 +33,10 @@ library
     , System.Nix.Build
     , System.Nix.Derivation
     , System.Nix.Hash
-    , System.Nix.Internal.Base32
-    , System.Nix.Internal.Hash
     , System.Nix.Internal.Base
+    , System.Nix.Internal.Base32
+    , System.Nix.Internal.Truncation
+    , System.Nix.Internal.Hash
     , System.Nix.Internal.Nar.Parser
     , System.Nix.Internal.Nar.Streamer
     , System.Nix.Internal.Nar.Effects

hnix-store-core/src/System/Nix/Internal/Hash.hs

@@ -19,14 +19,12 @@ import qualified Crypto.Hash.SHA1       as SHA1
 import qualified Crypto.Hash.SHA256     as SHA256
 import qualified Crypto.Hash.SHA512     as SHA512
 import qualified Data.ByteString        as BS
-import           Data.Bits              (xor)
 import qualified Data.ByteString.Lazy   as BSL
 import qualified Data.Hashable          as DataHashable
 import           Data.List              (foldl')
 import           Data.Proxy             (Proxy(Proxy))
 import           Data.Text              (Text)
 import qualified Data.Text              as T
-import           Data.Word              (Word8)
 import qualified GHC.TypeLits           as Kind
                                         (Nat, KnownNat, natVal)
 import           System.Nix.Internal.Base
@@ -34,8 +32,8 @@ import           System.Nix.Internal.Base
                                         , encodeWith
                                         , decodeWith
                                         )
-import           Data.Bool              (bool)
 import           Data.Coerce            (coerce)
+import System.Nix.Internal.Truncation   (truncateInNixWay)
 
 -- | The universe of supported hash algorithms.
 --
@@ -202,22 +200,7 @@ instance (ValidAlgo a, Kind.KnownNat n) => ValidAlgo ('Truncated n a) where
 truncateDigestInNixWay
   :: forall n a .(Kind.KnownNat n) => Digest a -> Digest ('Truncated n a)
 --  2021-06-07: NOTE: ^ This is why all the cookery with DataKinds, trunkation length (if allowed arbitrary) needs to be represented in type.
---  2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover: <https://crypto.stackexchange.com/questions/56337/strength-of-hash-obtained-by-xor-of-parts-of-sha3>
 truncateDigestInNixWay (Digest c) =
-    Digest $ BS.pack $ fmap truncOutputByte [0.. n-1]
+    Digest $ truncateInNixWay n c
   where
     n = fromIntegral $ Kind.natVal $ Proxy @n
-
-    truncOutputByte :: Int -> Word8
-    truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1]
-
-    inputByte :: Int -> Word8
-    inputByte j = BS.index c j
-
-    aux :: Int -> Word8 -> Int -> Word8
-    aux i x j =
-      bool
-        id
-        (`xor` inputByte j)
-        (j `mod` n == i)
-        x

hnix-store-core/src/System/Nix/Internal/Truncation.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE DataKinds           #-}
+
+module System.Nix.Internal.Truncation where
+
+import qualified Data.ByteString        as Bytes
+import           Data.Bits              (xor)
+import           Data.List              (foldl')
+import           Data.Word              (Word8)
+import           Data.Bool                 (bool)
+
+-- | Bytewise truncation of a 'Digest'.
+--
+-- When truncation length is greater than the length of the bytestring
+-- but less than twice the bytestring length, truncation splits the
+-- bytestring into a head part (truncation length) and tail part
+-- (leftover part), right-pads the leftovers with 0 to the truncation
+-- length, and combines the two strings bytewise with 'xor'.
+truncateInNixWay
+  :: Int -> Bytes.ByteString -> Bytes.ByteString
+--  2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover:
+-- 1. <https://crypto.stackexchange.com/questions/56337/strength-of-hash-obtained-by-xor-of-parts-of-sha3>
+-- 2. <https://www.reddit.com/r/crypto/comments/6olqfm/ways_to_truncated_hash/>
+truncateInNixWay n c =
+    Bytes.pack $ fmap truncOutputByte [0 .. n-1]
+  where
+
+    truncOutputByte :: Int -> Word8
+    truncOutputByte i = foldl' (aux i) 0 [0 .. Bytes.length c - 1]
+
+    inputByte :: Int -> Word8
+    inputByte j = Bytes.index c j
+
+    aux :: Int -> Word8 -> Int -> Word8
+    aux i x j =
+      bool
+        id
+        (`xor` inputByte j)
+        (j `mod` n == i)
+        x