{-# LANGUAGE DeriveFunctor             #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE DerivingVia               #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE NamedFieldPuns            #-}
{-# LANGUAGE PatternSynonyms           #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE ViewPatterns              #-}

-- TODO: needed with GHC-8.10
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Network.Mux.Trace
  ( -- * Exceptions
    Error (..)
  , handleIOException
    -- * Trace events
  , Trace (..)
  , ChannelTrace (..)
  , BearerTrace (..)
    -- * Tracers
  , Tracers' (.., TracersI, tracer_, channelTracer_, bearerTracer_)
  , contramapTracers'
  , Tracers
  , nullTracers
  , tracersWith
  , TracersWithBearer
  , tracersWithBearer
    -- * Tracing wrappers
  , WithBearer (..)
  , TraceLabelPeer (..)
    -- * State
  , State (..)
  ) where

import Prelude hiding (read)

import Text.Printf

import Control.Exception hiding (throwIO)
import Control.Monad.Class.MonadThrow
import Control.Tracer (Tracer, nullTracer)
import Data.Bifunctor (Bifunctor (..))
import Data.Functor.Contravariant (contramap, (>$<))
import Data.Functor.Identity
import GHC.Generics (Generic (..))
import Quiet (Quiet (..))

import Network.Mux.Types


--
-- Errors
--

-- | Enumeration of error conditions.
--
data Error = UnknownMiniProtocol MiniProtocolNum
           -- ^ returned by 'decodeSDUHeader', thrown by 'Bearer'.
           | BearerClosed String
           -- ^ thrown by 'Bearer' when received a null byte.
           | IngressQueueOverRun MiniProtocolNum MiniProtocolDir
           -- ^ thrown by 'demux' when violating 'maximumIngressQueue'
           -- byte limit.
           | InitiatorOnly MiniProtocolNum
           -- ^ thrown when data arrives on a responder channel when the
           -- mux was set up as an 'InitiatorApp'.
           | IOException IOException String
           -- ^ 'IOException' thrown by

           | SDUDecodeError String
           -- ^ return by 'decodeSDUHeader', thrown by 'Bearer'.
           | SDUReadTimeout
           -- ^ thrown when reading of a single SDU takes too long
           | SDUWriteTimeout
           -- ^ thrown when writing a single SDU takes too long

           | Shutdown (Maybe SomeException) Status
           -- ^ Result of runMiniProtocol's completionAction in case of
           -- an error or mux being closed while a mini-protocol was
           -- still running, this is not a clean exit.
           deriving Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show

instance Exception Error where
  displayException :: Error -> String
displayException = \case
    UnknownMiniProtocol MiniProtocolNum
pnum      -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"unknown mini-protocol %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
pnum)
    BearerClosed String
msg              -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"bearer closed: %s" (ShowS
forall a. Show a => a -> String
show String
msg)
    IngressQueueOverRun MiniProtocolNum
pnum MiniProtocolDir
pdir -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"ingress queue overrun for %s %s " (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
pnum) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
pdir)
    InitiatorOnly MiniProtocolNum
pnum            -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"received data on initiator only protocol %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
pnum)
    IOException IOException
e String
msg             -> IOException -> String
forall e. Exception e => e -> String
displayException IOException
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
    SDUDecodeError String
msg            -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"SDU decode error: %s" String
msg
    Error
SDUReadTimeout                -> String
"SDU read timeout expired"
    Error
SDUWriteTimeout               -> String
"SDU write timeout expired"
    Shutdown Maybe SomeException
Nothing Status
st           -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"mux shutdown error in state %s" (Status -> String
forall a. Show a => a -> String
show Status
st)
    Shutdown (Just SomeException
e) Status
st          -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"mux shutdown error (%s) in state %s " (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e) (Status -> String
forall a. Show a => a -> String
show Status
st)

-- | Handler for 'IOException's which wraps them in 'Error'.
--
-- It is used various 'Bearer' implementations:
-- * 'socketAsBearer'
-- * 'pipeAsBearer'
--
handleIOException :: MonadThrow m => String -> IOException -> m a
handleIOException :: forall (m :: * -> *) a.
MonadThrow m =>
String -> IOException -> m a
handleIOException String
msg IOException
e = Error -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOException -> String -> Error
IOException IOException
e String
msg)


--
-- Tracing
--

