module Hydra.Chain.BlockfrostSpec where

import Hydra.Prelude
import Test.Hspec

import Control.Concurrent.Class.MonadSTM (newTVarIO, takeTMVar, writeTQueue)
import Control.Retry (RetryPolicyM, limitRetries)
import Control.Tracer (nullTracer)
import Hydra.Chain.Blockfrost (blockfrostSubmissionClient, memoizeIO, retryOnBlockfrostError)
import Hydra.Chain.Blockfrost.Client (APIBlockfrostError (..), BlockfrostException (..), TxHash (..), isRetryable)
import Hydra.Chain.Direct.Handlers (CardanoChainLog)
import Hydra.Logging (Tracer)
import Test.Hydra.Prelude (failAfter)
import Test.Hydra.Tx.Gen ()
import Test.QuickCheck (arbitrary, generate)

retry :: RetryPolicyM IO
retry :: RetryPolicyM IO
retry = Int -> RetryPolicy
limitRetries Int
3

spec :: Spec
spec :: Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"isRetryable" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"treats DecodeError as non-retryable" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      APIBlockfrostError -> Bool
isRetryable (Text -> APIBlockfrostError
DecodeError Text
"some decode error") Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
False

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"treats BlockfrostError as retryable" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      APIBlockfrostError -> Bool
isRetryable (Text -> APIBlockfrostError
BlockfrostError Text
"some API error") Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"treats BlockfrostRateLimited as retryable" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      APIBlockfrostError -> Bool
isRetryable APIBlockfrostError
BlockfrostRateLimited Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"retryOnBlockfrostError" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"retries on transient APIBlockfrostError and eventually succeeds" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      IORef Int
attemptsRef <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
      Text
result <-
        Tracer IO CardanoChainLog
-> RetryPolicyM IO -> (RetryStatus -> IO Text) -> IO Text
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tracer m CardanoChainLog
-> RetryPolicyM m -> (RetryStatus -> m a) -> m a
retryOnBlockfrostError (Tracer IO CardanoChainLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer :: Tracer IO CardanoChainLog) RetryPolicyM IO
retry ((RetryStatus -> IO Text) -> IO Text)
-> (RetryStatus -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ IO Text -> RetryStatus -> IO Text
forall a b. a -> b -> a
const (IO Text -> RetryStatus -> IO Text)
-> IO Text -> RetryStatus -> IO Text
forall a b. (a -> b) -> a -> b
$ do
          Int
attempts <- IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
attemptsRef
          IORef Int -> Int -> Expectation
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef Int
attemptsRef (Int
attempts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          if Int
attempts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
            then APIBlockfrostError -> IO Text
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO Text) -> APIBlockfrostError -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> APIBlockfrostError
BlockfrostError Text
"transient error"
            else Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"success" :: Text)
      Text
result Text -> Text -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Text
"success"
      Int
finalAttempts <- IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
attemptsRef
      Int
finalAttempts Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
3

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"gives up after max retries" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      IORef Int
attemptsRef <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
      let action :: IO Any
action = do
            IORef Int -> (Int -> Int) -> Expectation
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef Int
attemptsRef (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            APIBlockfrostError -> IO Any
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO Any) -> APIBlockfrostError -> IO Any
forall a b. (a -> b) -> a -> b
$ Text -> APIBlockfrostError
BlockfrostError Text
"persistent error"
      Tracer IO CardanoChainLog
-> RetryPolicyM IO -> (RetryStatus -> IO Any) -> IO Any
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tracer m CardanoChainLog
-> RetryPolicyM m -> (RetryStatus -> m a) -> m a
retryOnBlockfrostError (Tracer IO CardanoChainLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer :: Tracer IO CardanoChainLog) RetryPolicyM IO
retry (IO Any -> RetryStatus -> IO Any
forall a b. a -> b -> a
const IO Any
action)
        IO Any -> (APIBlockfrostError -> Bool) -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` \case
          BlockfrostError{} -> Bool
True
          APIBlockfrostError
_ -> Bool
False
      Int
finalAttempts <- IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
attemptsRef
      Int
finalAttempts Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
4

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"retries on HTTP error (BlockfrostError Text) and eventually succeeds" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      IORef Int
attemptsRef <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
      Text
result <-
        Tracer IO CardanoChainLog
-> RetryPolicyM IO -> (RetryStatus -> IO Text) -> IO Text
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tracer m CardanoChainLog
-> RetryPolicyM m -> (RetryStatus -> m a) -> m a
retryOnBlockfrostError (Tracer IO CardanoChainLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer :: Tracer IO CardanoChainLog) RetryPolicyM IO
retry ((RetryStatus -> IO Text) -> IO Text)
-> (RetryStatus -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ IO Text -> RetryStatus -> IO Text
forall a b. a -> b -> a
const (IO Text -> RetryStatus -> IO Text)
-> IO Text -> RetryStatus -> IO Text
forall a b. (a -> b) -> a -> b
$ do
          Int
attempts <- IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
attemptsRef
          IORef Int -> (Int -> Int) -> Expectation
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef Int
attemptsRef (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          if Int
attempts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
            then APIBlockfrostError -> IO Text
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO Text) -> APIBlockfrostError -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> APIBlockfrostError
BlockfrostError Text
"HTTP 403 Forbidden"
            else Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"success" :: Text)
      Text
result Text -> Text -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Text
"success"
      Int
finalAttempts <- IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
attemptsRef
      Int
finalAttempts Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
3

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"gives up after max retries on persistent HTTP error" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      IORef Int
attemptsRef <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
      let action :: IO Any
action = do
            IORef Int -> (Int -> Int) -> Expectation
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef Int
attemptsRef (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            APIBlockfrostError -> IO Any
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO Any) -> APIBlockfrostError -> IO Any
forall a b. (a -> b) -> a -> b
$ Text -> APIBlockfrostError
BlockfrostError Text
"HTTP 403 Forbidden"
      Tracer IO CardanoChainLog
-> RetryPolicyM IO -> (RetryStatus -> IO Any) -> IO Any
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tracer m CardanoChainLog
-> RetryPolicyM m -> (RetryStatus -> m a) -> m a
retryOnBlockfrostError (Tracer IO CardanoChainLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer :: Tracer IO CardanoChainLog) RetryPolicyM IO
retry (IO Any -> RetryStatus -> IO Any
forall a b. a -> b -> a
const IO Any
action)
        IO Any -> (APIBlockfrostError -> Bool) -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` \case
          BlockfrostError Text
