module Bench.Pos.Explorer.ServerBench
    ( runTimeBenchmark
    , runSpaceBenchmark
    ) where

import           Universum

import           Criterion.Main (bench, defaultConfig, defaultMainWith, nfIO)
import           Criterion.Types (Config (..))
import           Weigh (io, mainWith)

import           Test.QuickCheck (arbitrary, generate)

import           Pos.Explorer.DB (defaultPageSize)
import           Pos.Explorer.ExplorerMode (ExplorerTestParams,
                     runExplorerTestMode)
import           Pos.Explorer.ExtraContext (ExtraContext (..), makeMockExtraCtx)
import           Pos.Explorer.TestUtil (BlockNumber, SlotsPerEpoch,
                     generateValidExplorerMockableMode)
import           Pos.Explorer.Web.ClientTypes (CBlockEntry)
import           Pos.Explorer.Web.Server (getBlocksPage, getBlocksTotal)

import           Test.Pos.Chain.Genesis.Dummy (dummyEpochSlots)
import           Test.Pos.Chain.Txp.Arbitrary.Unsafe ()
import           Test.Pos.Configuration (withDefConfigurations)

----------------------------------------------------------------
-- Mocked functions
----------------------------------------------------------------

type BenchmarkTestParams = (ExplorerTestParams, ExtraContext)

-- | @getBlocksTotal@ function for benchmarks.
getBlocksTotalBench :: BenchmarkTestParams -> IO Integer
getBlocksTotalBench (testParams, extraContext) =
    withDefConfigurations $ \_ _ _ -> runExplorerTestMode
        testParams
        extraContext
        getBlocksTotal

-- | @getBlocksPage@ function for the last page for benchmarks.
getBlocksPageBench :: BenchmarkTestParams -> IO (Integer, [CBlockEntry])
getBlocksPageBench (testParams, extraContext) =
    withDefConfigurations $ \_ _ _ ->
        runExplorerTestMode testParams extraContext
            $ getBlocksPage
                  dummyEpochSlots
                  Nothing
                  (Just $ fromIntegral defaultPageSize)

-- | This is used to generate the test environment. We don't do this while benchmarking
-- the functions since that would include the time/memory required for the generation of the
-- mock blockchain (test environment), and we don't want to include that in our benchmarks.
generateTestParams
    :: BlockNumber
    -> SlotsPerEpoch
    -> IO BenchmarkTestParams
generateTestParams totalBlocksNumber slotsPerEpoch = do
    testParams <- testParamsGen

    -- We replace the "real" blockchain with our custom generated one.
    mode <- generateValidExplorerMockableMode totalBlocksNumber slotsPerEpoch

    -- The extra context so we can mock the functions.
    let extraContext :: ExtraContext
        extraContext = withDefConfigurations $ \_ _ _ -> makeMockExtraCtx mode

    pure (testParams, extraContext)
  where
    -- | Generated test parameters.
    testParamsGen :: IO ExplorerTestParams
    testParamsGen = generate arbitrary

-- | Extracted common code. This needs to be run before the benchmarks since we don't
-- want to include time/memory of the test data generation in the benchmarks.
usingGeneratedBlocks :: IO (BenchmarkTestParams, BenchmarkTestParams, BenchmarkTestParams)
usingGeneratedBlocks = do

    blocks100   <- generateTestParams 100 10
    blocks1000  <- generateTestParams 1000 10
    blocks10000 <- generateTestParams 10000 10

    pure (blocks100, blocks1000, blocks10000)

----------------------------------------------------------------
-- Time benchmark
----------------------------------------------------------------

-- | Time @getBlocksPage@.
runTimeBenchmark :: IO ()
runTimeBenchmark = do
    -- Generate the test environment before the benchmarks.
    (blocks100, blocks1000, blocks10000) <- usingGeneratedBlocks

    defaultMainWith getBlocksPageConfig
        [ bench "getBlocksTotal 100 blocks" $ nfIO $ getBlocksTotalBench blocks100
        , bench "getBlocksTotal 1000 blocks" $ nfIO $ getBlocksTotalBench blocks1000
        , bench "getBlocksTotal 10000 blocks" $ nfIO $ getBlocksTotalBench blocks10000

        , bench "getBlocksPage 100 blocks" $ nfIO $ getBlocksPageBench blocks100
        , bench "getBlocksPage 1000 blocks" $ nfIO $ getBlocksPageBench blocks1000
        , bench "getBlocksPage 10000 blocks" $ nfIO $ getBlocksPageBench blocks10000
        ]

  where
    -- | Configuration.
    getBlocksPageConfig :: Config
    getBlocksPageConfig = defaultConfig
        { reportFile = Just "bench/results/ServerBackend.html"
        }

----------------------------------------------------------------
-- Space benchmark
----------------------------------------------------------------

-- | Space @getBlocksPage@.
runSpaceBenchmark :: IO ()
runSpaceBenchmark = do
    -- Generate the test environment before the benchmarks.
    (blocks100, blocks1000, blocks10000) <- usingGeneratedBlocks

    mainWith $ do
        io "getBlocksTotal 100 blocks" getBlocksTotalBench blocks100
        io "getBlocksTotal 1000 blocks" getBlocksTotalBench blocks1000
        io "getBlocksTotal 10000 blocks" getBlocksTotalBench blocks10000

        io "getBlocksPage 100 blocks" getBlocksPageBench blocks100
        io "getBlocksPage 1000 blocks" getBlocksPageBench blocks1000
        io "getBlocksPage 10000 blocks" getBlocksPageBench blocks10000
