{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Ouroboros.Network.TxSubmission.Types
  ( Tx (..)
  , TxId
  , Mempool
  , emptyMempool
  , newMempool
  , readMempool
  , getMempoolReader
  , getMempoolWriter
  , maxTxSize
  , LargeNonEmptyList (..)
  , SimResults (..)
  , WithThreadAndTime (..)
  , txSubmissionCodec2
  , evaluateTrace
  , verboseTracer
  , debugTracer
  ) where

import Prelude hiding (seq)

import NoThunks.Class

import Control.Concurrent.Class.MonadSTM
import Control.Exception (SomeException (..))
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadFork
import Control.Monad.Class.MonadSay
import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Monad.IOSim hiding (SimResult)
import Control.Tracer (Tracer (..), showTracing, traceWith)

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR

import Data.ByteString.Lazy (ByteString)
import GHC.Generics (Generic)

import Network.TypedProtocol.Codec

import Ouroboros.Network.Protocol.TxSubmission2.Codec
import Ouroboros.Network.Protocol.TxSubmission2.Type
import Ouroboros.Network.TxSubmission.Inbound.V1
import Ouroboros.Network.TxSubmission.Mempool.Reader
import Ouroboros.Network.TxSubmission.Mempool.Simple (Mempool)
import Ouroboros.Network.TxSubmission.Mempool.Simple qualified as Mempool
import Ouroboros.Network.Util.ShowProxy

import Test.QuickCheck
import Text.Printf


data Tx txid = Tx {
    forall txid. Tx txid -> txid
getTxId      :: !txid,
    forall txid. Tx txid -> SizeInBytes
getTxSize    :: !SizeInBytes,
    forall txid. Tx txid -> SizeInBytes
getTxAdvSize :: !SizeInBytes,
    -- | If false this means that when this tx will be submitted to a remote
    -- mempool it will not be valid.  The outbound mempool might contain
    -- invalid tx's in this sense.
    forall txid. Tx txid -> Bool
getTxValid   :: !Bool
  }
  deriving (Tx txid -> Tx txid -> Bool
(Tx txid -> Tx txid -> Bool)
-> (Tx txid -> Tx txid -> Bool) -> Eq (Tx txid)
forall txid. Eq txid => Tx txid -> Tx txid -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall txid. Eq txid => Tx txid -> Tx txid -> Bool
== :: Tx txid -> Tx txid -> Bool
$c/= :: forall txid. Eq txid => Tx txid -> Tx txid -> Bool
/= :: Tx txid -> Tx txid -> Bool
Eq, Eq (Tx txid)
Eq (Tx txid) =>
(Tx txid -> Tx txid -> Ordering)
-> (Tx txid -> Tx txid -> Bool)
-> (Tx txid -> Tx txid -> Bool)
-> (Tx txid -> Tx txid -> Bool)
-> (Tx txid -> Tx txid -> Bool)
-> (Tx txid -> Tx txid -> Tx txid)
-> (Tx txid -> Tx txid -> Tx txid)
-> Ord (Tx txid)
Tx txid -> Tx txid -> Bool
Tx txid -> Tx txid -> Ordering
Tx txid -> Tx txid -> Tx txid
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall txid. Ord txid => Eq (Tx txid)
forall txid. Ord txid => Tx txid -> Tx txid -> Bool
forall txid. Ord txid => Tx txid -> Tx txid -> Ordering
forall txid. Ord txid => Tx txid -> Tx txid -> Tx txid
$ccompare :: forall txid. Ord txid => Tx txid -> Tx txid -> Ordering
compare :: Tx txid -> Tx txid -> Ordering
$c< :: forall txid. Ord txid => Tx txid -> Tx txid -> Bool
< :: Tx txid -> Tx txid -> Bool
$c<= :: forall txid. Ord txid => Tx txid -> Tx txid -> Bool
<= :: Tx txid -> Tx txid -> Bool
$c> :: forall txid. Ord txid => Tx txid -> Tx txid -> Bool
> :: Tx txid -> Tx txid -> Bool
$c>= :: forall txid. Ord txid => Tx txid -> Tx txid -> Bool
>= :: Tx txid -> Tx txid -> Bool
$cmax :: forall txid. Ord txid => Tx txid -> Tx txid -> Tx txid
max :: Tx txid -> Tx txid -> Tx txid
$cmin :: forall txid. Ord txid => Tx txid -> Tx txid -> Tx txid
min :: Tx txid -> Tx txid -> Tx txid
Ord, Int -> Tx txid -> ShowS
[Tx txid] -> ShowS
Tx txid -> String
(Int -> Tx txid -> ShowS)
-> (Tx txid -> String) -> ([Tx txid] -> ShowS) -> Show (Tx txid)
forall txid. Show txid => Int -> Tx txid -> ShowS
forall txid. Show txid => [Tx txid] -> ShowS
forall txid. Show txid => Tx txid -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall txid. Show txid => Int -> Tx txid -> ShowS
showsPrec :: Int -> Tx txid -> ShowS
$cshow :: forall txid. Show txid => Tx txid -> String
show :: Tx txid -> String
$cshowList :: forall txid. Show txid => [Tx txid] -> ShowS
showList :: [Tx txid] -> ShowS
Show, (forall x. Tx txid -> Rep (Tx txid) x)
-> (forall x. Rep (Tx txid) x -> Tx txid) -> Generic (Tx txid)
forall x. Rep (Tx txid) x -> Tx txid
forall x. Tx txid -> Rep (Tx txid) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall txid x. Rep (Tx txid) x -> Tx txid
forall txid x. Tx txid -> Rep (Tx txid) x
$cfrom :: forall txid x. Tx txid -> Rep (Tx txid) x
from :: forall x. Tx txid -> Rep (Tx txid) x
$cto :: forall txid x. Rep (Tx txid) x -> Tx txid
to :: forall x. Rep (Tx txid) x -> Tx txid
Generic)

instance NoThunks txid => NoThunks (Tx txid)
instance ShowProxy txid => ShowProxy (Tx txid) where
    showProxy :: Proxy (Tx txid) -> String
showProxy Proxy (Tx txid)
_ = String
"Tx " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy txid -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy txid
forall {k} (t :: k). Proxy t
Proxy :: Proxy txid)

