shrub/pkg/hs/urbit-king/test/BehnTests.hs

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
    ]