From b44f83e6f7a968cf1db3923de72628548a7df888 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sat, 11 Feb 2023 09:14:16 +0300
Subject: [PATCH] simple saltine tests

---
 hbs2-tests/hbs2-tests.cabal    | 47 ++++++++++++++++++++
 hbs2-tests/test/TestSaltine.hs | 79 ++++++++++++++++++++++++++++++++++
 2 files changed, 126 insertions(+)
 create mode 100644 hbs2-tests/test/TestSaltine.hs

diff --git a/hbs2-tests/hbs2-tests.cabal b/hbs2-tests/hbs2-tests.cabal
index 011fe9c6..cb45a3f7 100644
--- a/hbs2-tests/hbs2-tests.cabal
+++ b/hbs2-tests/hbs2-tests.cabal
@@ -208,3 +208,50 @@ executable test-logger
         , fast-logger
 
 
+executable test-saltine
+    import:           shared-properties
+    import:           common-deps
+    default-language: Haskell2010
+
+    ghc-options:
+      -- -prof
+      -- -fprof-auto
+
+    other-modules:
+
+    -- other-extensions:
+
+    -- type:             exitcode-stdio-1.0
+    hs-source-dirs:   test
+    main-is:          TestSaltine.hs
+
+    build-depends:
+          base, hbs2-core
+        , async
+        , attoparsec
+        , bytestring
+        , cache
+        , clock
+        , containers
+        , data-default
+        , data-textual
+        , directory
+        , hashable
+        , microlens-platform
+        , mtl
+        , mwc-random
+        , network
+        , network-ip
+        , prettyprinter
+        , random
+        , safe
+        , serialise
+        , stm
+        , streaming
+        , saltine
+        , text
+        , transformers
+        , uniplate
+        , vector
+        , fast-logger
+
diff --git a/hbs2-tests/test/TestSaltine.hs b/hbs2-tests/test/TestSaltine.hs
new file mode 100644
index 00000000..b2fe53c2
--- /dev/null
+++ b/hbs2-tests/test/TestSaltine.hs
@@ -0,0 +1,79 @@
+module Main where
+
+import HBS2.Prelude
+import HBS2.OrDie
+import HBS2.Storage (calcChunks)
+
+import Data.Traversable(forM)
+import Data.Foldable(for_)
+import System.TimeIt
+import Crypto.Saltine (sodiumInit)
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as LBS
+import Crypto.Saltine.Core.SecretBox qualified as Symm
+import Crypto.Saltine.Core.Box qualified as Asymm
+import Crypto.Saltine.Core.Box (publicKey)
+import Crypto.Saltine.Core.SecretBox (secretbox)
+import System.Environment
+import Safe
+import Prettyprinter
+import Data.Fixed
+import System.Directory
+
+defBlockSize = 256*1024
+
+
+main :: IO ()
+main = do
+  sodiumInit
+
+  f <- (headMay <$> getArgs) `orDie` "pass file to encrypt"
+
+  key <- Symm.newKey
+  nonce <- Symm.newNonce
+
+  kpair <- Asymm.newKeypair
+  nonce2 <- Asymm.newNonce
+
+  size <- getFileSize f
+  co   <- LBS.readFile f
+
+  let chunks = calcChunks size defBlockSize
+
+  timeItNamed "read and encrypt" do
+    sizes <- forM chunks $ \(off,sz) -> do
+      let chu = LBS.take sz $ LBS.drop off co
+      let box = secretbox key nonce (LBS.toStrict chu)
+      pure (BS.length box)
+
+    let s =  (realToFrac (sum sizes) - realToFrac size) / realToFrac size * 100 :: Fixed E6
+    print $ pretty (sum sizes) <> comma <+> pretty (show s)
+    putStrLn ""
+
+  putStrLn ""
+
+
+  timeItNamed "read and encrypt asymm" do
+    sizes <- forM chunks $ \(off,sz) -> do
+      let chu = LBS.take sz $ LBS.drop off co
+      box <- Asymm.boxSeal (publicKey kpair) (LBS.toStrict chu)
+      pure (BS.length box)
+
+    let s =  (realToFrac (sum sizes) - realToFrac size) / realToFrac size * 100 :: Fixed E6
+    print $ pretty (sum sizes) <> comma <+> pretty (show s)
+    putStrLn ""
+
+  putStrLn ""
+
+
+  timeItNamed "just read" do
+    sizes <- forM chunks $ \(off,sz) -> do
+      let chu = LBS.take sz $ LBS.drop off co
+      pure (LBS.length chu)
+
+    let s =  (realToFrac (sum sizes) - realToFrac size) / realToFrac size * 100 :: Fixed E6
+    print $ pretty (sum sizes) <> comma <+> pretty (show s)
+    putStrLn ""
+
+