GOST34112012-Hash 0.1.1.1 → 0.1.1.2

raw patch · 5 files changed

+141/−104 lines, 5 filesdep −base16-bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: base16-bytestring

API changes (from Hackage documentation)

Files

• GOST34112012-Hash.cabal +6/−7
• src/Crypto/Hash/GOST34112012.hsc +67/−0
• src/Data/Digest/GOST34112012/Hash.hsc +0/−60
• test/Main.hs +66/−35
• test/etalon/make4Gb.sh +2/−2

@@ -1,11 +1,11 @@ cabal-version:          3.0 name:                   GOST34112012-Hash-version:                0.1.1.1+version:                0.1.1.2 synopsis:               Bindings to the GOST R 34.11-2012 hashing implementation-description:            Binds https://github.com/adegtyarev/streebog , a C+description:            Binds https://github.com/adegtyarev/streebog, a C                         implementation of the GOST R 34.11-2012 hash function.-                        See @c_src/streebog/README.md@ and @test/Main.hs@ to get started.-                        Requires a processor that supports MSSE4.1!+                        See c_src/streebog/README.md and test/Main.hs for examples.+                        Requires a x86 processor that supports MSSE4.1! homepage:               https://github.com/verrens/GOST34112012-Hash license:                BSD-2-Clause license-file:           LICENSE@@ -29,7 +29,7 @@  library     import:             warnings-    exposed-modules:    Data.Digest.GOST34112012.Hash+    exposed-modules:    Crypto.Hash.GOST34112012     build-depends:      base >= 4 && < 5,                         bytestring >= 0.11.5 && < 0.12     hs-source-dirs:     src@@ -59,9 +59,8 @@     build-depends:      base >= 4 && < 5,                         GOST34112012-Hash,                         bytestring >= 0.11.5 && < 0.12,-                        text >= 2.0.2 && < 2.1,                         utf8-string >= 1.0.2 && < 1.1,-                        base16-bytestring >= 1.0.2 && < 1.1+                        text >= 2.0.2 && < 2.1  source-repository head   type:                 git

@@ -0,0 +1,67 @@+module Crypto.Hash.GOST34112012+( GOST34112012Context, hashGOST34112012, +  hashGOST34112012_256, hashGOST34112012_512, getGOST34112012BufSize,+  initGOST34112012, updateGOST34112012, finishGOST34112012 ) where+import Foreign hiding (newForeignPtr)+import Foreign.Concurrent (newForeignPtr)+import Foreign.C (newCString, CString, CInt(..), CUInt(..), CSize(..))+import Data.ByteString (ByteString, useAsCStringLen, packCStringLen)++#include <gost3411-2012-core.h>++type GOST34112012Context = ForeignPtr GOST34112012Ctx++data GOST34112012Ctx = GOST34112012Ctx {+  cGOST34112012BufSize    :: CSize,+  cGOST34112012DigestSize :: CUInt+}++instance Storable GOST34112012Ctx where+  sizeOf _    = (#size GOST34112012Context)+  alignment _ = (#alignment GOST34112012Context)+  peek ptr    = GOST34112012Ctx+            <$> (#peek GOST34112012Context, bufsize) ptr+            <*> (#peek GOST34112012Context, digest_size) ptr+  poke _ _    = fail "GOST34112012Ctx is read only"++hashGOST34112012_256 :: ByteString -> IO ByteString+hashGOST34112012_256 = hashGOST34112012 256++hashGOST34112012_512 :: ByteString -> IO ByteString+hashGOST34112012_512 = hashGOST34112012 512++hashGOST34112012 :: Int -> ByteString -> IO ByteString+hashGOST34112012 dsize bytes = initGOST34112012 dsize+                   >>= \ctx -> updateGOST34112012 ctx bytes+                            >> finishGOST34112012 ctx++initGOST34112012 :: Int -> IO GOST34112012Context+initGOST34112012 dsize = malloc >>= \ctx -> do+  cGOST34112012Init ctx (fromIntegral dsize)+  newForeignPtr ctx (cGOST34112012Cleanup ctx >> free ctx)++updateGOST34112012 :: GOST34112012Context -> ByteString -> IO ()+updateGOST34112012 ctx bytes = useAsCStringLen bytes (\(str, len) ->+  withForeignPtr ctx (\ptr -> cGOST34112012Update ptr str (fromIntegral len)))++finishGOST34112012 :: GOST34112012Context -> IO ByteString+finishGOST34112012 ctx = withForeignPtr ctx (\ptr -> peek ptr >>= \ct ->+  newCString (replicate (hsize ct) ' ') >>= \str -> cGOST34112012Final ptr str+    >> cGOST34112012Cleanup ptr >> packCStringLen (str, hsize ct)) where+      hsize ct = if 256 == cGOST34112012DigestSize ct then 32 else 64++getGOST34112012BufSize :: GOST34112012Context -> IO Int+getGOST34112012BufSize = fmap (fromIntegral . cGOST34112012BufSize)+                                . (flip withForeignPtr peek)++foreign import ccall "GOST34112012Init"+  cGOST34112012Init :: Ptr GOST34112012Ctx -> CInt -> IO ()++foreign import ccall "GOST34112012Update"+  cGOST34112012Update :: Ptr GOST34112012Ctx -> CString -> CSize -> IO ()++foreign import ccall "GOST34112012Final"+  cGOST34112012Final :: Ptr GOST34112012Ctx -> CString -> IO ()++foreign import ccall "GOST34112012Cleanup"+  cGOST34112012Cleanup :: Ptr GOST34112012Ctx -> IO ()

