module Testnet.Run
  ( runTestnet
  ) where

import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Resource
import           Data.Bool
import           Data.Function
import           Data.Int
import           Data.Maybe
import           System.Console.ANSI (Color (..), ColorIntensity (..), ConsoleLayer (..), SGR (..))
import           System.IO (IO)

import qualified Control.Concurrent as IO
import qualified Control.Concurrent.STM as STM
import qualified Hedgehog as H
import qualified Hedgehog.Extras.Test.Base as H
import qualified System.Console.ANSI as ANSI
import qualified System.Exit as IO
import qualified System.IO as IO
import qualified Test.Base as H
import qualified Testnet.Conf as H

testnetProperty :: Maybe Int -> (H.Conf -> H.Integration ()) -> H.Property
testnetProperty :: Maybe Int -> (Conf -> Integration ()) -> Property
testnetProperty Maybe Int
maybeTestnetMagic Conf -> Integration ()
tn = HasCallStack => Integration () -> Property
Integration () -> Property
H.integration (Integration () -> Property)
-> ((FilePath -> Integration ()) -> Integration ())
-> (FilePath -> Integration ())
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integration () -> Integration ()
forall a. Integration a -> Integration a
H.runFinallies (Integration () -> Integration ())
-> ((FilePath -> Integration ()) -> Integration ())
-> (FilePath -> Integration ())
-> Integration ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath -> Integration ()) -> Integration ()
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> (FilePath -> m ()) -> m ()
H.workspace FilePath
"chairman" ((FilePath -> Integration ()) -> Property)
-> (FilePath -> Integration ()) -> Property
forall a b. (a -> b) -> a -> b
$ \FilePath
tempAbsPath' -> do
  Conf
conf <- FilePath -> Maybe Int -> Integration Conf
H.mkConf FilePath
tempAbsPath' Maybe Int
maybeTestnetMagic

  -- Fork a thread to keep alive indefinitely any resources allocated by testnet.
  PropertyT (ReaderT IntegrationState (ResourceT IO)) ThreadId
-> Integration ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PropertyT (ReaderT IntegrationState (ResourceT IO)) ThreadId
 -> Integration ())
-> (IO ()
    -> PropertyT (ReaderT IntegrationState (ResourceT IO)) ThreadId)
-> IO ()
-> Integration ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO ThreadId
-> PropertyT (ReaderT IntegrationState (ResourceT IO)) ThreadId
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT (ResourceT IO ThreadId
 -> PropertyT (ReaderT IntegrationState (ResourceT IO)) ThreadId)
-> (IO () -> ResourceT IO ThreadId)
-> IO ()
-> PropertyT (ReaderT IntegrationState (ResourceT IO)) ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO () -> ResourceT IO ThreadId
forall (m :: * -> *).
MonadUnliftIO m =>
ResourceT m () -> ResourceT m ThreadId
resourceForkIO (ResourceT IO () -> ResourceT IO ThreadId)
-> (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO () -> ResourceT IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ResourceT IO () -> ResourceT IO ())
-> (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> ResourceT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Integration ()) -> IO () -> Integration ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
IO.threadDelay Int
10000000

  Integration () -> Integration ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Integration () -> Integration ())
-> Integration () -> Integration ()
forall a b. (a -> b) -> a -> b
$ Conf -> Integration ()
tn Conf
conf

  Integration ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
H.failure -- Intentional failure to force failure report

runTestnet :: Maybe Int -> (H.Conf -> H.Integration a) -> IO ()
runTestnet :: Maybe Int -> (Conf -> Integration a) -> IO ()
runTestnet Maybe Int
maybeTestnetMagic Conf -> Integration a
tn = do
  TVar Bool
tvRunning <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
STM.newTVarIO Bool
False

  IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> (Property -> IO Bool) -> Property -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> IO Bool
forall (m :: * -> *). MonadIO m => Property -> m Bool
H.check (Property -> IO ()) -> Property -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> (Conf -> Integration ()) -> Property
testnetProperty Maybe Int
maybeTestnetMagic ((Conf -> Integration ()) -> Property)
-> (Conf -> Integration ()) -> Property
forall a b. (a -> b) -> a -> b
$ \Conf
c -> do
    Integration a -> Integration ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Integration a -> Integration ())
-> Integration a -> Integration ()
forall a b. (a -> b) -> a -> b
$ Conf -> Integration a
tn Conf
c
    IO () -> Integration ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> Integration ())
-> (STM () -> IO ()) -> STM () -> Integration ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> Integration ()) -> STM () -> Integration ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar Bool
tvRunning Bool
True

  Bool
running <- TVar Bool -> IO Bool
forall a. TVar a -> IO a
STM.readTVarIO TVar Bool
tvRunning

  if Bool
running
    then do
      [SGR] -> IO ()
ANSI.setSGR [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Green]
      FilePath -> IO ()
IO.putStr FilePath
"Testnet is running.  Type CTRL-C to exit."
      [SGR] -> IO ()
ANSI.setSGR [SGR
Reset]
      FilePath -> IO ()
IO.putStrLn FilePath
""
      IO Any -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Any -> IO ()) -> (IO () -> IO Any) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
IO.threadDelay Int
10000000
    else do
      [SGR] -> IO ()
ANSI.setSGR [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red]
      FilePath -> IO ()
IO.putStr FilePath
"Failed to start testnet."
      [SGR] -> IO ()
ANSI.setSGR [SGR
Reset]
      FilePath -> IO ()
IO.putStrLn FilePath
""
      IO ()
forall a. IO a
IO.exitFailure