_ -> Bool
True
          APIBlockfrostError
_ -> Bool
False
      Int
finalAttempts <- IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
attemptsRef
      Int
finalAttempts Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
4

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does not retry on BlockfrostClientError" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      IORef Int
attemptsRef <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
      let action :: IO Any
action = do
            IORef Int -> (Int -> Int) -> Expectation
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef Int
attemptsRef (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            APIBlockfrostError -> IO Any
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError -> IO Any) -> APIBlockfrostError -> IO Any
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError BlockfrostException
ByronAddressNotSupported
      Tracer IO CardanoChainLog
-> RetryPolicyM IO -> (RetryStatus -> IO Any) -> IO Any
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Tracer m CardanoChainLog
-> RetryPolicyM m -> (RetryStatus -> m a) -> m a
retryOnBlockfrostError (Tracer IO CardanoChainLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer :: Tracer IO CardanoChainLog) RetryPolicyM IO
retry (IO Any -> RetryStatus -> IO Any
forall a b. a -> b -> a
const IO Any
action)
        IO Any -> (APIBlockfrostError -> Bool) -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` \case
          BlockfrostClientError{} -> Bool
True
          APIBlockfrostError
_ -> Bool
False
      Int
finalAttempts <- IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
attemptsRef
      Int
finalAttempts Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
1

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"memoizeIO" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"runs the action only once" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      IORef Int
calls <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
      TVar (Maybe Text)
var <- Maybe Text -> IO (TVar IO (Maybe Text))
forall a. a -> IO (TVar IO a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO Maybe Text
forall a. Maybe a
Nothing
      [Text]
results <-
        Int -> IO Text -> IO [Text]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
5 (IO Text -> IO [Text]) -> IO Text -> IO [Text]
forall a b. (a -> b) -> a -> b
$
          TVar IO (Maybe Text) -> IO Text -> IO Text
forall a. TVar IO (Maybe a) -> IO a -> IO a
memoizeIO TVar (Maybe Text)
TVar IO (Maybe Text)
var (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ do
            IORef Int -> (Int -> Int) -> Expectation
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef Int
calls (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"genesis" :: Text)
      [Text]
results [Text] -> [Text] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
5 Text
"genesis"
      IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
calls IO Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` Int
1

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does not run the action when the cache is already filled" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      IORef Int
calls <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
      TVar (Maybe Text)
var <- Maybe Text -> IO (TVar IO (Maybe Text))
forall a. a -> IO (TVar IO a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"cached" :: Text))
      Text
