mismi-s3-0.0.2: test/bench.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell   #-}

import           Control.Monad.Catch
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.Except (ExceptT, runExceptT, mapExceptT)

import           Criterion.Main

import qualified Data.Text as T

import           Mismi.S3
import qualified Mismi.S3.Unsafe as Unsafe

import           P

import           System.IO
import           System.IO.Error
import           System.IO.Temp

import           Test.Mismi

import qualified Test.Mismi.S3 as S3

createFiles :: Address -> Int -> AWS ()
createFiles prefix n = do
  mapM_ (flip (Unsafe.writeWithMode Overwrite) "data") $ files prefix n

createLargeFiles :: Address -> Int -> AWS ()
createLargeFiles prefix n = do
  withSystemTempFile "file" $ \f h -> do
    liftIO $ hSetFileSize h (100 * 1024 * 1024 :: Integer) {-- 100 mb --}
    liftIO $ hClose h
    mapM_ (Unsafe.uploadWithMode Overwrite f) $ files prefix n

files :: Address -> Int -> [Address]
files prefix n =
  fmap (\i -> withKey (// Key ("file-" <> (T.pack $ show i))) prefix) [1..n]

run :: AWS a -> IO a
run =
  runAWSDefaultRegion

runE :: ExceptT SyncError AWS a -> IO a
runE t =
  either (throwM . userError . T.unpack . renderSyncError) pure =<< runExceptT (mapExceptT runAWSDefaultRegion t)

main :: IO ()
main = do
  buck <- S3.testBucket
  let a = Address buck (Key "s3-benchmarks/small-foo")
      b = Address buck (Key "s3-benchmarks/small-bar")
      c = Address buck (Key "s3-benchmarks/large-foo")
      d = Address buck (Key "s3-benchmarks/large-bar")
      o = Address buck (Key "s3-benchmarks/output")
  run $ do
    createFiles a 100
    createFiles b 1000
    createLargeFiles c 100
    createLargeFiles d 1000
  runE $ syncWithMode OverwriteSync b o 100
  defaultMain [
      bgroup "sync-small-files" [
          bench "sem-100-100" (nfIO . runE $ syncWithMode OverwriteSync a o 100)
        , bench "sem-100-50" (nfIO . runE $ syncWithMode OverwriteSync a o 50)
        , bench "sem-100-20" (nfIO . runE $ syncWithMode OverwriteSync a o 20)
        , bench "sem-100-10" (nfIO . runE $ syncWithMode OverwriteSync a o 10)
        , bench "sem-100-1" (nfIO . runE $ syncWithMode OverwriteSync a o 1)
        , bench "sem-1000-1000" (nfIO . runE $ syncWithMode OverwriteSync b o 1000)
        , bench "sem-1000-100" (nfIO . runE $ syncWithMode OverwriteSync b o 100)
        , bench "sem-1000-10" (nfIO . runE $ syncWithMode OverwriteSync b o 10)
        ]
    , bgroup "sync-large-files" [
          bench "sem-100-100" (nfIO . runE $ syncWithMode OverwriteSync c o 100)
        , bench "sem-100-50" (nfIO . runE $ syncWithMode OverwriteSync c o 50)
        , bench "sem-100-20" (nfIO . runE $ syncWithMode OverwriteSync c o 20)
        , bench "sem-100-10" (nfIO . runE $ syncWithMode OverwriteSync c o 10)
        , bench "sem-100-1" (nfIO . runE $ syncWithMode OverwriteSync c o 1)
        , bench "sem-1000-1000" (nfIO . runE $ syncWithMode OverwriteSync d o 1000)
        , bench "sem-1000-100" (nfIO . runE $ syncWithMode OverwriteSync d o 100)
        , bench "sem-1000-10" (nfIO . runE $ syncWithMode OverwriteSync d o 10)
        ]

    ]