module Hydra.Node.InputQueueSpec where

import Hydra.Prelude

import Control.Monad.IOSim (IOSim, runSimOrThrow)
import Hydra.Node.InputQueue (Queued (queuedId), createInputQueue, dequeue, enqueue, park, queueStats, tryEnqueue)
import Test.Hspec (Spec, it, shouldBe)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (NonEmptyList (NonEmpty), Property, counterexample)
import Test.Util (isContinuous)

spec :: Spec
spec :: Spec
spec = do
  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"samples a full queue and refuses advisory admission without blocking" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let result :: (Bool, (Natural, Int), (Natural, Int))
result = (forall s. IOSim s (Bool, (Natural, Int), (Natural, Int)))
-> (Bool, (Natural, Int), (Natural, Int))
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s (Bool, (Natural, Int), (Natural, Int)))
 -> (Bool, (Natural, Int), (Natural, Int)))
-> (forall s. IOSim s (Bool, (Natural, Int), (Natural, Int)))
-> (Bool, (Natural, Int), (Natural, Int))
forall a b. (a -> b) -> a -> b
$ do
          InputQueue (IOSim s) Int
q <- IOSim s (InputQueue (IOSim s) Int)
forall (m :: * -> *) e.
(MonadDelay m, MonadAsync m, MonadLabelledSTM m) =>
m (InputQueue m e)
createInputQueue
          [Int] -> (Int -> IOSim s ()) -> IOSim s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
100 :: Int] ((Int -> IOSim s ()) -> IOSim s ())
-> (Int -> IOSim s ()) -> IOSim s ()
forall a b. (a -> b) -> a -> b
$ InputQueue (IOSim s) Int -> Int -> IOSim s ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue (IOSim s) Int
q
          Bool
admitted <- InputQueue (IOSim s) Int -> Int -> IOSim s Bool
forall (m :: * -> *) e. InputQueue m e -> e -> m Bool
tryEnqueue InputQueue (IOSim s) Int
q Int
101
          (Natural, Int)
stats <- InputQueue (IOSim s) Int -> IOSim s (Natural, Int)
forall (m :: * -> *) e. InputQueue m e -> m (Natural, Int)
queueStats InputQueue (IOSim s) Int
q
          Queued Int
firstItem <- InputQueue (IOSim s) Int -> IOSim s (Queued Int)
forall (m :: * -> *) e. InputQueue m e -> m (Queued e)
dequeue InputQueue (IOSim s) Int
q
          InputQueue (IOSim s) Int -> Queued Int -> IOSim s ()
forall (m :: * -> *) e. InputQueue m e -> Queued e -> m ()
park InputQueue (IOSim s) Int
q Queued Int
firstItem
          (Natural, Int)
parked <- InputQueue (IOSim s) Int -> IOSim s (Natural, Int)
forall (m :: * -> *) e. InputQueue m e -> m (Natural, Int)
queueStats InputQueue (IOSim s) Int
q
          (Bool, (Natural, Int), (Natural, Int))
-> IOSim s (Bool, (Natural, Int), (Natural, Int))
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
admitted, (Natural, Int)
stats, (Natural, Int)
parked)
    (Bool, (Natural, Int), (Natural, Int))
result (Bool, (Natural, Int), (Natural, Int))
-> (Bool, (Natural, Int), (Natural, Int)) -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` (Bool
False, (Natural
100, Int
0), (Natural
99, Int
1))

  String -> (NonEmptyList Int -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"adds sequential id to all enqueued items" NonEmptyList Int -> Property
prop_identify_enqueued_items

newtype DummyInput = DummyInput Int
  deriving newtype (DummyInput -> DummyInput -> Bool
(DummyInput -> DummyInput -> Bool)
-> (DummyInput -> DummyInput -> Bool) -> Eq DummyInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DummyInput -> DummyInput -> Bool
== :: DummyInput -> DummyInput -> Bool
$c/= :: DummyInput -> DummyInput -> Bool
/= :: DummyInput -> DummyInput -> Bool
Eq, Int -> DummyInput -> ShowS
[DummyInput] -> ShowS
DummyInput -> String
(Int -> DummyInput -> ShowS)
-> (DummyInput -> String)
-> ([DummyInput] -> ShowS)
-> Show DummyInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DummyInput -> ShowS
showsPrec :: Int -> DummyInput -> ShowS
$cshow :: DummyInput -> String
show :: DummyInput -> String
$cshowList :: [DummyInput] -> ShowS
showList :: [DummyInput] -> ShowS
Show)

prop_identify_enqueued_items :: NonEmptyList Int -> Property
prop_identify_enqueued_items :: NonEmptyList Int -> Property
prop_identify_enqueued_items (NonEmpty [Int]
inputs) =
  let test :: IOSim s [Word64]
      test :: forall s. IOSim s [Word64]
test = do
        InputQueue (IOSim s) Int
q <- IOSim s (InputQueue (IOSim s) Int)
forall (m :: * -> *) e.
(MonadDelay m, MonadAsync m, MonadLabelledSTM m) =>
m (InputQueue m e)
createInputQueue
        [Int] -> (Int -> IOSim s Word64) -> IOSim s [Word64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
inputs ((Int -> IOSim s Word64) -> IOSim s [Word64])
-> (Int -> IOSim s Word64) -> IOSim s [Word64]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
          InputQueue (IOSim s) Int -> Int -> IOSim s ()
forall (m :: * -> *) e. InputQueue m e -> e -> m ()
enqueue InputQueue (IOSim s) Int
q Int
i
          Queued Int -> Word64
forall a. Queued a -> Word64
queuedId (Queued Int -> Word64) -> IOSim s (Queued Int) -> IOSim s Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputQueue (IOSim s) Int -> IOSim s (Queued Int)
forall (m :: * -> *) e. InputQueue m e -> m (Queued e)
dequeue InputQueue (IOSim s) Int
q
      ids :: [Word64]
ids = (forall s. IOSim s [Word64]) -> [Word64]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow IOSim s [Word64]
forall s. IOSim s [Word64]
test
   in [Word64] -> Bool
forall a. (Eq a, Enum a) => [a] -> Bool
isContinuous [Word64]
ids
        Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"queued ids: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Word64] -> String
forall b a. (Show a, IsString b) => a -> b
show [Word64]
ids)