instance Arbitrary txid => Arbitrary (Tx txid) where
    arbitrary :: Gen (Tx txid)
arbitrary = do
      -- note:
      -- generating small tx sizes avoids overflow error when semigroup
      -- instance of `SizeInBytes` is used (summing up all inflight tx
      -- sizes).
      (size, advSize) <- [(Int, Gen (SizeInBytes, SizeInBytes))]
-> Gen (SizeInBytes, SizeInBytes)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [ (Int
99, (\SizeInBytes
a -> (SizeInBytes
a,SizeInBytes
a)) (SizeInBytes -> (SizeInBytes, SizeInBytes))
-> Gen SizeInBytes -> Gen (SizeInBytes, SizeInBytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SizeInBytes, SizeInBytes) -> Gen SizeInBytes
forall a. Enum a => (a, a) -> Gen a
chooseEnum (SizeInBytes
0, SizeInBytes
maxTxSize))
                                   , (Int
1, (,) (SizeInBytes -> SizeInBytes -> (SizeInBytes, SizeInBytes))
-> Gen SizeInBytes
-> Gen (SizeInBytes -> (SizeInBytes, SizeInBytes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SizeInBytes, SizeInBytes) -> Gen SizeInBytes
forall a. Enum a => (a, a) -> Gen a
chooseEnum (SizeInBytes
0, SizeInBytes
maxTxSize) Gen (SizeInBytes -> (SizeInBytes, SizeInBytes))
-> Gen SizeInBytes -> Gen (SizeInBytes, SizeInBytes)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SizeInBytes, SizeInBytes) -> Gen SizeInBytes
forall a. Enum a => (a, a) -> Gen a
chooseEnum (SizeInBytes
0, SizeInBytes
maxTxSize))
                                   ]
      Tx <$> arbitrary
         <*> pure size
         <*> pure advSize
         <*> frequency [ (3, pure True)
                       , (1, pure False)
                       ]