@@ -1,60 +0,0 @@-module Data.Digest.GOST34112012.Hash-( GOST34112012HashContext, hashGOST34112012, getGOST34112012HashBufSize,-  initGOST34112012Hash, updateGOST34112012Hash, finishGOST34112012Hash ) where-import Foreign hiding (newForeignPtr)-import Foreign.Concurrent (newForeignPtr)-import Foreign.C (newCString, CString, CInt(..), CUInt(..), CSize(..))-import Data.ByteString (ByteString, useAsCStringLen, packCStringLen)--#include <gost3411-2012-core.h>--type GOST34112012HashContext = ForeignPtr GOST34112012HashCtx--data GOST34112012HashCtx = GOST34112012HashCtx {-  cGOST34112012HashBufSize    :: CSize,-  cGOST34112012HashDigestSize :: CUInt-} deriving (Eq, Ord, Show)--instance Storable GOST34112012HashCtx where-  sizeOf _    = (#size GOST34112012Context)-  alignment _ = (#alignment GOST34112012Context)-  peek ptr    = GOST34112012HashCtx-            <$> (#peek GOST34112012Context, bufsize) ptr-            <*> (#peek GOST34112012Context, digest_size) ptr-  poke _ _    = fail "GOST34112012HashCtx is read only"--hashGOST34112012 :: Int -> ByteString -> IO ByteString-hashGOST34112012 dsize bytes = initGOST34112012Hash dsize-                   >>= \ctx -> updateGOST34112012Hash ctx bytes-                            >> finishGOST34112012Hash ctx--initGOST34112012Hash :: Int -> IO GOST34112012HashContext-initGOST34112012Hash dsize = malloc >>= \ctx -> do-  cGOST34112012Init ctx (fromIntegral dsize)-  newForeignPtr ctx (cGOST34112012Cleanup ctx >> free ctx)--updateGOST34112012Hash :: GOST34112012HashContext -> ByteString -> IO ()-updateGOST34112012Hash ctx bytes = useAsCStringLen bytes (\(str, len) ->-  withForeignPtr ctx (\ptr -> cGOST34112012Update ptr str (fromIntegral len)))--finishGOST34112012Hash :: GOST34112012HashContext -> IO ByteString-finishGOST34112012Hash ctx = withForeignPtr ctx (\ptr -> peek ptr >>= \ct ->-  newCString (replicate (hsize ct) ' ') >>= \str -> cGOST34112012Final ptr str-    >> cGOST34112012Cleanup ptr >> packCStringLen (str, hsize ct)) where-      hsize ct = if 256 == cGOST34112012HashDigestSize ct then 32 else 64--getGOST34112012HashBufSize :: GOST34112012HashContext -> IO Int-getGOST34112012HashBufSize = fmap (fromIntegral . cGOST34112012HashBufSize)-                                . (flip withForeignPtr peek)--foreign import ccall "GOST34112012Init"-  cGOST34112012Init :: Ptr GOST34112012HashCtx -> CInt -> IO ()--foreign import ccall "GOST34112012Update"-  cGOST34112012Update :: Ptr GOST34112012HashCtx -> CString -> CSize -> IO ()--foreign import ccall "GOST34112012Final"-  cGOST34112012Final :: Ptr GOST34112012HashCtx -> CString -> IO ()--foreign import ccall "GOST34112012Cleanup"-  cGOST34112012Cleanup :: Ptr GOST34112012HashCtx -> IO ()

