commit e072b044fbcaad9f72900e4fdd2dd82a15b92a0e
parent 76a7f9b44a462bbb0ed53c8d76cb4729141efa57
Author: Jared Tobin <jared@jtobin.io>
Date:   Wed,  5 Feb 2025 15:08:15 +0400
lib: refine builder strategies
Diffstat:
1 file changed, 16 insertions(+), 12 deletions(-)
diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs
@@ -99,6 +99,15 @@ unsafe_parseWsPair (BI.BS x l) =
   WSPair (unsafe_word32be (BI.BS x 4)) (BI.BS (plusForeignPtr x 4) (l - 4))
 {-# INLINE unsafe_parseWsPair #-}
 
+-- builder realization strategies
+
+to_strict :: BSB.Builder -> BS.ByteString
+to_strict = BL.toStrict . BSB.toLazyByteString
+
+to_strict_small :: BSB.Builder -> BS.ByteString
+to_strict_small = BL.toStrict . BE.toLazyByteStringWith
+  (BE.safeStrategy 128 BE.smallChunkSize) mempty
+
 -- message padding and parsing
 -- https://datatracker.ietf.org/doc/html/rfc6234#section-4.1
 
@@ -110,9 +119,9 @@ sol l =
 
 -- RFC 6234 4.1 (strict)
 pad :: BS.ByteString -> BS.ByteString
-pad m@(BI.PS _ _ (fi -> l)) =
-    BL.toStrict . BE.toLazyByteStringWith
-      (BE.safeStrategy 128 BE.smallChunkSize) mempty $ padded
+pad m@(BI.PS _ _ (fi -> l))
+    | l < 128 = to_strict_small padded
+    | otherwise = to_strict padded
   where
     padded = BSB.byteString m
           <> fill (sol l) (BSB.word8 0x80)
@@ -196,10 +205,8 @@ pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where
   padding l k bs
     | k == 0 =
           pure
-        . BL.toStrict
+        . to_strict
           -- more efficient for small builder
-        . BE.toLazyByteStringWith
-            (BE.safeStrategy 128 BE.smallChunkSize) mempty
         $ bs <> BSB.word64BE (l * 8)
     | otherwise =
         let nacc = bs <> BSB.word8 0x00
@@ -425,12 +432,9 @@ unsafe_hash_alg rs bs = block_hash rs (prepare_schedule (unsafe_parse bs))
 
 -- register concatenation
 cat :: Registers -> BS.ByteString
-cat Registers {..} =
-      BL.toStrict
-      -- more efficient for small builder
-    . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty
-    $     BSB.word64BE w64_0 <> BSB.word64BE w64_1
-       <> BSB.word64BE w64_2 <> BSB.word64BE w64_3
+cat Registers {..} = to_strict_small $
+       BSB.word64BE w64_0 <> BSB.word64BE w64_1
+    <> BSB.word64BE w64_2 <> BSB.word64BE w64_3
   where
     !w64_0 = fi h0 `B.unsafeShiftL` 32 .|. fi h1
     !w64_1 = fi h2 `B.unsafeShiftL` 32 .|. fi h3