-- maximal tx size
maxTxSize :: SizeInBytes
maxTxSize :: SizeInBytes
maxTxSize = SizeInBytes
65536

type TxId = Int

emptyMempool :: MonadSTM m => m (Mempool m (Tx txid))
emptyMempool :: forall (m :: * -> *) txid. MonadSTM m => m (Mempool m (Tx txid))
emptyMempool = m (Mempool m (Tx txid))
forall (m :: * -> *) tx. MonadSTM m => m (Mempool m tx)
Mempool.empty

newMempool :: MonadSTM m => [Tx txid] -> m (Mempool m (Tx txid))
newMempool :: forall (m :: * -> *) txid.
MonadSTM m =>
[Tx txid] -> m (Mempool m (Tx txid))
newMempool   = [Tx txid] -> m (Mempool m (Tx txid))
forall (m :: * -> *) tx. MonadSTM m => [tx] -> m (Mempool m tx)
Mempool.new

readMempool :: MonadSTM m => Mempool m (Tx txid) -> m [Tx txid]
readMempool :: forall (m :: * -> *) txid.
MonadSTM m =>
Mempool m (Tx txid) -> m [Tx txid]
readMempool  = Mempool m (Tx txid) -> m [Tx txid]
forall (m :: * -> *) tx. MonadSTM m => Mempool m tx -> m [tx]
Mempool.read

getMempoolReader :: forall txid m.
                    ( MonadSTM m
                    , Eq txid
                    , Show txid
                    )
                 => Mempool m (Tx txid)
                 -> TxSubmissionMempoolReader txid (Tx txid) Int m
getMempoolReader :: forall txid (m :: * -> *).
(MonadSTM m, Eq txid, Show txid) =>
Mempool m (Tx txid)
-> TxSubmissionMempoolReader txid (Tx txid) Int m
getMempoolReader = (Tx txid -> txid)
-> (Tx txid -> SizeInBytes)
-> Mempool m (Tx txid)
-> TxSubmissionMempoolReader txid (Tx txid) Int m
forall tx txid (m :: * -> *).
(MonadSTM m, Eq txid) =>
(tx -> txid)
-> (tx -> SizeInBytes)
-> Mempool m tx
-> TxSubmissionMempoolReader txid tx Int m
Mempool.getReader Tx txid -> txid
forall txid. Tx txid -> txid
getTxId Tx txid -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize


getMempoolWriter :: forall txid m.
                    ( MonadSTM m
                    , Ord txid
                    , Eq txid
                    )
                 => Mempool m (Tx txid)
                 -> TxSubmissionMempoolWriter txid (Tx txid) Int m
getMempoolWriter :: forall txid (m :: * -> *).
(MonadSTM m, Ord txid, Eq txid) =>
Mempool m (Tx txid)
-> TxSubmissionMempoolWriter txid (Tx txid) Int m
getMempoolWriter = (Tx txid -> txid)
-> (Tx txid -> Bool)
-> Mempool m (Tx txid)
-> TxSubmissionMempoolWriter txid (Tx txid) Int m
forall tx txid (m :: * -> *).
(MonadSTM m, Ord txid) =>
(tx -> txid)
-> (tx -> Bool)
-> Mempool m tx
-> TxSubmissionMempoolWriter txid tx Int m
Mempool.getWriter Tx txid -> txid
forall txid. Tx txid -> txid
getTxId Tx txid -> Bool
forall txid. Tx txid -> Bool
getTxValid


txSubmissionCodec2 :: MonadST m
                   => Codec (TxSubmission2 Int (Tx Int))
                            CBOR.DeserialiseFailure m ByteString
txSubmissionCodec2 :: forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 Int (Tx Int)) DeserialiseFailure m ByteString
txSubmissionCodec2 =
    (Int -> Encoding)
-> (forall s. Decoder s Int)
-> (Tx Int -> Encoding)
-> (forall s. Decoder s (Tx Int))
-> Codec
     (TxSubmission2 Int (Tx Int)) DeserialiseFailure m ByteString
