{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Ouroboros.Network.Protocol.LocalTxMonitor.Type where
import Data.Kind
import Data.Map.Strict (Map)
import Data.Singletons
import Data.Text (Text)
import Data.Word
import GHC.Generics (Generic)
import Control.DeepSeq
import Network.TypedProtocol.Core
import Ouroboros.Network.Util.ShowProxy
type LocalTxMonitor :: Type -> Type -> Type -> Type
data LocalTxMonitor txid tx slot where
StIdle :: LocalTxMonitor txid tx slot
StAcquiring :: LocalTxMonitor txid tx slot
StAcquired :: LocalTxMonitor txid tx slot
StBusy :: StBusyKind -> LocalTxMonitor txid tx slot
StDone :: LocalTxMonitor txid tx slot
instance
( ShowProxy txid
, ShowProxy tx
, ShowProxy slot
) =>
ShowProxy (LocalTxMonitor txid tx slot)
where
showProxy :: Proxy (LocalTxMonitor txid tx slot) -> String
showProxy Proxy (LocalTxMonitor txid tx slot)
_ = [String] -> String
unwords
[ String
"LocalTxMonitor"
, Proxy txid -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy txid
forall {k} (t :: k). Proxy t
Proxy :: Proxy txid)
, Proxy tx -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy tx
forall {k} (t :: k). Proxy t
Proxy :: Proxy tx)
, Proxy slot -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy slot
forall {k} (t :: k). Proxy t
Proxy :: Proxy slot)
]
type SingLocalTxMonitor :: LocalTxMonitor txid tx slot -> Type
data SingLocalTxMonitor st where
SingIdle :: SingLocalTxMonitor StIdle
SingAcquiring :: SingLocalTxMonitor StAcquiring
SingAcquired :: SingLocalTxMonitor StAcquired
SingBusy :: SingBusyKind k
-> SingLocalTxMonitor (StBusy k)
SingDone :: SingLocalTxMonitor StDone
instance StateTokenI StIdle where stateToken :: StateToken 'StIdle
stateToken = StateToken 'StIdle
SingLocalTxMonitor 'StIdle
forall {txid} {tx} {slot}. SingLocalTxMonitor 'StIdle
SingIdle
instance StateTokenI StAcquiring where stateToken :: StateToken 'StAcquiring
stateToken = StateToken 'StAcquiring
SingLocalTxMonitor 'StAcquiring
forall {txid} {tx} {slot}. SingLocalTxMonitor 'StAcquiring
SingAcquiring
instance StateTokenI StAcquired where stateToken :: StateToken 'StAcquired
stateToken = StateToken 'StAcquired
SingLocalTxMonitor 'StAcquired
forall {txid} {tx} {slot}. SingLocalTxMonitor 'StAcquired
SingAcquired
instance SingI k =>
StateTokenI (StBusy k) where stateToken :: StateToken ('StBusy k)
stateToken = SingBusyKind k -> SingLocalTxMonitor ('StBusy k)
forall {txid} {tx} {slot} (k :: StBusyKind).
SingBusyKind k -> SingLocalTxMonitor ('StBusy k)
SingBusy (Sing k
forall {k} (a :: k). SingI a => Sing a
sing :: Sing k)
instance StateTokenI StDone where stateToken :: StateToken 'StDone
stateToken = StateToken 'StDone
SingLocalTxMonitor 'StDone
forall {txid} {tx} {slot}. SingLocalTxMonitor 'StDone
SingDone
deriving instance Show (SingLocalTxMonitor st)
data StBusyKind where
NextTx :: StBusyKind
HasTx :: StBusyKind
GetSizes :: StBusyKind
GetMeasures :: StBusyKind
type SingBusyKind :: StBusyKind -> Type
data SingBusyKind st where
SingNextTx :: SingBusyKind NextTx
SingHasTx :: SingBusyKind HasTx
SingGetSizes :: SingBusyKind GetSizes
SingGetMeasures :: SingBusyKind GetMeasures
type instance Sing = SingBusyKind
instance SingI NextTx where sing :: Sing 'NextTx
sing = Sing 'NextTx
SingBusyKind 'NextTx
SingNextTx
instance SingI HasTx where sing :: Sing 'HasTx
sing = Sing 'HasTx
SingBusyKind 'HasTx
SingHasTx
instance SingI GetSizes where sing :: Sing 'GetSizes
sing = Sing 'GetSizes
SingBusyKind 'GetSizes
SingGetSizes
instance SingI GetMeasures where sing :: Sing 'GetMeasures
sing = Sing 'GetMeasures
SingBusyKind 'GetMeasures
SingGetMeasures
deriving instance Show (SingBusyKind st)
data MempoolSizeAndCapacity = MempoolSizeAndCapacity
{ MempoolSizeAndCapacity -> Word32
capacityInBytes :: !Word32
, MempoolSizeAndCapacity -> Word32
sizeInBytes :: !Word32
, MempoolSizeAndCapacity -> Word32
numberOfTxs :: !Word32
} deriving ((forall x. MempoolSizeAndCapacity -> Rep MempoolSizeAndCapacity x)
-> (forall x.
Rep MempoolSizeAndCapacity x -> MempoolSizeAndCapacity)
-> Generic MempoolSizeAndCapacity
forall x. Rep MempoolSizeAndCapacity x -> MempoolSizeAndCapacity
forall x. MempoolSizeAndCapacity -> Rep MempoolSizeAndCapacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MempoolSizeAndCapacity -> Rep MempoolSizeAndCapacity x
from :: forall x. MempoolSizeAndCapacity -> Rep MempoolSizeAndCapacity x
$cto :: forall x. Rep MempoolSizeAndCapacity x -> MempoolSizeAndCapacity
to :: forall x. Rep MempoolSizeAndCapacity x -> MempoolSizeAndCapacity
Generic, MempoolSizeAndCapacity -> MempoolSizeAndCapacity -> Bool
(MempoolSizeAndCapacity -> MempoolSizeAndCapacity -> Bool)
-> (MempoolSizeAndCapacity -> MempoolSizeAndCapacity -> Bool)
-> Eq MempoolSizeAndCapacity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MempoolSizeAndCapacity -> MempoolSizeAndCapacity -> Bool
== :: MempoolSizeAndCapacity -> MempoolSizeAndCapacity -> Bool
$c/= :: MempoolSizeAndCapacity -> MempoolSizeAndCapacity -> Bool
/= :: MempoolSizeAndCapacity -> MempoolSizeAndCapacity -> Bool
Eq, Int -> MempoolSizeAndCapacity -> ShowS
[MempoolSizeAndCapacity] -> ShowS
MempoolSizeAndCapacity -> String
(Int -> MempoolSizeAndCapacity -> ShowS)
-> (MempoolSizeAndCapacity -> String)
-> ([MempoolSizeAndCapacity] -> ShowS)
-> Show MempoolSizeAndCapacity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MempoolSizeAndCapacity -> ShowS
showsPrec :: Int -> MempoolSizeAndCapacity -> ShowS
$cshow :: MempoolSizeAndCapacity -> String
show :: MempoolSizeAndCapacity -> String
$cshowList :: [MempoolSizeAndCapacity] -> ShowS
showList :: [MempoolSizeAndCapacity] -> ShowS
Show, MempoolSizeAndCapacity -> ()
(MempoolSizeAndCapacity -> ()) -> NFData MempoolSizeAndCapacity
forall a. (a -> ()) -> NFData a
$crnf :: MempoolSizeAndCapacity -> ()
rnf :: MempoolSizeAndCapacity -> ()
NFData)
data SizeAndCapacity a = SizeAndCapacity
{ forall a. SizeAndCapacity a -> a
size :: !a
, forall a. SizeAndCapacity a -> a
capacity :: !a
} deriving ((forall x. SizeAndCapacity a -> Rep (SizeAndCapacity a) x)
-> (forall x. Rep (SizeAndCapacity a) x -> SizeAndCapacity a)
-> Generic (SizeAndCapacity a)
forall x. Rep (SizeAndCapacity a) x -> SizeAndCapacity a
forall x. SizeAndCapacity a -> Rep (SizeAndCapacity a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SizeAndCapacity a) x -> SizeAndCapacity a
forall a x. SizeAndCapacity a -> Rep (SizeAndCapacity a) x
$cfrom :: forall a x. SizeAndCapacity a -> Rep (SizeAndCapacity a) x
from :: forall x. SizeAndCapacity a -> Rep (SizeAndCapacity a) x
$cto :: forall a x. Rep (SizeAndCapacity a) x -> SizeAndCapacity a
to :: forall x. Rep (SizeAndCapacity a) x -> SizeAndCapacity a
Generic, SizeAndCapacity a -> SizeAndCapacity a -> Bool
(SizeAndCapacity a -> SizeAndCapacity a -> Bool)
-> (SizeAndCapacity a -> SizeAndCapacity a -> Bool)
-> Eq (SizeAndCapacity a)
forall a. Eq a => SizeAndCapacity a -> SizeAndCapacity a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SizeAndCapacity a -> SizeAndCapacity a -> Bool
== :: SizeAndCapacity a -> SizeAndCapacity a -> Bool
$c/= :: forall a. Eq a => SizeAndCapacity a -> SizeAndCapacity a -> Bool
/= :: SizeAndCapacity a -> SizeAndCapacity a -> Bool
Eq, Int -> SizeAndCapacity a -> ShowS
[SizeAndCapacity a] -> ShowS
SizeAndCapacity a -> String
(Int -> SizeAndCapacity a -> ShowS)
-> (SizeAndCapacity a -> String)
-> ([SizeAndCapacity a] -> ShowS)
-> Show (SizeAndCapacity a)
forall a. Show a => Int -> SizeAndCapacity a -> ShowS
forall a. Show a => [SizeAndCapacity a] -> ShowS
forall a. Show a => SizeAndCapacity a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SizeAndCapacity a -> ShowS
showsPrec :: Int -> SizeAndCapacity a -> ShowS
$cshow :: forall a. Show a => SizeAndCapacity a -> String
show :: SizeAndCapacity a -> String
$cshowList :: forall a. Show a => [SizeAndCapacity a] -> ShowS
showList :: [SizeAndCapacity a] -> ShowS
Show, SizeAndCapacity a -> ()
(SizeAndCapacity a -> ()) -> NFData (SizeAndCapacity a)
forall a. NFData a => SizeAndCapacity a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => SizeAndCapacity a -> ()
rnf :: SizeAndCapacity a -> ()
NFData)
instance Functor SizeAndCapacity where
fmap :: forall a b. (a -> b) -> SizeAndCapacity a -> SizeAndCapacity b
fmap a -> b
f (SizeAndCapacity a
s a
c) = b -> b -> SizeAndCapacity b
forall a. a -> a -> SizeAndCapacity a
SizeAndCapacity (a -> b
f a
s) (a -> b
f a
c)
newtype MeasureName = MeasureName Text
deriving ((forall x. MeasureName -> Rep MeasureName x)
-> (forall x. Rep MeasureName x -> MeasureName)
-> Generic MeasureName
forall x. Rep MeasureName x -> MeasureName
forall x. MeasureName -> Rep MeasureName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MeasureName -> Rep MeasureName x
from :: forall x. MeasureName -> Rep MeasureName x
$cto :: forall x. Rep MeasureName x -> MeasureName
to :: forall x. Rep MeasureName x -> MeasureName
Generic, MeasureName -> MeasureName -> Bool
(MeasureName -> MeasureName -> Bool)
-> (MeasureName -> MeasureName -> Bool) -> Eq MeasureName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeasureName -> MeasureName -> Bool
== :: MeasureName -> MeasureName -> Bool
$c/= :: MeasureName -> MeasureName -> Bool
/= :: MeasureName -> MeasureName -> Bool
Eq, Eq MeasureName
Eq MeasureName =>
(MeasureName -> MeasureName -> Ordering)
-> (MeasureName -> MeasureName -> Bool)
-> (MeasureName -> MeasureName -> Bool)
-> (MeasureName -> MeasureName -> Bool)
-> (MeasureName -> MeasureName -> Bool)
-> (MeasureName -> MeasureName -> MeasureName)
-> (MeasureName -> MeasureName -> MeasureName)
-> Ord MeasureName
MeasureName -> MeasureName -> Bool
MeasureName -> MeasureName -> Ordering
MeasureName -> MeasureName -> MeasureName
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
$ccompare :: MeasureName -> MeasureName -> Ordering
compare :: MeasureName -> MeasureName -> Ordering
$c< :: MeasureName -> MeasureName -> Bool
< :: MeasureName -> MeasureName -> Bool
$c<= :: MeasureName -> MeasureName -> Bool
<= :: MeasureName -> MeasureName -> Bool
$c> :: MeasureName -> MeasureName -> Bool
> :: MeasureName -> MeasureName -> Bool
$c>= :: MeasureName -> MeasureName -> Bool
>= :: MeasureName -> MeasureName -> Bool
$cmax :: MeasureName -> MeasureName -> MeasureName
max :: MeasureName -> MeasureName -> MeasureName
$cmin :: MeasureName -> MeasureName -> MeasureName
min :: MeasureName -> MeasureName -> MeasureName
Ord, Int -> MeasureName -> ShowS
[MeasureName] -> ShowS
MeasureName -> String
(Int -> MeasureName -> ShowS)
-> (MeasureName -> String)
-> ([MeasureName] -> ShowS)
-> Show MeasureName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MeasureName -> ShowS
showsPrec :: Int -> MeasureName -> ShowS
$cshow :: MeasureName -> String
show :: MeasureName -> String
$cshowList :: [MeasureName] -> ShowS
showList :: [MeasureName] -> ShowS
Show, MeasureName -> ()
(MeasureName -> ()) -> NFData MeasureName
forall a. (a -> ()) -> NFData a
$crnf :: MeasureName -> ()
rnf :: MeasureName -> ()
NFData)
data MempoolMeasures = MempoolMeasures
{ MempoolMeasures -> Word32
txCount :: !Word32
, MempoolMeasures -> Map MeasureName (SizeAndCapacity Integer)
measuresMap :: !(Map MeasureName (SizeAndCapacity Integer))
} deriving ((forall x. MempoolMeasures -> Rep MempoolMeasures x)
-> (forall x. Rep MempoolMeasures x -> MempoolMeasures)
-> Generic MempoolMeasures
forall x. Rep MempoolMeasures x -> MempoolMeasures
forall x. MempoolMeasures -> Rep MempoolMeasures x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MempoolMeasures -> Rep MempoolMeasures x
from :: forall x. MempoolMeasures -> Rep MempoolMeasures x
$cto :: forall x. Rep MempoolMeasures x -> MempoolMeasures
to :: forall x. Rep MempoolMeasures x -> MempoolMeasures
Generic, MempoolMeasures -> MempoolMeasures -> Bool
(MempoolMeasures -> MempoolMeasures -> Bool)
-> (MempoolMeasures -> MempoolMeasures -> Bool)
-> Eq MempoolMeasures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MempoolMeasures -> MempoolMeasures -> Bool
== :: MempoolMeasures -> MempoolMeasures -> Bool
$c/= :: MempoolMeasures -> MempoolMeasures -> Bool
/= :: MempoolMeasures -> MempoolMeasures -> Bool
Eq, Int -> MempoolMeasures -> ShowS
[MempoolMeasures] -> ShowS
MempoolMeasures -> String
(Int -> MempoolMeasures -> ShowS)
-> (MempoolMeasures -> String)
-> ([MempoolMeasures] -> ShowS)
-> Show MempoolMeasures
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MempoolMeasures -> ShowS
showsPrec :: Int -> MempoolMeasures -> ShowS
$cshow :: MempoolMeasures -> String
show :: MempoolMeasures -> String
$cshowList :: [MempoolMeasures] -> ShowS
showList :: [MempoolMeasures] -> ShowS
Show, MempoolMeasures -> ()
(MempoolMeasures -> ()) -> NFData MempoolMeasures
forall a. (a -> ()) -> NFData a
$crnf :: MempoolMeasures -> ()
rnf :: MempoolMeasures -> ()
NFData)
instance Protocol (LocalTxMonitor txid tx slot) where
data Message (LocalTxMonitor txid tx slot) from to where
MsgAcquire
:: Message (LocalTxMonitor txid tx slot) StIdle StAcquiring
MsgAcquired
:: slot
-> Message (LocalTxMonitor txid tx slot) StAcquiring StAcquired
MsgAwaitAcquire
:: Message (LocalTxMonitor txid tx slot) StAcquired StAcquiring
MsgNextTx
:: Message (LocalTxMonitor txid tx slot) StAcquired (StBusy NextTx)
MsgReplyNextTx
:: Maybe tx
-> Message (LocalTxMonitor txid tx slot) (StBusy NextTx) StAcquired
MsgHasTx
:: txid
-> Message (LocalTxMonitor txid tx slot) StAcquired (StBusy HasTx)
MsgReplyHasTx
:: Bool
-> Message (LocalTxMonitor txid tx slot) (StBusy HasTx) StAcquired
MsgGetSizes
:: Message (LocalTxMonitor txid tx slot) StAcquired (StBusy GetSizes)
MsgReplyGetSizes
:: MempoolSizeAndCapacity
-> Message (LocalTxMonitor txid tx slot) (StBusy GetSizes) StAcquired
MsgGetMeasures
:: Message (LocalTxMonitor txid tx slot) StAcquired (StBusy GetMeasures)
MsgReplyGetMeasures
:: MempoolMeasures
-> Message (LocalTxMonitor txid tx slot) (StBusy GetMeasures) StAcquired
MsgRelease
:: Message (LocalTxMonitor txid tx slot) StAcquired StIdle
MsgDone
:: Message (LocalTxMonitor txid tx slot) StIdle StDone
type StateAgency StIdle = ClientAgency
type StateAgency StAcquiring = ServerAgency
type StateAgency StAcquired = ClientAgency
type StateAgency (StBusy _) = ServerAgency
type StateAgency StDone = NobodyAgency
type StateToken = SingLocalTxMonitor
instance ( NFData txid
, NFData tx
, NFData slot
) => NFData (Message (LocalTxMonitor txid tx slot) from to) where
rnf :: Message (LocalTxMonitor txid tx slot) from to -> ()
rnf Message (LocalTxMonitor txid tx slot) from to
R:MessageLocalTxMonitorfromto txid tx slot from to
MsgAcquire = ()
rnf (MsgAcquired slot
slot) = slot -> ()
forall a. NFData a => a -> ()
rnf slot
slot
rnf Message (LocalTxMonitor txid tx slot) from to
R:MessageLocalTxMonitorfromto txid tx slot from to
MsgAwaitAcquire = ()
rnf Message (LocalTxMonitor txid tx slot) from to
R:MessageLocalTxMonitorfromto txid tx slot from to
MsgNextTx = ()
rnf (MsgReplyNextTx Maybe tx
mbTx) = Maybe tx -> ()
forall a. NFData a => a -> ()
rnf Maybe tx
mbTx
rnf (MsgHasTx txid
txid) = txid -> ()
forall a. NFData a => a -> ()
rnf txid
txid
rnf (MsgReplyHasTx Bool
b) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
rnf Message (LocalTxMonitor txid tx slot) from to
R:MessageLocalTxMonitorfromto txid tx slot from to
MsgGetSizes = ()
rnf (MsgReplyGetSizes MempoolSizeAndCapacity
msc) = MempoolSizeAndCapacity -> ()
forall a. NFData a => a -> ()
rnf MempoolSizeAndCapacity
msc
rnf Message (LocalTxMonitor txid tx slot) from to
R:MessageLocalTxMonitorfromto txid tx slot from to
MsgGetMeasures = ()
rnf (MsgReplyGetMeasures MempoolMeasures
msc) = MempoolMeasures -> ()
forall a. NFData a => a -> ()
rnf MempoolMeasures
msc
rnf Message (LocalTxMonitor txid tx slot) from to
R:MessageLocalTxMonitorfromto txid tx slot from to
MsgRelease = ()
rnf Message (LocalTxMonitor txid tx slot) from to
R:MessageLocalTxMonitorfromto txid tx slot from to
MsgDone = ()
deriving instance (Show txid, Show tx, Show slot)
=> Show (Message (LocalTxMonitor txid tx slot) from to)