GOST34112012-Hash-0.1.1.0: test/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.Digest.GOST34112012.Hash
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 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.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

  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

-- 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


  report t0 "Processing 'M8' (carry) test"
  testEtalon t0 BIO.readFile hashB16B 512 8
  testEtalon t0 BIO.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"

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")
  ]

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

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

hashB16 :: Int -> Text -> IO Text
hashB16 bs = hashB16B bs . encodeUtf8

hashB16B :: Int -> ByteString -> IO Text
hashB16B bs = fmap (toUpper . decodeUtf8 . encode) . hashGOST34112012 bs

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)