-- | A peer label for use in 'Tracer's. This annotates tracer output as being
-- associated with a given peer identifier.
--
data TraceLabelPeer peerid a = TraceLabelPeer peerid a
  deriving (TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool
(TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool)
-> (TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool)
-> Eq (TraceLabelPeer peerid a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall peerid a.
(Eq peerid, Eq a) =>
TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool
$c== :: forall peerid a.
(Eq peerid, Eq a) =>
TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool
== :: TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool
$c/= :: forall peerid a.
(Eq peerid, Eq a) =>
TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool
/= :: TraceLabelPeer peerid a -> TraceLabelPeer peerid a -> Bool
Eq, (forall a b.
 (a -> b) -> TraceLabelPeer peerid a -> TraceLabelPeer peerid b)
-> (forall a b.
    a -> TraceLabelPeer peerid b -> TraceLabelPeer peerid a)
-> Functor (TraceLabelPeer peerid)
forall a b. a -> TraceLabelPeer peerid b -> TraceLabelPeer peerid a
forall a b.
(a -> b) -> TraceLabelPeer peerid a -> TraceLabelPeer peerid b
forall peerid a b.
a -> TraceLabelPeer peerid b -> TraceLabelPeer peerid a
forall peerid a b.
(a -> b) -> TraceLabelPeer peerid a -> TraceLabelPeer peerid b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall peerid a b.
(a -> b) -> TraceLabelPeer peerid a -> TraceLabelPeer peerid b
fmap :: forall a b.
(a -> b) -> TraceLabelPeer peerid a -> TraceLabelPeer peerid b
$c<$ :: forall peerid a b.
a -> TraceLabelPeer peerid b -> TraceLabelPeer peerid a
<$ :: forall a b. a -> TraceLabelPeer peerid b -> TraceLabelPeer peerid a
Functor, Int -> TraceLabelPeer peerid a -> ShowS
[TraceLabelPeer peerid a] -> ShowS
TraceLabelPeer peerid a -> String
(Int -> TraceLabelPeer peerid a -> ShowS)
-> (TraceLabelPeer peerid a -> String)
-> ([TraceLabelPeer peerid a] -> ShowS)
-> Show (TraceLabelPeer peerid a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peerid a.
(Show peerid, Show a) =>
Int -> TraceLabelPeer peerid a -> ShowS
forall peerid a.
(Show peerid, Show a) =>
[TraceLabelPeer peerid a] -> ShowS
forall peerid a.
(Show peerid, Show a) =>
TraceLabelPeer peerid a -> String
$cshowsPrec :: forall peerid a.
(Show peerid, Show a) =>
Int -> TraceLabelPeer peerid a -> ShowS
showsPrec :: Int -> TraceLabelPeer peerid a -> ShowS
$cshow :: forall peerid a.
(Show peerid, Show a) =>
TraceLabelPeer peerid a -> String
show :: TraceLabelPeer peerid a -> String
$cshowList :: forall peerid a.
(Show peerid, Show a) =>
[TraceLabelPeer peerid a] -> ShowS
showList :: [TraceLabelPeer peerid a] -> ShowS
Show)

instance Bifunctor TraceLabelPeer where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> TraceLabelPeer a c -> TraceLabelPeer b d
bimap a -> b
f c -> d
g (TraceLabelPeer a
a c
b) = b -> d -> TraceLabelPeer b d
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer (a -> b
f a
a) (c -> d
g c
b)

-- | Type used for tracing mux events.
--
data WithBearer peerid a = WithBearer {
      forall peerid a. WithBearer peerid a -> peerid
wbPeerId :: !peerid
      -- ^ A tag that should identify a specific mux bearer.
    , forall peerid a. WithBearer peerid a -> a
wbEvent  :: !a
  }
  deriving ((forall x. WithBearer peerid a -> Rep (WithBearer peerid a) x)
-> (forall x. Rep (WithBearer peerid a) x -> WithBearer peerid a)
-> Generic (WithBearer peerid a)
forall x. Rep (WithBearer peerid a) x -> WithBearer peerid a
forall x. WithBearer peerid a -> Rep (WithBearer peerid a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall peerid a x.
Rep (WithBearer peerid a) x -> WithBearer peerid a
forall peerid a x.
WithBearer peerid a -> Rep (WithBearer peerid a) x
$cfrom :: forall peerid a x.
WithBearer peerid a -> Rep (WithBearer peerid a) x
from :: forall x. WithBearer peerid a -> Rep (WithBearer peerid a) x
$cto :: forall peerid a x.
Rep (WithBearer peerid a) x -> WithBearer peerid a
to :: forall x. Rep (WithBearer peerid a) x -> WithBearer peerid a
Generic)
  deriving Int -> WithBearer peerid a -> ShowS
[WithBearer peerid a] -> ShowS
WithBearer peerid a -> String
(Int -> WithBearer peerid a -> ShowS)
-> (WithBearer peerid a -> String)
-> ([WithBearer peerid a] -> ShowS)
-> Show (WithBearer peerid a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peerid a.
(Show peerid, Show a) =>
Int -> WithBearer peerid a -> ShowS
forall peerid a.
(Show peerid, Show a) =>
[WithBearer peerid a] -> ShowS
forall peerid a.
(Show peerid, Show a) =>
WithBearer peerid a -> String
$cshowsPrec :: forall peerid a.
(Show peerid, Show a) =>
Int -> WithBearer peerid a -> ShowS
showsPrec :: Int -> WithBearer peerid a -> ShowS
$cshow :: forall peerid a.
(Show peerid, Show a) =>
WithBearer peerid a -> String
show :: WithBearer peerid a -> String
$cshowList :: forall peerid a.
(Show peerid, Show a) =>
[WithBearer peerid a] -> ShowS
showList :: [WithBearer peerid a] -> ShowS
Show via (Quiet (WithBearer peerid a))
--TODO: probably remove this type


-- | Mid-level channel events traced independently by each mini protocol job.
--
data ChannelTrace =
      TraceChannelRecvStart MiniProtocolNum
    | TraceChannelRecvEnd MiniProtocolNum Int
    | TraceChannelSendStart MiniProtocolNum Int
    | TraceChannelSendEnd MiniProtocolNum

instance Show ChannelTrace where
    show :: ChannelTrace -> String
show (TraceChannelRecvStart MiniProtocolNum
mid) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Channel Receive Start on %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid)
    show (TraceChannelRecvEnd MiniProtocolNum
mid Int
len) = String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Channel Receive End on (%s) %d" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid)
        Int
len
    show (TraceChannelSendStart MiniProtocolNum
mid Int
len) = String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Channel Send Start on (%s) %d" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid)
        Int
len
    show (TraceChannelSendEnd MiniProtocolNum
mid) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Channel Send End on %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid)


data State = Mature
             -- ^ `Mux started ingress, and egress threads
           | Dead
             -- ^ Mux is being shutdown.
           deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State -> State -> Bool
== :: State -> State -> Bool
$c/= :: State -> State -> Bool
/= :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> State -> ShowS
showsPrec :: Int -> State -> ShowS
$cshow :: State -> String
show :: State -> String
$cshowList :: [State] -> ShowS
showList :: [State] -> ShowS
Show)

-- | High-level mux events.
--
data Trace =
      TraceState State
    | TraceCleanExit MiniProtocolNum MiniProtocolDir
    | TraceExceptionExit MiniProtocolNum MiniProtocolDir SomeException
    | TraceStartEagerly MiniProtocolNum MiniProtocolDir
    | TraceStartOnDemand MiniProtocolNum MiniProtocolDir
    | TraceStartOnDemandAny MiniProtocolNum MiniProtocolDir
    | TraceStartedOnDemand MiniProtocolNum MiniProtocolDir
    | TraceTerminating MiniProtocolNum MiniProtocolDir
    | forall mode. TraceNewMux [MiniProtocolInfo mode]
    | TraceStarting
    | TraceStopping
    | TraceStopped

instance Show Trace where
    show :: Trace -> String
show (TraceState State
new) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"State: %s" (State -> String
forall a. Show a => a -> String
show State
new)
    show (TraceCleanExit MiniProtocolNum
mid MiniProtocolDir
dir) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Miniprotocol (%s) %s terminated cleanly" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
dir)
    show (TraceExceptionExit MiniProtocolNum
mid MiniProtocolDir
dir SomeException
e) = String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Miniprotocol %s %s terminated with exception %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
dir) (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
    show (TraceStartEagerly MiniProtocolNum
mid MiniProtocolDir
dir) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Eagerly started (%s) in %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
dir)
    show (TraceStartOnDemand MiniProtocolNum
mid MiniProtocolDir
dir) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Preparing to start (%s) in %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
dir)
    show (TraceStartOnDemandAny MiniProtocolNum
mid MiniProtocolDir
dir) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Preparing to start on any (%s) in %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
dir)
    show (TraceStartedOnDemand MiniProtocolNum
mid MiniProtocolDir
dir) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Started on demand (%s) in %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
dir)
    show (TraceTerminating MiniProtocolNum
mid MiniProtocolDir
dir) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Terminating (%s) in %s" (MiniProtocolNum -> String
forall a. Show a => a -> String
show MiniProtocolNum
mid) (MiniProtocolDir -> String
forall a. Show a => a -> String
show MiniProtocolDir
dir)
    show (TraceNewMux [MiniProtocolInfo mode]
infos) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"New mux with protocols: %s" ([MiniProtocolInfo mode] -> String
forall a. Show a => a -> String
show [MiniProtocolInfo mode]
infos)
    show Trace
TraceStarting = String
"Mux starting"
    show Trace
TraceStopping = String
"Mux stopping"
    show Trace
TraceStopped  = String
"Mux stoppped"


-- | Bundle of tracers used directly by mux.
--
data Tracers' m f = Tracers {
    forall (m :: * -> *) (f :: * -> *).
Tracers' m f -> Tracer m (f Trace)
tracer        :: Tracer m (f Trace),
    -- ^ high-level tracer of mux state events

    forall (m :: * -> *) (f :: * -> *).
Tracers' m f -> Tracer m (f ChannelTrace)
channelTracer :: Tracer m (f ChannelTrace),
    -- ^ channel tracer

    forall (m :: * -> *) (f :: * -> *).
Tracers' m f -> Tracer m (f BearerTrace)
bearerTracer  :: Tracer m (f BearerTrace)
    -- ^ high-frequency tracer
  }

type Tracers m = Tracers' m Identity


-- | Trace all events through one polymorphic tracer.
--
tracersWith :: (forall x. Tracer m x) -> Tracers' m f
tracersWith :: forall (m :: * -> *) (f :: * -> *).
(forall x. Tracer m x) -> Tracers' m f
tracersWith forall x. Tracer m x
tr = Tracers {
    tracer :: Tracer m (f Trace)
tracer        = Tracer m (f Trace)
forall x. Tracer m x
tr,
    channelTracer :: Tracer m (f ChannelTrace)
channelTracer = Tracer m (f ChannelTrace)
forall x. Tracer m x
tr,
    bearerTracer :: Tracer m (f BearerTrace)
bearerTracer  = Tracer m (f BearerTrace)
forall x. Tracer m x
tr
  }


nullTracers :: Applicative m => Tracers' m f
nullTracers :: forall (m :: * -> *) (f :: * -> *). Applicative m => Tracers' m f
nullTracers = (forall x. Tracer m x) -> Tracers' m f
forall (m :: * -> *) (f :: * -> *).
(forall x. Tracer m x) -> Tracers' m f
tracersWith Tracer m x
forall x. Tracer m x
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer


-- | A convenient bidirectional pattern synonym which (un)wraps the `Identity`
-- functor in the `Tracer` type.
--
pattern TracersI :: forall m.
                    Tracer m Trace
                 -> Tracer m ChannelTrace
                 -> Tracer m BearerTrace
                 -> Tracers m
pattern $bTracersI :: forall (m :: * -> *).
Tracer m Trace
-> Tracer m ChannelTrace -> Tracer m BearerTrace -> Tracers m
$mTracersI :: forall {r} {m :: * -> *}.
Tracers m
-> (Tracer m Trace
    -> Tracer m ChannelTrace -> Tracer m BearerTrace -> r)
-> ((# #) -> r)
-> r
TracersI { forall (m :: * -> *). Tracers m -> Tracer m Trace
tracer_, forall (m :: * -> *). Tracers m -> Tracer m ChannelTrace
channelTracer_, forall (m :: * -> *). Tracers m -> Tracer m BearerTrace
bearerTracer_ } <-
    Tracers { tracer        = contramap Identity -> tracer_,
              channelTracer = contramap Identity -> channelTracer_,
              bearerTracer  = contramap Identity -> bearerTracer_
            }
  where
    TracersI Tracer m Trace
tracer' Tracer m ChannelTrace
channelTracer' Tracer m BearerTrace
bearerTracer' =
      Tracers {
         tracer :: Tracer m (Identity Trace)
tracer        = Identity Trace -> Trace
forall a. Identity a -> a
runIdentity (Identity Trace -> Trace)
-> Tracer m Trace -> Tracer m (Identity Trace)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m Trace
tracer',
         channelTracer :: Tracer m (Identity ChannelTrace)
channelTracer = Identity ChannelTrace -> ChannelTrace
forall a. Identity a -> a
runIdentity (Identity ChannelTrace -> ChannelTrace)
-> Tracer m ChannelTrace -> Tracer m (Identity ChannelTrace)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m ChannelTrace
channelTracer',
         bearerTracer :: Tracer m (Identity BearerTrace)
bearerTracer  = Identity BearerTrace -> BearerTrace
forall a. Identity a -> a
runIdentity (Identity BearerTrace -> BearerTrace)
-> Tracer m BearerTrace -> Tracer m (Identity BearerTrace)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m BearerTrace
bearerTracer'
       }

{-# COMPLETE TracersI #-}

-- | Contravariant natural transformation of `Tracers' m`.
--
contramapTracers' :: (forall x. f' x -> f x)
                  -> Tracers' m f -> Tracers' m f'
contramapTracers' :: forall (f' :: * -> *) (f :: * -> *) (m :: * -> *).
(forall x. f' x -> f x) -> Tracers' m f -> Tracers' m f'
contramapTracers'
  forall x. f' x -> f x
f
  Tracers { Tracer m (f Trace)
tracer :: forall (m :: * -> *) (f :: * -> *).
Tracers' m f -> Tracer m (f Trace)
tracer :: Tracer m (f Trace)
tracer,
            Tracer m (f ChannelTrace)
channelTracer :: forall (m :: * -> *) (f :: * -> *).
Tracers' m f -> Tracer m (f ChannelTrace)
channelTracer :: Tracer m (f ChannelTrace)
channelTracer,
            Tracer m (f BearerTrace)
bearerTracer :: forall (m :: * -> *) (f :: * -> *).
Tracers' m f -> Tracer m (f BearerTrace)
bearerTracer :: Tracer m (f BearerTrace)
bearerTracer
          }
  =
  Tracers { tracer :: Tracer m (f' Trace)
tracer        = f' Trace -> f Trace
forall x. f' x -> f x
f (f' Trace -> f Trace) -> Tracer m (f Trace) -> Tracer m (f' Trace)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m (f Trace)
tracer,
            channelTracer :: Tracer m (f' ChannelTrace)
channelTracer = f' ChannelTrace -> f ChannelTrace
forall x. f' x -> f x
f (f' ChannelTrace -> f ChannelTrace)
-> Tracer m (f ChannelTrace) -> Tracer m (f' ChannelTrace)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m (f ChannelTrace)
channelTracer,
            bearerTracer :: Tracer m (f' BearerTrace)
bearerTracer  = f' BearerTrace -> f BearerTrace
forall x. f' x -> f x
f (f' BearerTrace -> f BearerTrace)
-> Tracer m (f BearerTrace) -> Tracer m (f' BearerTrace)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m (f BearerTrace)
bearerTracer
          }


type TracersWithBearer connId m = Tracers' m (WithBearer connId)

tracersWithBearer :: peerId -> TracersWithBearer peerId m -> Tracers m
tracersWithBearer :: forall peerId (m :: * -> *).
peerId -> TracersWithBearer peerId m -> Tracers m
tracersWithBearer peerId
peerId = (forall x. Identity x -> WithBearer peerId x)
-> Tracers' m (WithBearer peerId) -> Tracers' m Identity
forall (f' :: * -> *) (f :: * -> *) (m :: * -> *).
(forall x. f' x -> f x) -> Tracers' m f -> Tracers' m f'
contramapTracers' (peerId -> x -> WithBearer peerId x
forall peerid a. peerid -> a -> WithBearer peerid a
WithBearer peerId
peerId (x -> WithBearer peerId x)
-> (Identity x -> x) -> Identity x -> WithBearer peerId x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> x
forall a. Identity a -> a
runIdentity)