result <- TVar IO (Maybe Text) -> IO Text -> IO Text
forall a. TVar IO (Maybe a) -> IO a -> IO a
memoizeIO TVar (Maybe Text)
TVar IO (Maybe Text)
var (IORef Int -> (Int -> Int) -> Expectation
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef Int
calls (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Expectation -> Text -> IO Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"fresh")
      Text
result Text -> Text -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Text
"cached"
      IORef Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef Int
calls IO Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` Int
0

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"blockfrostSubmissionClient" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"reports submission failures immediately and keeps serving the queue" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      NominalDiffTime -> Expectation -> Expectation
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
5 (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$ do
        TQueue (Tx, TMVar (Maybe (PostTxError Tx)))
queue <- String -> IO (TQueue IO (Tx, TMVar (Maybe (PostTxError Tx))))
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> m (TQueue m a)
newLabelledTQueueIO String
"test-submission-queue"
        IORef Int
calls <- Int -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef (Int
0 :: Int)
        let submit :: Tx -> IO (Either Text TxHash)
submit Tx
_tx = do
              Int
n <- IORef Int -> (Int -> (Int, Int)) -> IO Int
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' IORef Int
calls ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Int
c -> (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
c)
              Either Text TxHash -> IO (Either Text TxHash)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text TxHash -> IO (Either Text TxHash))
-> Either Text TxHash -> IO (Either Text TxHash)
forall a b. (a -> b) -> a -> b
$
                if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                  then Text -> Either Text TxHash
forall a b. a -> Either a b
Left Text
"submission failed"
                  else TxHash -> Either Text TxHash
forall a b. b -> Either a b
Right (Text -> TxHash
TxHash Text
"deadbeef")
        Tx
tx1 <- Gen Tx -> IO Tx
forall a. Gen a -> IO a
generate Gen Tx
forall a. Arbitrary a => Gen a
arbitrary
        Tx
tx2 <- Gen Tx -> IO Tx
forall a. Gen a -> IO a
generate Gen Tx
forall a. Arbitrary a => Gen a
arbitrary
        (String, Expectation)
-> (Async IO () -> Expectation) -> Expectation
forall (m :: * -> *) a b.
MonadAsync m =>
(String, m a) -> (Async m a -> m b) -> m b
withAsyncLabelled (String
"blockfrost-submit", Tracer IO CardanoChainLog
-> (Tx -> IO (Either Text TxHash))
-> TQueue IO (Tx, TMVar IO (Maybe (PostTxError Tx)))
-> Expectation
forall (m :: * -> *).
MonadSTM m =>
Tracer m CardanoChainLog
-> (Tx -> m (Either Text TxHash))
-> TQueue m (Tx, TMVar m (Maybe (PostTxError Tx)))
-> m ()
blockfrostSubmissionClient (Tracer IO CardanoChainLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer :: Tracer IO CardanoChainLog) Tx -> IO (Either Text TxHash)
submit TQueue (Tx, TMVar (Maybe (PostTxError Tx)))
TQueue IO (Tx, TMVar IO (Maybe (PostTxError Tx)))
queue) ((Async IO () -> Expectation) -> Expectation)
-> (Async IO () -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \Async IO ()
_ -> do
          Maybe (PostTxError Tx)
res1 <- TQueue IO (Tx, TMVar IO (Maybe (PostTxError Tx)))
-> Tx -> IO (Maybe (PostTxError Tx))
forall (m :: * -> *) a b.
MonadLabelledSTM m =>
TQueue m (a, TMVar m b) -> a -> m b
postViaQueue TQueue (Tx, TMVar (Maybe (PostTxError Tx)))
TQueue IO (Tx, TMVar IO (Maybe (PostTxError Tx)))
queue Tx
tx1
          Maybe (PostTxError Tx)
res1 Maybe (PostTxError Tx)
-> (Maybe (PostTxError Tx) -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` Maybe (PostTxError Tx) -> Bool
forall a. Maybe a -> Bool
isJust
          Maybe (PostTxError Tx)
res2 <- TQueue IO (Tx, TMVar IO (Maybe (PostTxError Tx)))
-> Tx -> IO (Maybe (PostTxError Tx))
forall (m :: * -> *) a b.
MonadLabelledSTM m =>
TQueue m (a, TMVar m b) -> a -> m b
postViaQueue TQueue (Tx, TMVar (Maybe (PostTxError Tx)))
TQueue IO (Tx, TMVar IO (Maybe (PostTxError Tx)))
queue Tx
tx2
          Maybe (PostTxError Tx)
res2 Maybe (PostTxError Tx)
-> (Maybe (PostTxError Tx) -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` Maybe (PostTxError Tx) -> Bool
forall a. Maybe a -> Bool
isNothing
 where
  postViaQueue :: forall m a b. MonadLabelledSTM m => TQueue m (a, TMVar m b) -> a -> m b
  postViaQueue :: forall (m :: * -> *) a b.
MonadLabelledSTM m =>
TQueue m (a, TMVar m b) -> a -> m b
postViaQueue TQueue m (a, TMVar m b)
queue a
tx = do
    TMVar m b
response <- STM m (TMVar m b) -> m (TMVar m b)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (TMVar m b) -> m (TMVar m b))
-> STM m (TMVar m b) -> m (TMVar m b)
forall a b. (a -> b) -> a -> b
$ do
      TMVar m b
r <- String -> STM m (TMVar m b)
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> STM m (TMVar m a)
newLabelledEmptyTMVar String
"test-response"
      TQueue m (a, TMVar m b) -> (a, TMVar m b) -> STM m ()
forall a. TQueue m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TQueue m a -> a -> STM m ()
writeTQueue TQueue m (a, TMVar m b)
queue (a
tx, TMVar m b
r)
      TMVar m b -> STM m (TMVar m b)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMVar m b
r
    STM m b -> m b
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m b -> m b) -> STM m b -> m b
forall a b. (a -> b) -> a -> b
$ TMVar m b -> STM m b
forall a. TMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TMVar m a -> STM m a
takeTMVar TMVar m b
response