forall txid tx (m :: * -> *).
MonadST m =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> Codec (TxSubmission2 txid tx) DeserialiseFailure m ByteString
codecTxSubmission2 Int -> Encoding
CBOR.encodeInt Decoder s Int
forall s. Decoder s Int
CBOR.decodeInt
                       Tx Int -> Encoding
encodeTx Decoder s (Tx Int)
forall s. Decoder s (Tx Int)
decodeTx
  where
    encodeTx :: Tx Int -> Encoding
encodeTx Tx {Int
getTxId :: forall txid. Tx txid -> txid
getTxId :: Int
getTxId, SizeInBytes
getTxSize :: forall txid. Tx txid -> SizeInBytes
getTxSize :: SizeInBytes
getTxSize, SizeInBytes
getTxAdvSize :: forall txid. Tx txid -> SizeInBytes
getTxAdvSize :: SizeInBytes
getTxAdvSize, Bool
getTxValid :: forall txid. Tx txid -> Bool
getTxValid :: Bool
getTxValid} =
         Word -> Encoding
CBOR.encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt Int
getTxId
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 (SizeInBytes -> Word32
getSizeInBytes SizeInBytes
getTxSize)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 (SizeInBytes -> Word32
getSizeInBytes SizeInBytes
getTxAdvSize)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool Bool
getTxValid

    decodeTx :: Decoder s (Tx Int)
decodeTx = do
      _ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
      Tx <$> CBOR.decodeInt
         <*> (SizeInBytes <$> CBOR.decodeWord32)
         <*> (SizeInBytes <$> CBOR.decodeWord32)
         <*> CBOR.decodeBool


newtype LargeNonEmptyList a = LargeNonEmpty { forall a. LargeNonEmptyList a -> [a]
getLargeNonEmpty :: [a] }
  deriving Int -> LargeNonEmptyList a -> ShowS
[LargeNonEmptyList a] -> ShowS
LargeNonEmptyList a -> String
(Int -> LargeNonEmptyList a -> ShowS)
-> (LargeNonEmptyList a -> String)
-> ([LargeNonEmptyList a] -> ShowS)
-> Show (LargeNonEmptyList a)
forall a. Show a => Int -> LargeNonEmptyList a -> ShowS
forall a. Show a => [LargeNonEmptyList a] -> ShowS
forall a. Show a => LargeNonEmptyList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> LargeNonEmptyList a -> ShowS
showsPrec :: Int -> LargeNonEmptyList a -> ShowS
$cshow :: forall a. Show a => LargeNonEmptyList a -> String
show :: LargeNonEmptyList a -> String
$cshowList :: forall a. Show a => [LargeNonEmptyList a] -> ShowS
showList :: [LargeNonEmptyList a] -> ShowS
Show

instance Arbitrary a => Arbitrary (LargeNonEmptyList a) where
    arbitrary :: Gen (LargeNonEmptyList a)
arbitrary =
      [a] -> LargeNonEmptyList a
forall a. [a] -> LargeNonEmptyList a
LargeNonEmpty ([a] -> LargeNonEmptyList a)
-> Gen [a] -> Gen (LargeNonEmptyList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a] -> ([a] -> Bool) -> Gen [a]
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat (Int -> Gen [a] -> Gen [a]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
500 (Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
listOf Gen a
forall a. Arbitrary a => Gen a
arbitrary)) ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
25) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)


-- TODO: Belongs in iosim.
data SimResults a = SimReturn a [String]
                  | SimException SomeException [String]
                  | SimDeadLock [String]

-- Traverses a list of trace events and returns the result along with all log messages.
-- Incase of a pure exception, ie an assert, all tracers evaluated so far are returned.
evaluateTrace :: SimTrace a -> IO (SimResults a)
evaluateTrace :: forall a. SimTrace a -> IO (SimResults a)
evaluateTrace = Context -> SimTrace a -> IO (SimResults a)
forall {m :: * -> *} {a}.
(MonadCatch m, MonadEvaluate m) =>
Context -> SimTrace a -> m (SimResults a)
go []
  where
    go :: Context -> SimTrace a -> m (SimResults a)
