Skip to content

Commit

Permalink
align benchmark structure with hspec a bit more
Browse files Browse the repository at this point in the history
  • Loading branch information
KtorZ committed Apr 8, 2019
1 parent 8aca631 commit 18901ea
Showing 1 changed file with 30 additions and 36 deletions.
66 changes: 30 additions & 36 deletions test/bench/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,6 @@ import Cardano.Wallet.Network.HttpBridge
( newNetworkLayer )
import Cardano.Wallet.Primitive.AddressDerivation
( Passphrase (..) )
import Cardano.Wallet.Primitive.AddressDiscovery
( mkAddressPoolGap )
import Cardano.Wallet.Primitive.Types
( SlotId, WalletName (..) )
import Control.Arrow
Expand All @@ -32,7 +30,7 @@ import Control.DeepSeq
import Control.Exception
( bracket, evaluate )
import Control.Monad
( mapM_ )
( forM_ )
import Criterion.Measurement
( getTime, initializeTime, secs )
import Data.Generics.Internal.VL.Lens
Expand All @@ -43,7 +41,7 @@ import qualified Data.Text as T
import Data.Text.Class
( FromText (..), TextDecodingError (..), ToText (..) )
import Fmt
( fmt, (+|), (+||), (|+), (||+) )
( fmt, (+||), (|+), (||+) )
import Say
( say )
import System.Environment
Expand All @@ -59,10 +57,20 @@ main :: IO ()
main = do
network <- getArgs >>= either fail return . parseArgs
installSignalHandlers
runBenchmarks
[ bench ("restore " <> toText network <> " seq")
initializeTime
describe "Wallet Restoration"
[ bench ("Restore " <> toText network <> " seq")
(bench_restoration network walletSeq)
]
where
walletSeq :: NewWallet
walletSeq = NewWallet
{ gap = minBound
, name = WalletName "Benchmark Sequential Wallet"
, passphrase = mempty
, secondFactor = mempty
, seed = Passphrase "whatever"
}

-- | Very simplistic benchmark argument parser. If anything more is ever needed,
-- it's probably a good idea to go for `optparse-application` or similar for a
Expand All @@ -77,26 +85,24 @@ parseArgs = \case
Left "invalid arguments provided to benchmark suite: I expect a\
\ single string with the target network (e.g. \"mainnet\")."

runBenchmarks :: [IO (Text, Double)] -> IO ()
runBenchmarks bs = do
initializeTime
rs <- sequence bs
say "\n\nAll results:"
mapM_ (uncurry printResult) rs

bench :: Text -> IO () -> IO (Text, Double)
bench benchName action = do
say $ "Running " <> benchName
-- | Run a serie of benchmark in sequence
describe :: Text -> [IO Double] -> IO ()
describe title bs = do
say title
forM_ bs $ \runBenchmark -> do
time <- runBenchmark
say . fmt $ secs time|+""

-- | Declare a benchmark to run. Returns the time it took.
bench :: Text -> IO () -> IO Double
bench title action = do
say $ " " <> title
start <- getTime
res <- action
evaluate (rnf res)
finish <- getTime
let dur = finish - start
printResult benchName dur
pure (benchName, dur)
return $ finish - start

printResult :: Text -> Double -> IO ()
printResult benchName dur = say . fmt $ " "+|benchName|+": "+|secs dur|+""

{-------------------------------------------------------------------------------
Benchmarks
Expand All @@ -108,16 +114,13 @@ bench_restoration network nw = withHttpBridge network $ \port -> do
dbLayer <- MVar.newDBLayer
networkLayer <- newNetworkLayer networkName port
(_, bh) <- unsafeRunExceptT $ networkTip networkLayer
say . fmt $ "Note: the "+|networkName|+" tip is at "+||(bh ^. #slotId)||+""
say . fmt $ networkName|+" tip is at "+||(bh ^. #slotId)||+""
let walletLayer = mkWalletLayer dbLayer networkLayer
wallet <- unsafeRunExceptT $ createWallet walletLayer nw
processWallet walletLayer logChunk wallet
where
networkName = toText network

logChunk :: SlotId -> IO ()
logChunk slot = say . fmt $ "Processing "+||slot||+""

withHttpBridge :: Network -> (Int -> IO a) -> IO a
withHttpBridge network action = bracket start stop (const (action port))
where
Expand All @@ -138,14 +141,5 @@ withHttpBridge network action = bracket start stop (const (action port))
cancel handle
threadDelay 1000000 -- wait for socket to be closed


baseWallet :: NewWallet
baseWallet = NewWallet (Passphrase "") (Passphrase "")
(WalletName "") (Passphrase "") gap20
where Right gap20 = mkAddressPoolGap 20

walletSeq :: NewWallet
walletSeq = baseWallet
{ seed = Passphrase "involve key curtain arrest fortune custom lens marine before material wheel glide cause weapon wrap"
, name = WalletName "Benchmark Sequential Wallet"
}
logChunk :: SlotId -> IO ()
logChunk slot = say . fmt $ "Processing "+||slot||+""

0 comments on commit 18901ea

Please sign in to comment.