mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 16:51:42 +03:00
55 lines
1.5 KiB
Haskell
55 lines
1.5 KiB
Haskell
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.EventLog.LMDB
|
|
import Urbit.Noun
|
|
import Urbit.Noun.Time
|
|
import Urbit.Prelude
|
|
import Urbit.Vere.Behn
|
|
import Urbit.Vere.Pier.Types
|
|
|
|
import Control.Concurrent (runInBoundThread, threadDelay)
|
|
import Data.LargeWord (LargeKey(..))
|
|
import GHC.Natural (Natural)
|
|
import Network.Socket (tupleToHostAddress)
|
|
import Urbit.King.App (runKingEnvNoLog, HasKingId(..))
|
|
|
|
import qualified Urbit.EventLog.LMDB as Log
|
|
import qualified Urbit.Noun.Time as Time
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- TODO Timers always fire immediatly. Something is wrong!
|
|
timerFires :: Property
|
|
timerFires = forAll arbitrary (ioProperty . runKingEnvNoLog . runTest)
|
|
where
|
|
runTest :: HasKingId e => () -> RIO e Bool
|
|
runTest () = do
|
|
envr <- ask
|
|
king <- fromIntegral <$> view kingIdL
|
|
q <- newTQueueIO
|
|
rwith (liftAcquire $ behn envr (writeTQueue q)) $ \cb -> do
|
|
io $ cb (BehnEfDoze (king, ()) (Just (2^20)))
|
|
t <- atomically $ readTQueue q
|
|
pure True
|
|
|
|
|
|
-- Utils -----------------------------------------------------------------------
|
|
|
|
tests :: TestTree
|
|
tests =
|
|
testGroup "Behn"
|
|
[ localOption (QuickCheckTests 10) $
|
|
testProperty "Behn Timers Fire" $
|
|
timerFires
|
|
]
|