go Context
as SimTrace a
tr = do
      r <- m (SimTrace a) -> m (Either SomeException (SimTrace a))
forall e a. Exception e => m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (SimTrace a -> m (SimTrace a)
forall a. a -> m a
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate SimTrace a
tr)
      case r of
        Right (SimTrace Time
_ IOSimThreadId
_ Maybe String
_ (EventSay String
s) SimTrace a
tr')      -> Context -> SimTrace a -> m (SimResults a)
go (String
s String -> Context -> Context
forall a. a -> [a] -> [a]
: Context
as) SimTrace a
tr'
        Right (SimTrace Time
_ IOSimThreadId
_ Maybe String
_ SimEventType
_ SimTrace a
tr' )                -> Context -> SimTrace a -> m (SimResults a)
go Context
as SimTrace a
tr'
        Right (SimPORTrace Time
_ IOSimThreadId
_ Int
_ Maybe String
_ (EventSay String
s) SimTrace a
tr') -> Context -> SimTrace a -> m (SimResults a)
go (String
s String -> Context -> Context
forall a. a -> [a] -> [a]
: Context
as) SimTrace a
tr'
        Right (SimPORTrace Time
_ IOSimThreadId
_ Int
_ Maybe String
_ SimEventType
_ SimTrace a
tr' )           -> Context -> SimTrace a -> m (SimResults a)
go Context
as SimTrace a
tr'
        Right (TraceMainReturn Time
_ Labelled IOSimThreadId
_ a
a [Labelled IOSimThreadId]
_)              -> SimResults a -> m (SimResults a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimResults a -> m (SimResults a))
-> SimResults a -> m (SimResults a)
forall a b. (a -> b) -> a -> b
$ a -> Context -> SimResults a
forall a. a -> Context -> SimResults a
SimReturn a
a (Context -> Context
forall a. [a] -> [a]
reverse Context
as)
        Right (TraceMainException Time
_ Labelled IOSimThreadId
_ SomeException
e [Labelled IOSimThreadId]
_)           -> SimResults a -> m (SimResults a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimResults a -> m (SimResults a))
-> SimResults a -> m (SimResults a)
forall a b. (a -> b) -> a -> b
$ SomeException -> Context -> SimResults a
forall a. SomeException -> Context -> SimResults a
SimException SomeException
e (Context -> Context
forall a. [a] -> [a]
reverse Context
as)
        Right (TraceDeadlock Time
_ [Labelled IOSimThreadId]
_)                    -> SimResults a -> m (SimResults a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimResults a -> m (SimResults a))
-> SimResults a -> m (SimResults a)
forall a b. (a -> b) -> a -> b
$ Context -> SimResults a
forall a. Context -> SimResults a
SimDeadLock (Context -> Context
forall a. [a] -> [a]
reverse Context
as)
        Right SimTrace a
TraceLoop                              -> String -> m (SimResults a)
forall a. HasCallStack => String -> a
error String
"IOSimPOR step time limit exceeded"
        Right (TraceInternalError String
e)                 -> String -> m (SimResults a)
forall a. HasCallStack => String -> a
error (String
"IOSim: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)
        Left  (SomeException e
e)                      -> SimResults a -> m (SimResults a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimResults a -> m (SimResults a))
-> SimResults a -> m (SimResults a)
forall a b. (a -> b) -> a -> b
$ SomeException -> Context -> SimResults a
forall a. SomeException -> Context -> SimResults a
SimException (e -> SomeException
forall e. (Exception e, HasExceptionContext) => e -> SomeException
SomeException e
e) (Context -> Context
forall a. [a] -> [a]
reverse Context
as)


data WithThreadAndTime a = WithThreadAndTime {
      forall a. WithThreadAndTime a -> Time
wtatOccuredAt    :: !Time
    , forall a. WithThreadAndTime a -> String
wtatWithinThread :: !String
    , forall a. WithThreadAndTime a -> a
wtatEvent        :: !a
    }

instance (Show a) => Show (WithThreadAndTime a) where
    show :: WithThreadAndTime a -> String
show WithThreadAndTime {Time
wtatOccuredAt :: forall a. WithThreadAndTime a -> Time
wtatOccuredAt :: Time
wtatOccuredAt, String
wtatWithinThread :: forall a. WithThreadAndTime a -> String
wtatWithinThread :: String
wtatWithinThread, a
wtatEvent :: forall a. WithThreadAndTime a -> a
wtatEvent :: a
wtatEvent} =
        String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s: %s: %s" (Time -> String
forall a. Show a => a -> String
show Time
wtatOccuredAt) (ShowS
forall a. Show a => a -> String
show String
wtatWithinThread) (a -> String
forall a. Show a => a -> String
show a
wtatEvent)

verboseTracer :: forall a m.
                       ( MonadAsync m
                       , MonadDelay m
                       , MonadSay m
                       , MonadMonotonicTime m
                       , Show a
                       )
               => Tracer m a
verboseTracer :: forall a (m :: * -> *).
(MonadAsync m, MonadDelay m, MonadSay m, MonadMonotonicTime m,
 Show a) =>
Tracer m a
verboseTracer = Tracer m (WithThreadAndTime a) -> Tracer m a
forall a (m :: * -> *).
(MonadAsync m, MonadDelay m, MonadMonotonicTime m) =>
Tracer m (WithThreadAndTime a) -> Tracer m a
threadAndTimeTracer (Tracer m (WithThreadAndTime a) -> Tracer m a)
-> Tracer m (WithThreadAndTime a) -> Tracer m a
forall a b. (a -> b) -> a -> b
$ Tracer m String -> Tracer m (WithThreadAndTime a)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing (Tracer m String -> Tracer m (WithThreadAndTime a))
-> Tracer m String -> Tracer m (WithThreadAndTime a)
forall a b. (a -> b) -> a -> b
$ (String -> m ()) -> Tracer m String
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer String -> m ()
forall (m :: * -> *). MonadSay m => String -> m ()
say

debugTracer :: forall a s. Show a => Tracer (IOSim s) a
debugTracer :: forall a s. Show a => Tracer (IOSim s) a
debugTracer = Tracer (IOSim s) (WithThreadAndTime a) -> Tracer (IOSim s) a
forall a (m :: * -> *).
(MonadAsync m, MonadDelay m, MonadMonotonicTime m) =>
Tracer m (WithThreadAndTime a) -> Tracer m a
threadAndTimeTracer (Tracer (IOSim s) (WithThreadAndTime a) -> Tracer (IOSim s) a)
-> Tracer (IOSim s) (WithThreadAndTime a) -> Tracer (IOSim s) a
forall a b. (a -> b) -> a -> b
$ Tracer (IOSim s) String -> Tracer (IOSim s) (WithThreadAndTime a)
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing (Tracer (IOSim s) String -> Tracer (IOSim s) (WithThreadAndTime a))
-> Tracer (IOSim s) String
-> Tracer (IOSim s) (WithThreadAndTime a)
forall a b. (a -> b) -> a -> b
$ (String -> IOSim s ()) -> Tracer (IOSim s) String
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (String -> IOSim s ()
forall a s. Typeable a => a -> IOSim s ()
traceM (String -> IOSim s ()) -> ShowS -> String -> IOSim s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show)

threadAndTimeTracer :: forall a m.
                       ( MonadAsync m
                       , MonadDelay m
                       , MonadMonotonicTime m
                       )
                    => Tracer m (WithThreadAndTime a) -> Tracer m a
threadAndTimeTracer :: forall a (m :: * -> *).
(MonadAsync m, MonadDelay m, MonadMonotonicTime m) =>
Tracer m (WithThreadAndTime a) -> Tracer m a
threadAndTimeTracer Tracer m (WithThreadAndTime a)
tr = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((a -> m ()) -> Tracer m a) -> (a -> m ()) -> Tracer m a
forall a b. (a -> b) -> a -> b
$ \a
s -> do
    !now <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
    !tid <- myThreadId
    traceWith tr $ WithThreadAndTime now (show tid) s