@@ -1,17 +1,17 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, LambdaCase #-} module Main (main) where-import Data.Digest.GOST34112012.Hash+import Crypto.Hash.GOST34112012 import Prelude hiding (readFile, putStrLn) import Data.ByteString (ByteString)-import qualified Data.ByteString as BIO-import Data.ByteString.Base16 (encode)-import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import qualified Data.ByteString as B+import Data.Text.Encoding (encodeUtf8) import Data.Text (Text, toUpper, pack, unpack) import Data.Text.IO (putStrLn) import qualified Data.Text.IO as TIO import Control.Monad (when, forM_) import System.CPUTime (getCPUTime, cpuTimePrecision) import Control.Exception (catchJust)+import System.IO (IOMode(..), withBinaryFile) import System.IO.Error (ioeGetErrorType, isDoesNotExistErrorType)  main :: IO ()@@ -19,43 +19,44 @@   t0 <- getCPUTimeNS    report t0 "Processing 'empty' test"-  hashB16 512 "" >>= test t0 "empty" emptyB16_512-  hashB16 256 "" >>= test t0 "empty" emptyB16_256+  hashB16_512 "" >>= test t0 "empty" emptyB16_512+  hashB16_256 "" >>= test t0 "empty" emptyB16_256      report t0 "Processing 'two symbols' test"-  hashB16 512 "xe" >>= test t0 "two ascii" twoAsciiB16_512-  hashB16 512 "хе" >>= test t0 "two unicode" twoUnicodeB16_512+  hashB16_512 "xe" >>= test t0 "two ascii" twoAsciiB16_512+  hashB16_512 "хе" >>= test t0 "two unicode" twoUnicodeB16_512    report t0 "Processing 'LICENSE' test"   TIO.readFile "LICENSE" >>=-    hashB16 512 >>= test t0 "LICENSE" licenseB16_512+    hashB16_512 >>= test t0 "LICENSE" licenseB16_512   TIO.readFile "LICENSE" >>=-    hashB16 256 >>= test t0 "LICENSE" licenseB16_256+    hashB16_256 >>= test t0 "LICENSE" licenseB16_256   TIO.readFile "c_src/streebog/LICENSE" >>=-    hashB16 512 >>= test t0 "LICENSE" licenseStreebogB16_512+    hashB16_512 >>= test t0 "LICENSE" licenseStreebogB16_512   TIO.readFile "c_src/streebog/LICENSE.GPL2" >>=-    hashB16 256 >>= test t0 "LICENSE.GPL2" licenseGpl2B16_256+    hashB16_256 >>= test t0 "LICENSE.GPL2" licenseGpl2B16_256+  sequenceFileRead 256 "c_src/streebog/LICENSE.GPL2" >>=+    test t0 "LICENSE.GPL2" licenseGpl2B16_256+  sequenceFileRead 512 "c_src/streebog/LICENSE.GPL2" >>=+    test t0 "LICENSE.GPL2" licenseGpl2B16_512 -  report t0 "Processing etalons"   forM_ [ (bs, i) | i <- [1, 3, 4, 5, 6], bs <- [512, 256] ] $ uncurry $     testEtalon t0 TIO.readFile hashB16 -  report t0 "Processing 'M2' (win-1251) test"-  testEtalon t0 BIO.readFile hashB16B 512 2-  testEtalon t0 BIO.readFile hashB16B 256 2+  testEtalon t0 B.readFile hashB16B 512 2+  testEtalon t0 B.readFile hashB16B 256 2  -- 4G file! Use make4G if needed   catchFileNotFound (report t0 "The missing etalon M7 is skipped. \     \The file takes about 4 gbytes, and can be generated by the \     \test/etalon/make4Gb command.") $ do-      report t0 "Processing 'M7' (4Gb) test (it will be long)"-      testEtalon t0 BIO.readFile hashB16B 512 7-      testEtalon t0 BIO.readFile hashB16B 256 7+      testEtalon' t0 512 7 $ sequenceFileRead 512+      testEtalon' t0 256 7 $ sequenceFileRead 256+      -- testEtalon t0 B.readFile hashB16B 256 7  -  report t0 "Processing 'M8' (carry) test"-  testEtalon t0 BIO.readFile hashB16B 512 8-  testEtalon t0 BIO.readFile hashB16B 256 8+  testEtalon t0 B.readFile hashB16B 512 8+  testEtalon t0 B.readFile hashB16B 256 8    report t0 "Tests passed"   pure ()@@ -84,6 +85,9 @@ licenseGpl2B16_256 :: Text licenseGpl2B16_256 = "972B18C6ABA96CBADB6C1F817DFB7CBCA2E08BCA5513819E05CEF85B69A7E1CC" +licenseGpl2B16_512 :: Text+licenseGpl2B16_512 = toUpper "7ecacddc1e3c92dbe2cda16f2b035bd5278cda5ab248f94117853c900105295d15490175f1c07d38d235a48fd9c165e01673bab76a12bb9c924da752189aeb9b"+ licenseStreebogB16_512 :: Text licenseStreebogB16_512 = toUpper "6ee316287bab10429c3c66311c606406fbb2f42848de9007c239cc6d9f43ea1a0f272ee3a4e55cc9850a0542a8c4e73a44a4aa08827c2803d0ac32db1ce8e4b7" @@ -107,18 +111,26 @@   ("8.256", "AAAD2B63E972EA3EAF14922255786A56ECBC9DFF7589C81C40DC96F52F3695EA")   ] +sequenceFileRead :: Int -> FilePath -> IO Text+sequenceFileRead bs fname = withBinaryFile fname ReadMode $ \h -> do+  ctx <- initGOST34112012 bs+  -- kinda "random" buffer size+  let bsize = (+ 21) . (flip mod 262144) . (* 3) <$> getGOST34112012BufSize ctx+  let loop = bsize >>= B.hGet h >>= \case+        "" -> pure ()+        b -> updateGOST34112012 ctx b >> loop+  loop+  hex <$> finishGOST34112012 ctx++testEtalon' :: Integer -> Int -> Int -> (FilePath -> IO Text) -> IO ()+testEtalon' t0 bs n r = do+  (tid, chk, fname) <- readEtalon bs n+  report t0 $ "Processing etalon " ++ tid ++ " file " ++ fname+  tst <- r fname+  test t0 (pack $ tid ++ " (" ++ fname ++ ")") (toUpper chk) tst+ testEtalon :: Integer -> (FilePath -> IO t) -> (Int -> t -> IO Text) -> Int -> Int -> IO ()-testEtalon t0 r h bs n = do-  report t0 $ "Processing etalon " ++ show tid-  chk <- TIO.readFile $ etalonPath ++ "H" ++ tid-  csum <- hashB16 256 chk-  if not $ etalonsCheck tid csum-    then fail $ unpack $ "Etalon csum mismatch! Please fix function etalonCheck: '" <>-      " (\"" <> pack tid <> "\", \"" <> csum <> "\")"-    else do-      tst <- r (etalonPath ++ "M" ++ show n ++ ".src") >>= h bs-      test t0 (pack $ etalonPath ++ "/?" <> tid) (toUpper chk) tst where-        tid = show n ++ "." ++ show bs+testEtalon t0 r h bs n = testEtalon' t0 bs n $ \fname -> r fname >>= h bs  test :: Integer -> Text -> Text -> Text -> IO () test t0 msg tst chk = when (chk /= tst) testFail where@@ -126,11 +138,30 @@     report t0 $ unpack $ "Test '" <> msg <> "' FAILED: '" <> chk <> "' /= '" <> tst <> "'"     fail $ unpack msg +readEtalon :: Int -> Int -> IO (String, Text, FilePath)+readEtalon bs n = let tid = show n ++ "." ++ show bs in do+  chk <- TIO.readFile $ etalonPath ++ "H" ++ tid+  csum <- hashB16 256 chk+  if not $ etalonsCheck tid csum+    then fail $ unpack $ "Etalon csum mismatch! Please fix function etalonCheck: '" <>+      " (\"" <> pack tid <> "\", \"" <> csum <> "\")"+    else pure (tid, chk, etalonPath ++ "M" ++ show n ++ ".src")++hashB16_512 :: Text -> IO Text+hashB16_512 = fmap hex . hashGOST34112012_512 . encodeUtf8++hashB16_256 :: Text -> IO Text+hashB16_256 = fmap hex . hashGOST34112012_256 . encodeUtf8+ hashB16 :: Int -> Text -> IO Text hashB16 bs = hashB16B bs . encodeUtf8  hashB16B :: Int -> ByteString -> IO Text-hashB16B bs = fmap (toUpper . decodeUtf8 . encode) . hashGOST34112012 bs+hashB16B bs = fmap hex . hashGOST34112012 bs++hex :: ByteString -> Text+hex = let h = ("0123456789ABCDEF" !!) . fromEnum+    in pack . B.foldr (\b a -> h (div b 16) : h (mod b 16) : a) ""  getCPUTimeNS :: IO Integer getCPUTimeNS = fmap (flip div cpuTimePrecision) getCPUTime

@@ -1,4 +1,4 @@-cat M5 M6 > tmp1+cat M5.src M6.src > tmp1 cat tmp1 tmp1 tmp1 tmp1 > tmp2 cat tmp2 tmp2 tmp2 tmp2 > tmp1 cat tmp1 tmp1 tmp1 tmp1 > tmp2@@ -11,5 +11,5 @@ cat tmp2 tmp2 tmp2 tmp2 > tmp1 cat tmp1 tmp1 tmp1 tmp1 > tmp2 cat tmp2 tmp2 tmp2 tmp2 > tmp1-cat M2 tmp1 > M7+cat M2.src tmp1 > M7.src rm -f tmp1 tmp2