GOST34112012-Hash-0.1.1.2: test/Main.hs

{-# LANGUAGE OverloadedStrings, LambdaCase #-}
module Main (main) where
import Crypto.Hash.GOST34112012
import Prelude hiding (readFile, putStrLn)
import Data.ByteString (ByteString)
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 ()
main = do
  t0 <- getCPUTimeNS

  report t0 "Processing 'empty' test"
  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

  report t0 "Processing 'LICENSE' test"
  TIO.readFile "LICENSE" >>=
    hashB16_512 >>= test t0 "LICENSE" licenseB16_512
  TIO.readFile "LICENSE" >>=
    hashB16_256 >>= test t0 "LICENSE" licenseB16_256
  TIO.readFile "c_src/streebog/LICENSE" >>=
    hashB16_512 >>= test t0 "LICENSE" licenseStreebogB16_512
  TIO.readFile "c_src/streebog/LICENSE.GPL2" >>=
    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

  forM_ [ (bs, i) | i <- [1, 3, 4, 5, 6], bs <- [512, 256] ] $ uncurry $
    testEtalon t0 TIO.readFile hashB16

  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
      testEtalon' t0 512 7 $ sequenceFileRead 512
      testEtalon' t0 256 7 $ sequenceFileRead 256
      -- testEtalon t0 B.readFile hashB16B 256 7


  testEtalon t0 B.readFile hashB16B 512 8
  testEtalon t0 B.readFile hashB16B 256 8

  report t0 "Tests passed"
  pure ()

etalonPath :: FilePath
etalonPath = "test/etalon/"

emptyB16_512 :: Text
emptyB16_512 = "8E945DA209AA869F0455928529BCAE4679E9873AB707B55315F56CEB98BEF0A7362F715528356EE83CDA5F2AAC4C6AD2BA3A715C1BCD81CB8E9F90BF4C1C1A8A"

emptyB16_256 :: Text
emptyB16_256 = "3F539A213E97C802CC229D474C6AA32A825A360B2A933A949FD925208D9CE1BB"

twoAsciiB16_512 :: Text
twoAsciiB16_512 = toUpper "f5e2ec8bf5705a0b6ed1afd6e469a3cabd1a0476d8ae904aafdb094c69b33f5f2a890b9258c205dde383b83a1a391f18685b4395de4b4d1037944448ce797068"

twoUnicodeB16_512 :: Text
twoUnicodeB16_512 = toUpper "c90966f0594acbfec047b11b02d03344e19070e35b36c523577223aeae0ad8d3172d8955174faac47a256628ac7e69427222ace2eae454ea7fa52086ee43fa97"

licenseB16_512 :: Text
licenseB16_512 = toUpper "40253a453e526e62d96af2e6efe64d794039908053fdedaf0e5340f6369a966dc9341d1f988c9169e2b1fb51f4987b219e6b26417e5b1afa34df09e002efdddd"

licenseB16_256 :: Text
licenseB16_256 = toUpper "14e7341e97e50e47526b333820dc53bc12d70fe6df76ebf2231531951b4a1819"

licenseGpl2B16_256 :: Text
licenseGpl2B16_256 = "972B18C6ABA96CBADB6C1F817DFB7CBCA2E08BCA5513819E05CEF85B69A7E1CC"

licenseGpl2B16_512 :: Text
licenseGpl2B16_512 = toUpper "7ecacddc1e3c92dbe2cda16f2b035bd5278cda5ab248f94117853c900105295d15490175f1c07d38d235a48fd9c165e01673bab76a12bb9c924da752189aeb9b"

licenseStreebogB16_512 :: Text
licenseStreebogB16_512 = toUpper "6ee316287bab10429c3c66311c606406fbb2f42848de9007c239cc6d9f43ea1a0f272ee3a4e55cc9850a0542a8c4e73a44a4aa08827c2803d0ac32db1ce8e4b7"

etalonsCheck :: String -> Text -> Bool
etalonsCheck tid csum = maybe False (== csum) $ lookup tid [
  ("1.512", "D7630524FCAF7054613064EE5FE1D19885FCD33B2F74FB074F1A6724420E127F"),
  ("1.256", "C81762568A91969C2FFBC4EE9F4817B636043BFA95A9A25FBCDBAF4ADB8D3ACE"),
  ("2.512", "35A4B0011506B6521A7222FECAF2E97F6C3482F55ABA4F821D6302E8EF553551"),
  ("2.256", "9F86EABE1AC4DEC3B46378DB6470ABEEFE9AEADE12116A269875F391C2B9763E"),
  ("3.512", "1B101143197C9B5CFAC2F2D9A0A29BE8315B76FF442BFA8C7003522CF6BF76EF"),
  ("3.256", "D789EC569F4910EB3CCF37D04C4EAE9119CA8BF50F10E4CC8D4DB8ED641374B5"),
  ("4.512", "5A269B8F9126EF8233F9255EC30E41295692294DC0F52584BC01EF91C0315BCD"),
  ("4.256", "DFC267C06977089381D049BF3532862CBBA81991079FA6706AC66C3A2E6E1803"),
  ("5.512", "6E543523B6BE13F3F516D3B6F4C29D66A3E57F562F494AACD2BCD9BDA641B20B"),
  ("5.256", "502BD3C103F5C751F09E8129AFF7445CD3036F16182883773964A2DDFF42FC29"),
  ("6.512", "F3A1BFBE060CE023343549259840BAD60A5718A7996911E9DFDBCFD4698FD79F"),
  ("6.256", "CBF20C9196004329067882AE468E8B850600E23687CD846419E38B9D18123566"),
  ("7.256", "6AC9BCEC2F70243C9E55331E553BB351266B638085A46F7EFF3D053FD1B1EA7C"),
  ("7.512", "18C144CED8D060D8D2AB933B8EF7D30973E6ECB3E02C548804A29A0CB616DE46"),
  ("8.512", "6F2ED35F3541D12C25F3C7B3FC049DD3053E4F2687331C86FB907BA132D01A17"),
  ("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 = 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
  testFail = do
    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 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

report :: Integer -> String -> IO ()
report t0 msg = getCPUTimeNS >>= \t -> putStrLn $ pack $ "  [" ++ show (t - t0) ++ "] " ++ msg

catchFileNotFound :: IO () -> IO () -> IO ()
catchFileNotFound h m = catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing) m (const h)