1
1
mirror of https://github.com/urbit/shrub.git synced 2024-12-28 22:54:15 +03:00
shrub/pkg/hs/urbit-king/test/BehnTests.hs

55 lines
1.5 KiB
Haskell
Raw Normal View History

2019-08-01 03:27:13 +03:00
module BehnTests (tests) where
import Data.Acquire
import Data.Conduit
import Data.Conduit.List hiding (take)
import Data.Ord.Unicode
import Test.QuickCheck hiding ((.&.))
import Test.Tasty
import Test.Tasty.QuickCheck
import Test.Tasty.TH
import Urbit.Arvo
import Urbit.Noun
import Urbit.Prelude
import Urbit.Time
import Urbit.Vere.Behn
import Urbit.Vere.Log
import Urbit.Vere.Pier.Types
2019-08-01 03:27:13 +03:00
import Control.Concurrent (runInBoundThread, threadDelay)
import Data.LargeWord (LargeKey(..))
import GHC.Natural (Natural)
import Network.Socket (tupleToHostAddress)
import Urbit.King.App (runKingEnvNoLog, HasKingId(..))
2019-08-01 03:27:13 +03:00
import qualified Urbit.Time as Time
import qualified Urbit.Vere.Log as Log
2019-08-01 03:27:13 +03:00
--------------------------------------------------------------------------------
-- TODO Timers always fire immediatly. Something is wrong!
timerFires :: Property
timerFires = forAll arbitrary (ioProperty . runKingEnvNoLog . runTest)
2019-08-01 03:27:13 +03:00
where
2020-05-30 01:57:35 +03:00
runTest :: HasKingId e => () -> RIO e Bool
2019-08-01 03:27:13 +03:00
runTest () = do
2020-05-30 01:57:35 +03:00
envr <- ask
king <- fromIntegral <$> view kingIdL
2019-08-01 03:27:13 +03:00
q <- newTQueueIO
2020-05-30 01:57:35 +03:00
rwith (liftAcquire $ snd $ behn envr (writeTQueue q)) $ \cb -> do
cb (BehnEfDoze (king, ()) (Just (2^20)))
2019-08-01 03:27:13 +03:00
t <- atomically $ readTQueue q
pure True
2019-08-01 03:27:13 +03:00
-- Utils -----------------------------------------------------------------------
tests :: TestTree
tests =
testGroup "Behn"
[ localOption (QuickCheckTests 10) $
testProperty "Behn Timers Fire" $
timerFires
]