Skip to content

Instantly share code, notes, and snippets.

@aljce
Created June 7, 2023 01:59
Show Gist options
  • Save aljce/28eb54caa70ace39e17d8b8dfbacee4d to your computer and use it in GitHub Desktop.
Save aljce/28eb54caa70ace39e17d8b8dfbacee4d to your computer and use it in GitHub Desktop.
runWithAsaModes
:: ( AsaMode
-> ( String
-> YT.SIO (YT.YesodExampleData App) (AsaTestState Identity)
-> SpecWith (Arg (YT.SIO (YT.YesodExampleData App) (AsaTestState Identity)))
)
-> SpecWith (Arg (YT.SIO (YT.YesodExampleData App) ()))
)
-> SpecWith (Arg (YT.SIO (YT.YesodExampleData App) ()))
runWithAsaModes cb = do
-- The tmvar scheme is required because hspec tests cant communicate results to each other.
-- The tests are run concurrently anyway so this makes sense from that perspective.
nominalVar <- runIO $ newEmptyTMVarIO
degradedVar <- runIO $ newEmptyTMVarIO
let mkIt
:: TMVar AsaTestResult
-> String
-> YT.SIO (YT.YesodExampleData App) (AsaTestState Identity)
-> SpecWith (Arg (YT.SIO (YT.YesodExampleData App) (AsaTestState Identity)))
mkIt var name action =
it name $ do
res <- try action
case res of
Left (err :: SomeException) -> do
atomically $ putTMVar var TestFailed
throwWithCallStack err
Right ts -> do
atomically $ putTMVar var $ TestFinished ts
pure ts
describe "ASA Fallback: Nominal" $ cb NominalPath (mkIt nominalVar)
describe "ASA Fallback: Degraded" $ cb DegradedPath (mkIt degradedVar)
it "ASA Fallback agreement" $ do
(nomRes, degRes) <- atomically $ (,) <$> takeTMVar nominalVar <*> takeTMVar degradedVar
nomState <- case nomRes of
TestFailed -> assertFailure "Nominal test didn't pass"
TestFinished nomState -> pure nomState
degState <- case degRes of
TestFailed -> assertFailure "Degraded test didn't pass"
TestFinished degState -> pure degState
YT.assertEq
"Nominal and Degraded asa fallback modes disagree on lithic transaction state"
(asaTestStateLithicTransactionState nomState)
(asaTestStateLithicTransactionState degState)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment