{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.Network.Ping
( PingOpts(..)
, LogMsg(..)
, NodeVersion(..)
, HandshakeFailure(..)
, StatPoint(..)
, InitiatorOnly(..)
, mainnetMagic
, pingClient
, logger
, supportedNodeToNodeVersions
, supportedNodeToClientVersions
, handshakeDec
, handshakeReq
, isSameVersionAndMagic
) where
import Control.Exception (bracket, Exception (..), throwIO)
import Control.Monad (replicateM, unless, when)
import Control.Concurrent.Class.MonadSTM.Strict ( MonadSTM(atomically), takeTMVar, StrictTMVar )
import Control.Monad.Class.MonadTime.SI (UTCTime, diffTime, MonadMonotonicTime(getMonotonicTime), MonadTime(getCurrentTime), Time)
import Control.Monad.Trans.Except
import Control.Tracer (Tracer (..), nullTracer, traceWith)
import Data.Aeson (Value, ToJSON(toJSON, toJSONList), object, encode, KeyValue((.=)))
import Data.Aeson.Text (encodeToLazyText)
import Data.Bits (clearBit, setBit, testBit)
import Data.ByteString.Lazy (ByteString)
import Data.Foldable (toList)
import Data.IP
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromMaybe,)
import Data.TDigest (insert, maximumValue, minimumValue, tdigest, mean, quantile, stddev, TDigest)
import Data.Text (unpack)
import Data.Time (DiffTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Word (Word16, Word32, Word64)
import GHC.Generics
import Network.Mux.Bearer (MakeBearer (..), makeSocketBearer)
import Network.Mux.Timeout (TimeoutFn, withTimeoutSerial)
import Network.Mux.Types (MuxSDUHeader(MuxSDUHeader, mhTimestamp, mhDir, mhLength, mhNum), MiniProtocolNum(..), MiniProtocolDir(InitiatorDir), MuxBearer(read, write), MuxSDU(..), RemoteClockModel(RemoteClockModel))
import Network.Socket (AddrInfo, StructLinger (..))
import Text.Printf (printf)
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import qualified Codec.CBOR.Write as CBOR
import qualified Control.Monad.Class.MonadTimer.SI as MT
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as LBS.Char
import qualified Data.List as L
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Network.Socket as Socket
import qualified System.IO as IO
import Codec.CBOR.Read (DeserialiseFailure)
data PingOpts = PingOpts
{ PingOpts -> Word32
pingOptsCount :: Word32
, PingOpts -> Maybe String
pingOptsHost :: Maybe String
, PingOpts -> Bool
pingOptsHandshakeQuery :: Bool
, PingOpts -> Maybe String
pingOptsUnixSock :: Maybe String
, PingOpts -> String
pingOptsPort :: String
, PingOpts -> Word32
pingOptsMagic :: Word32
, PingOpts -> Bool
pingOptsJson :: Bool
, PingOpts -> Bool
pingOptsQuiet :: Bool
, PingOpts -> Bool
pingOptsGetTip :: Bool
} deriving (PingOpts -> PingOpts -> Bool
(PingOpts -> PingOpts -> Bool)
-> (PingOpts -> PingOpts -> Bool) -> Eq PingOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PingOpts -> PingOpts -> Bool
== :: PingOpts -> PingOpts -> Bool
$c/= :: PingOpts -> PingOpts -> Bool
/= :: PingOpts -> PingOpts -> Bool
Eq, Int -> PingOpts -> String -> String
[PingOpts] -> String -> String
PingOpts -> String
(Int -> PingOpts -> String -> String)
-> (PingOpts -> String)
-> ([PingOpts] -> String -> String)
-> Show PingOpts
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PingOpts -> String -> String
showsPrec :: Int -> PingOpts -> String -> String
$cshow :: PingOpts -> String
show :: PingOpts -> String
$cshowList :: [PingOpts] -> String -> String
showList :: [PingOpts] -> String -> String
Show)
mainnetMagic :: Word32
mainnetMagic :: Word32
mainnetMagic = Word32
764824073
handshakeNum :: MiniProtocolNum
handshakeNum :: MiniProtocolNum
handshakeNum = Word16 -> MiniProtocolNum
MiniProtocolNum Word16
0
chainSyncNum :: MiniProtocolNum
chainSyncNum :: MiniProtocolNum
chainSyncNum = Word16 -> MiniProtocolNum
MiniProtocolNum Word16
2
keepaliveNum :: MiniProtocolNum
keepaliveNum :: MiniProtocolNum
keepaliveNum = Word16 -> MiniProtocolNum
MiniProtocolNum Word16
8
nodeToClientVersionBit :: Int
nodeToClientVersionBit :: Int
nodeToClientVersionBit = Int
15
data LogMsg = LogMsg ByteString
| LogEnd
deriving Int -> LogMsg -> String -> String
[LogMsg] -> String -> String
LogMsg -> String
(Int -> LogMsg -> String -> String)
-> (LogMsg -> String)
-> ([LogMsg] -> String -> String)
-> Show LogMsg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LogMsg -> String -> String
showsPrec :: Int -> LogMsg -> String -> String
$cshow :: LogMsg -> String
show :: LogMsg -> String
$cshowList :: [LogMsg] -> String -> String
showList :: [LogMsg] -> String -> String
Show
logger :: StrictTMVar IO LogMsg -> Bool -> Bool -> Bool -> IO ()
logger :: StrictTMVar IO LogMsg -> Bool -> Bool -> Bool -> IO ()
logger StrictTMVar IO LogMsg
msgQueue Bool
json Bool
query Bool
tip = Bool -> IO ()
go Bool
True
where
go :: Bool -> IO ()
go Bool
first = do
msg <- STM IO LogMsg -> IO LogMsg
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO LogMsg -> IO LogMsg) -> STM IO LogMsg -> IO LogMsg
forall a b. (a -> b) -> a -> b
$ StrictTMVar IO LogMsg -> STM IO LogMsg
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar IO LogMsg
msgQueue
case msg of
LogMsg ByteString
bs -> do
let bs' :: ByteString
bs' = case (Bool
json, Bool
first, Bool
tip) of
(Bool
True, Bool
False, Bool
_) -> String -> ByteString
LBS.Char.pack String
",\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
(Bool
True, Bool
True, Bool
False) -> String -> ByteString
LBS.Char.pack String
"{ \"pongs\": [ " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
(Bool
True, Bool
True, Bool
True) -> String -> ByteString
LBS.Char.pack String
"{ \"tip\": [ " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
(Bool
False, Bool
True, Bool
False) -> String -> ByteString
LBS.Char.pack String
"timestamp, host, cookie, sample, median, p90, mean, min, max, std\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
(Bool
False, Bool
True, Bool
True) -> ByteString
bs
(Bool
False, Bool
False, Bool
_) -> ByteString
bs
ByteString -> IO ()
LBS.Char.putStr ByteString
bs'
Bool -> IO ()
go Bool
False
LogMsg
LogEnd -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
json Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
query) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
IO.putStrLn String
"] }"
supportedNodeToNodeVersions :: Word32 -> [NodeVersion]
supportedNodeToNodeVersions :: Word32 -> [NodeVersion]
supportedNodeToNodeVersions Word32
magic =
[ Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV7 Word32
magic InitiatorOnly
InitiatorOnly
, Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV8 Word32
magic InitiatorOnly
InitiatorOnly
, Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV9 Word32
magic InitiatorOnly
InitiatorOnly
, Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV10 Word32
magic InitiatorOnly
InitiatorOnly
, Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV11 Word32
magic InitiatorOnly
InitiatorOnly
, Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV12 Word32
magic InitiatorOnly
InitiatorOnly
, Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion
NodeToNodeVersionV13 Word32
magic InitiatorOnly
InitiatorOnly PeerSharing
PeerSharingDisabled
]
supportedNodeToClientVersions :: Word32 -> [NodeVersion]
supportedNodeToClientVersions :: Word32 -> [NodeVersion]
supportedNodeToClientVersions Word32
magic =
[ Word32 -> NodeVersion
NodeToClientVersionV9 Word32
magic
, Word32 -> NodeVersion
NodeToClientVersionV10 Word32
magic
, Word32 -> NodeVersion
NodeToClientVersionV11 Word32
magic
, Word32 -> NodeVersion
NodeToClientVersionV12 Word32
magic
, Word32 -> NodeVersion
NodeToClientVersionV13 Word32
magic
, Word32 -> NodeVersion
NodeToClientVersionV14 Word32
magic
, Word32 -> NodeVersion
NodeToClientVersionV15 Word32
magic
, Word32 -> NodeVersion
NodeToClientVersionV16 Word32
magic
]
data InitiatorOnly = InitiatorOnly | InitiatorAndResponder
deriving (InitiatorOnly -> InitiatorOnly -> Bool
(InitiatorOnly -> InitiatorOnly -> Bool)
-> (InitiatorOnly -> InitiatorOnly -> Bool) -> Eq InitiatorOnly
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitiatorOnly -> InitiatorOnly -> Bool
== :: InitiatorOnly -> InitiatorOnly -> Bool
$c/= :: InitiatorOnly -> InitiatorOnly -> Bool
/= :: InitiatorOnly -> InitiatorOnly -> Bool
Eq, Eq InitiatorOnly
Eq InitiatorOnly =>
(InitiatorOnly -> InitiatorOnly -> Ordering)
-> (InitiatorOnly -> InitiatorOnly -> Bool)
-> (InitiatorOnly -> InitiatorOnly -> Bool)
-> (InitiatorOnly -> InitiatorOnly -> Bool)
-> (InitiatorOnly -> InitiatorOnly -> Bool)
-> (InitiatorOnly -> InitiatorOnly -> InitiatorOnly)
-> (InitiatorOnly -> InitiatorOnly -> InitiatorOnly)
-> Ord InitiatorOnly
InitiatorOnly -> InitiatorOnly -> Bool
InitiatorOnly -> InitiatorOnly -> Ordering
InitiatorOnly -> InitiatorOnly -> InitiatorOnly
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 :: InitiatorOnly -> InitiatorOnly -> Ordering
compare :: InitiatorOnly -> InitiatorOnly -> Ordering
$c< :: InitiatorOnly -> InitiatorOnly -> Bool
< :: InitiatorOnly -> InitiatorOnly -> Bool
$c<= :: InitiatorOnly -> InitiatorOnly -> Bool
<= :: InitiatorOnly -> InitiatorOnly -> Bool
$c> :: InitiatorOnly -> InitiatorOnly -> Bool
> :: InitiatorOnly -> InitiatorOnly -> Bool
$c>= :: InitiatorOnly -> InitiatorOnly -> Bool
>= :: InitiatorOnly -> InitiatorOnly -> Bool
$cmax :: InitiatorOnly -> InitiatorOnly -> InitiatorOnly
max :: InitiatorOnly -> InitiatorOnly -> InitiatorOnly
$cmin :: InitiatorOnly -> InitiatorOnly -> InitiatorOnly
min :: InitiatorOnly -> InitiatorOnly -> InitiatorOnly
Ord, Int -> InitiatorOnly -> String -> String
[InitiatorOnly] -> String -> String
InitiatorOnly -> String
(Int -> InitiatorOnly -> String -> String)
-> (InitiatorOnly -> String)
-> ([InitiatorOnly] -> String -> String)
-> Show InitiatorOnly
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> InitiatorOnly -> String -> String
showsPrec :: Int -> InitiatorOnly -> String -> String
$cshow :: InitiatorOnly -> String
show :: InitiatorOnly -> String
$cshowList :: [InitiatorOnly] -> String -> String
showList :: [InitiatorOnly] -> String -> String
Show, InitiatorOnly
InitiatorOnly -> InitiatorOnly -> Bounded InitiatorOnly
forall a. a -> a -> Bounded a
$cminBound :: InitiatorOnly
minBound :: InitiatorOnly
$cmaxBound :: InitiatorOnly
maxBound :: InitiatorOnly
Bounded, (forall x. InitiatorOnly -> Rep InitiatorOnly x)
-> (forall x. Rep InitiatorOnly x -> InitiatorOnly)
-> Generic InitiatorOnly
forall x. Rep InitiatorOnly x -> InitiatorOnly
forall x. InitiatorOnly -> Rep InitiatorOnly x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitiatorOnly -> Rep InitiatorOnly x
from :: forall x. InitiatorOnly -> Rep InitiatorOnly x
$cto :: forall x. Rep InitiatorOnly x -> InitiatorOnly
to :: forall x. Rep InitiatorOnly x -> InitiatorOnly
Generic)
instance ToJSON InitiatorOnly
modeToBool :: InitiatorOnly -> Bool
modeToBool :: InitiatorOnly -> Bool
modeToBool InitiatorOnly
InitiatorOnly = Bool
True
modeToBool InitiatorOnly
InitiatorAndResponder = Bool
False
modeFromBool :: Bool -> InitiatorOnly
modeFromBool :: Bool -> InitiatorOnly
modeFromBool Bool
True = InitiatorOnly
InitiatorOnly
modeFromBool Bool
False = InitiatorOnly
InitiatorAndResponder
data PeerSharing = PeerSharingEnabled | PeerSharingDisabled
deriving (PeerSharing -> PeerSharing -> Bool
(PeerSharing -> PeerSharing -> Bool)
-> (PeerSharing -> PeerSharing -> Bool) -> Eq PeerSharing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerSharing -> PeerSharing -> Bool
== :: PeerSharing -> PeerSharing -> Bool
$c/= :: PeerSharing -> PeerSharing -> Bool
/= :: PeerSharing -> PeerSharing -> Bool
Eq, Eq PeerSharing
Eq PeerSharing =>
(PeerSharing -> PeerSharing -> Ordering)
-> (PeerSharing -> PeerSharing -> Bool)
-> (PeerSharing -> PeerSharing -> Bool)
-> (PeerSharing -> PeerSharing -> Bool)
-> (PeerSharing -> PeerSharing -> Bool)
-> (PeerSharing -> PeerSharing -> PeerSharing)
-> (PeerSharing -> PeerSharing -> PeerSharing)
-> Ord PeerSharing
PeerSharing -> PeerSharing -> Bool
PeerSharing -> PeerSharing -> Ordering
PeerSharing -> PeerSharing -> PeerSharing
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 :: PeerSharing -> PeerSharing -> Ordering
compare :: PeerSharing -> PeerSharing -> Ordering
$c< :: PeerSharing -> PeerSharing -> Bool
< :: PeerSharing -> PeerSharing -> Bool
$c<= :: PeerSharing -> PeerSharing -> Bool
<= :: PeerSharing -> PeerSharing -> Bool
$c> :: PeerSharing -> PeerSharing -> Bool
> :: PeerSharing -> PeerSharing -> Bool
$c>= :: PeerSharing -> PeerSharing -> Bool
>= :: PeerSharing -> PeerSharing -> Bool
$cmax :: PeerSharing -> PeerSharing -> PeerSharing
max :: PeerSharing -> PeerSharing -> PeerSharing
$cmin :: PeerSharing -> PeerSharing -> PeerSharing
min :: PeerSharing -> PeerSharing -> PeerSharing
Ord, Int -> PeerSharing -> String -> String
[PeerSharing] -> String -> String
PeerSharing -> String
(Int -> PeerSharing -> String -> String)
-> (PeerSharing -> String)
-> ([PeerSharing] -> String -> String)
-> Show PeerSharing
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PeerSharing -> String -> String
showsPrec :: Int -> PeerSharing -> String -> String
$cshow :: PeerSharing -> String
show :: PeerSharing -> String
$cshowList :: [PeerSharing] -> String -> String
showList :: [PeerSharing] -> String -> String
Show, PeerSharing
PeerSharing -> PeerSharing -> Bounded PeerSharing
forall a. a -> a -> Bounded a
$cminBound :: PeerSharing
minBound :: PeerSharing
$cmaxBound :: PeerSharing
maxBound :: PeerSharing
Bounded, (forall x. PeerSharing -> Rep PeerSharing x)
-> (forall x. Rep PeerSharing x -> PeerSharing)
-> Generic PeerSharing
forall x. Rep PeerSharing x -> PeerSharing
forall x. PeerSharing -> Rep PeerSharing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerSharing -> Rep PeerSharing x
from :: forall x. PeerSharing -> Rep PeerSharing x
$cto :: forall x. Rep PeerSharing x -> PeerSharing
to :: forall x. Rep PeerSharing x -> PeerSharing
Generic)
instance ToJSON PeerSharing
peerSharingFromWord32 :: Word32 -> PeerSharing
peerSharingFromWord32 :: Word32 -> PeerSharing
peerSharingFromWord32 Word32
1 = PeerSharing
PeerSharingEnabled
peerSharingFromWord32 Word32
_ = PeerSharing
PeerSharingDisabled
data NodeVersion
= NodeToClientVersionV9 Word32
| NodeToClientVersionV10 Word32
| NodeToClientVersionV11 Word32
| NodeToClientVersionV12 Word32
| NodeToClientVersionV13 Word32
| NodeToClientVersionV14 Word32
| NodeToClientVersionV15 Word32
| NodeToClientVersionV16 Word32
| NodeToClientVersionV17 Word32
| NodeToNodeVersionV1 Word32
| NodeToNodeVersionV2 Word32
| NodeToNodeVersionV3 Word32
| NodeToNodeVersionV4 Word32 InitiatorOnly
| NodeToNodeVersionV5 Word32 InitiatorOnly
| NodeToNodeVersionV6 Word32 InitiatorOnly
| NodeToNodeVersionV7 Word32 InitiatorOnly
| NodeToNodeVersionV8 Word32 InitiatorOnly
| NodeToNodeVersionV9 Word32 InitiatorOnly
| NodeToNodeVersionV10 Word32 InitiatorOnly
| NodeToNodeVersionV11 Word32 InitiatorOnly
| NodeToNodeVersionV12 Word32 InitiatorOnly
| NodeToNodeVersionV13 Word32 InitiatorOnly PeerSharing
deriving (NodeVersion -> NodeVersion -> Bool
(NodeVersion -> NodeVersion -> Bool)
-> (NodeVersion -> NodeVersion -> Bool) -> Eq NodeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeVersion -> NodeVersion -> Bool
== :: NodeVersion -> NodeVersion -> Bool
$c/= :: NodeVersion -> NodeVersion -> Bool
/= :: NodeVersion -> NodeVersion -> Bool
Eq, Eq NodeVersion
Eq NodeVersion =>
(NodeVersion -> NodeVersion -> Ordering)
-> (NodeVersion -> NodeVersion -> Bool)
-> (NodeVersion -> NodeVersion -> Bool)
-> (NodeVersion -> NodeVersion -> Bool)
-> (NodeVersion -> NodeVersion -> Bool)
-> (NodeVersion -> NodeVersion -> NodeVersion)
-> (NodeVersion -> NodeVersion -> NodeVersion)
-> Ord NodeVersion
NodeVersion -> NodeVersion -> Bool
NodeVersion -> NodeVersion -> Ordering
NodeVersion -> NodeVersion -> NodeVersion
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 :: NodeVersion -> NodeVersion -> Ordering
compare :: NodeVersion -> NodeVersion -> Ordering
$c< :: NodeVersion -> NodeVersion -> Bool
< :: NodeVersion -> NodeVersion -> Bool
$c<= :: NodeVersion -> NodeVersion -> Bool
<= :: NodeVersion -> NodeVersion -> Bool
$c> :: NodeVersion -> NodeVersion -> Bool
> :: NodeVersion -> NodeVersion -> Bool
$c>= :: NodeVersion -> NodeVersion -> Bool
>= :: NodeVersion -> NodeVersion -> Bool
$cmax :: NodeVersion -> NodeVersion -> NodeVersion
max :: NodeVersion -> NodeVersion -> NodeVersion
$cmin :: NodeVersion -> NodeVersion -> NodeVersion
min :: NodeVersion -> NodeVersion -> NodeVersion
Ord, Int -> NodeVersion -> String -> String
[NodeVersion] -> String -> String
NodeVersion -> String
(Int -> NodeVersion -> String -> String)
-> (NodeVersion -> String)
-> ([NodeVersion] -> String -> String)
-> Show NodeVersion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> NodeVersion -> String -> String
showsPrec :: Int -> NodeVersion -> String -> String
$cshow :: NodeVersion -> String
show :: NodeVersion -> String
$cshowList :: [NodeVersion] -> String -> String
showList :: [NodeVersion] -> String -> String
Show)
instance ToJSON NodeVersion where
toJSON :: NodeVersion -> Value
toJSON NodeVersion
nv =
[Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ case NodeVersion
nv of
NodeToClientVersionV9 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV9" Word32
m
NodeToClientVersionV10 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV10" Word32
m
NodeToClientVersionV11 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV11" Word32
m
NodeToClientVersionV12 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV12" Word32
m
NodeToClientVersionV13 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV13" Word32
m
NodeToClientVersionV14 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV14" Word32
m
NodeToClientVersionV15 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV15" Word32
m
NodeToClientVersionV16 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV16" Word32
m
NodeToClientVersionV17 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV17" Word32
m
NodeToNodeVersionV1 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToNodeVersionV1" Word32
m
NodeToNodeVersionV2 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToNodeVersionV2" Word32
m
NodeToNodeVersionV3 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToNodeVersionV3" Word32
m
NodeToNodeVersionV4 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV4" Word32
m InitiatorOnly
i
NodeToNodeVersionV5 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV5" Word32
m InitiatorOnly
i
NodeToNodeVersionV6 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV6" Word32
m InitiatorOnly
i
NodeToNodeVersionV7 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV7" Word32
m InitiatorOnly
i
NodeToNodeVersionV8 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV8" Word32
m InitiatorOnly
i
NodeToNodeVersionV9 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV9" Word32
m InitiatorOnly
i
NodeToNodeVersionV10 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV10" Word32
m InitiatorOnly
i
NodeToNodeVersionV11 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV11" Word32
m InitiatorOnly
i
NodeToNodeVersionV12 Word32
m InitiatorOnly
i -> String -> Word32 -> InitiatorOnly -> [Pair]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
"NodeToNodeVersionV12" Word32
m InitiatorOnly
i
NodeToNodeVersionV13 Word32
m InitiatorOnly
i PeerSharing
ps -> String -> Word32 -> InitiatorOnly -> PeerSharing -> [Pair]
forall {e} {a} {a} {v} {a}.
(KeyValue e a, ToJSON a, ToJSON v, ToJSON a) =>
String -> v -> a -> a -> [a]
go4 String
"NodeToNodeVersionV13" Word32
m InitiatorOnly
i PeerSharing
ps
where
go2 :: String -> v -> [a]
go2 (String
version :: String) v
magic = [Key
"version" Key -> String -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
version, Key
"magic" Key -> v -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
magic]
go3 :: String -> v -> a -> [a]
go3 String
version v
magic a
initiator = String -> v -> [a]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
version v
magic [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [Key
"initiator" Key -> Value -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
initiator]
go4 :: String -> v -> a -> a -> [a]
go4 String
version v
magic a
initiator a
peersharing = String -> v -> a -> [a]
forall {e} {a} {v} {a}.
(KeyValue e a, ToJSON v, ToJSON a) =>
String -> v -> a -> [a]
go3 String
version v
magic a
initiator [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<>
[Key
"peersharing" Key -> Value -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
peersharing]
data PingTip = PingTip {
PingTip -> (IP, PortNumber)
ptHost :: !(IP, Socket.PortNumber)
, PingTip -> Double
ptRtt :: !Double
, PingTip -> ByteString
ptHash :: !ByteString
, PingTip -> Word64
ptBlockNo :: !Word64
, PingTip -> Word64
ptSlotNo :: !Word64
}
hexStr :: ByteString -> String
hexStr :: ByteString -> String
hexStr = (Word8 -> String -> String) -> String -> ByteString -> String
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
LBS.foldr (\Word8
b -> String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>) (String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
b)) String
""
instance Show PingTip where
show :: PingTip -> String
show PingTip{Double
Word64
(IP, PortNumber)
ByteString
ptHost :: PingTip -> (IP, PortNumber)
ptRtt :: PingTip -> Double
ptHash :: PingTip -> ByteString
ptBlockNo :: PingTip -> Word64
ptSlotNo :: PingTip -> Word64
ptHost :: (IP, PortNumber)
ptRtt :: Double
ptHash :: ByteString
ptBlockNo :: Word64
ptSlotNo :: Word64
..} =
String
-> String
-> Word16
-> Double
-> String
-> Word64
-> Word64
-> String
forall r. PrintfType r => String -> r
printf String
"host: %s:%d, rtt: %f, hash %s, blockNo: %d slotNo: %d" (IP -> String
forall a. Show a => a -> String
show (IP -> String) -> IP -> String
forall a b. (a -> b) -> a -> b
$ (IP, PortNumber) -> IP
forall a b. (a, b) -> a
fst (IP, PortNumber)
ptHost)
(PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PortNumber -> Word16) -> PortNumber -> Word16
forall a b. (a -> b) -> a -> b
$ (IP, PortNumber) -> PortNumber
forall a b. (a, b) -> b
snd (IP, PortNumber)
ptHost :: Word16) Double
ptRtt (ByteString -> String
hexStr ByteString
ptHash) Word64
ptBlockNo Word64
ptSlotNo
instance ToJSON PingTip where
toJSON :: PingTip -> Value
toJSON PingTip{Double
Word64
(IP, PortNumber)
ByteString
ptHost :: PingTip -> (IP, PortNumber)
ptRtt :: PingTip -> Double
ptHash :: PingTip -> ByteString
ptBlockNo :: PingTip -> Word64
ptSlotNo :: PingTip -> Word64
ptHost :: (IP, PortNumber)
ptRtt :: Double
ptHash :: ByteString
ptBlockNo :: Word64
ptSlotNo :: Word64
..} =
[Pair] -> Value
object [
Key
"rtt" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
ptRtt
, Key
"hash" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> String
hexStr ByteString
ptHash
, Key
"blockNo" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
ptBlockNo
, Key
"slotNo" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
ptSlotNo
, Key
"addr" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (IP -> String
forall a. Show a => a -> String
show (IP -> String) -> IP -> String
forall a b. (a -> b) -> a -> b
$ (IP, PortNumber) -> IP
forall a b. (a, b) -> a
fst ((IP, PortNumber) -> IP) -> (IP, PortNumber) -> IP
forall a b. (a -> b) -> a -> b
$ (IP, PortNumber)
ptHost :: String)
, Key
"port" Key -> Word16 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PortNumber -> Word16) -> PortNumber -> Word16
forall a b. (a -> b) -> a -> b
$ (IP, PortNumber) -> PortNumber
forall a b. (a, b) -> b
snd ((IP, PortNumber) -> PortNumber) -> (IP, PortNumber) -> PortNumber
forall a b. (a -> b) -> a -> b
$ (IP, PortNumber)
ptHost :: Word16)
]
keepAliveReqEnc :: NodeVersion -> Word16 -> CBOR.Encoding
keepAliveReqEnc :: NodeVersion -> Word16 -> Encoding
keepAliveReqEnc NodeVersion
v Word16
cookie | NodeVersion
v NodeVersion -> NodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV7 Word32
forall a. Bounded a => a
minBound InitiatorOnly
forall a. Bounded a => a
minBound =
Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
cookie
keepAliveReqEnc NodeVersion
_ Word16
cookie =
Word -> Encoding
CBOR.encodeWord Word
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
cookie
keepAliveReq :: NodeVersion -> Word16 -> ByteString
keepAliveReq :: NodeVersion -> Word16 -> ByteString
keepAliveReq NodeVersion
v Word16
c = Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ NodeVersion -> Word16 -> Encoding
keepAliveReqEnc NodeVersion
v Word16
c
keepAliveDone :: NodeVersion -> ByteString
keepAliveDone :: NodeVersion -> ByteString
keepAliveDone NodeVersion
v | NodeVersion
v NodeVersion -> NodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV7 Word32
forall a. Bounded a => a
minBound InitiatorOnly
forall a. Bounded a => a
minBound =
Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
Word -> Encoding
CBOR.encodeListLen Word
1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2
keepAliveDone NodeVersion
_ =
Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
Word -> Encoding
CBOR.encodeWord Word
2
chainSyncFindIntersect :: ByteString
chainSyncFindIntersect :: ByteString
chainSyncFindIntersect = Encoding -> ByteString
CBOR.toLazyByteString Encoding
findIntersectEnc
where
findIntersectEnc :: CBOR.Encoding
findIntersectEnc :: Encoding
findIntersectEnc =
Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
handshakeReqEnc :: NonEmpty NodeVersion -> Bool -> CBOR.Encoding
handshakeReqEnc :: NonEmpty NodeVersion -> Bool -> Encoding
handshakeReqEnc NonEmpty NodeVersion
versions Bool
query =
Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeMapLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ NonEmpty NodeVersion -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length NonEmpty NodeVersion
versions)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [ NodeVersion -> Encoding
encodeVersion (NodeVersion -> NodeVersion
fixupVersion NodeVersion
v)
| NodeVersion
v <- NonEmpty NodeVersion -> [NodeVersion]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty NodeVersion
versions
]
where
fixupVersion :: NodeVersion -> NodeVersion
fixupVersion :: NodeVersion -> NodeVersion
fixupVersion NodeVersion
v | Bool -> Bool
not Bool
query = NodeVersion
v
fixupVersion (NodeToNodeVersionV4 Word32
a InitiatorOnly
_) = Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV4 Word32
a InitiatorOnly
InitiatorAndResponder
fixupVersion (NodeToNodeVersionV5 Word32
a InitiatorOnly
_) = Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV5 Word32
a InitiatorOnly
InitiatorAndResponder
fixupVersion (NodeToNodeVersionV6 Word32
a InitiatorOnly
_) = Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV6 Word32
a InitiatorOnly
InitiatorAndResponder
fixupVersion (NodeToNodeVersionV7 Word32
a InitiatorOnly
_) = Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV7 Word32
a InitiatorOnly
InitiatorAndResponder
fixupVersion (NodeToNodeVersionV8 Word32
a InitiatorOnly
_) = Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV8 Word32
a InitiatorOnly
InitiatorAndResponder
fixupVersion (NodeToNodeVersionV9 Word32
a InitiatorOnly
_) = Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV9 Word32
a InitiatorOnly
InitiatorAndResponder
fixupVersion (NodeToNodeVersionV10 Word32
a InitiatorOnly
_) = Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV10 Word32
a InitiatorOnly
InitiatorAndResponder
fixupVersion NodeVersion
v = NodeVersion
v
encodeVersion :: NodeVersion -> CBOR.Encoding
encodeVersion :: NodeVersion -> Encoding
encodeVersion (NodeToClientVersionV9 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
9 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToClientVersionV10 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
10 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToClientVersionV11 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
11 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToClientVersionV12 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
12 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToClientVersionV13 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
13 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToClientVersionV14 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
14 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToClientVersionV15 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
15 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
nodeToClientDataWithQuery Word32
magic
encodeVersion (NodeToClientVersionV16 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
16 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
nodeToClientDataWithQuery Word32
magic
encodeVersion (NodeToClientVersionV17 Word32
magic) =
Word -> Encoding
CBOR.encodeWord (Word
17 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`setBit` Int
nodeToClientVersionBit)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
nodeToClientDataWithQuery Word32
magic
encodeVersion (NodeToNodeVersionV1 Word32
magic) =
Word -> Encoding
CBOR.encodeWord Word
1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToNodeVersionV2 Word32
magic) =
Word -> Encoding
CBOR.encodeWord Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToNodeVersionV3 Word32
magic) =
Word -> Encoding
CBOR.encodeWord Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
encodeVersion (NodeToNodeVersionV4 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
4 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV5 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
5 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV6 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
6 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV7 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
7 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV8 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
8 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV9 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
9 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV10 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
10 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV11 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
11 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV12 Word32
magic InitiatorOnly
mode) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
12 Word32
magic InitiatorOnly
mode
encodeVersion (NodeToNodeVersionV13 Word32
magic InitiatorOnly
mode PeerSharing
_) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
13 Word32
magic InitiatorOnly
mode
nodeToClientDataWithQuery :: Word32 -> CBOR.Encoding
nodeToClientDataWithQuery :: Word32 -> Encoding
nodeToClientDataWithQuery Word32
magic
= Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool Bool
query
encodeWithMode :: Word -> Word32 -> InitiatorOnly -> CBOR.Encoding
encodeWithMode :: Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
vn Word32
magic InitiatorOnly
mode
| Word
vn Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
12 =
Word -> Encoding
CBOR.encodeWord Word
vn
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool (InitiatorOnly -> Bool
modeToBool InitiatorOnly
mode)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt Int
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool Bool
query
| Word
vn Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
11 =
Word -> Encoding
CBOR.encodeWord Word
vn
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool (InitiatorOnly -> Bool
modeToBool InitiatorOnly
mode)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt Int
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool Bool
query
| Bool
otherwise =
Word -> Encoding
CBOR.encodeWord Word
vn
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
CBOR.encodeInt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
magic)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool (InitiatorOnly -> Bool
modeToBool InitiatorOnly
mode)
handshakeReq :: [NodeVersion] -> Bool -> ByteString
handshakeReq :: [NodeVersion] -> Bool -> ByteString
handshakeReq [] Bool
_ = ByteString
LBS.empty
handshakeReq (NodeVersion
v:[NodeVersion]
vs) Bool
query = Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ NonEmpty NodeVersion -> Bool -> Encoding
handshakeReqEnc (NodeVersion
vNodeVersion -> [NodeVersion] -> NonEmpty NodeVersion
forall a. a -> [a] -> NonEmpty a
:|[NodeVersion]
vs) Bool
query
data HandshakeFailure
= UnknownVersionInRsp Word
| UnknownKey Word
| UnknownTag Word
| VersionMissmath [Word]
| DecodeError Word String
| Refused Word String
deriving Int -> HandshakeFailure -> String -> String
[HandshakeFailure] -> String -> String
HandshakeFailure -> String
(Int -> HandshakeFailure -> String -> String)
-> (HandshakeFailure -> String)
-> ([HandshakeFailure] -> String -> String)
-> Show HandshakeFailure
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> HandshakeFailure -> String -> String
showsPrec :: Int -> HandshakeFailure -> String -> String
$cshow :: HandshakeFailure -> String
show :: HandshakeFailure -> String
$cshowList :: [HandshakeFailure] -> String -> String
showList :: [HandshakeFailure] -> String -> String
Show
newtype KeepAliveFailure = KeepAliveFailureKey Word deriving Int -> KeepAliveFailure -> String -> String
[KeepAliveFailure] -> String -> String
KeepAliveFailure -> String
(Int -> KeepAliveFailure -> String -> String)
-> (KeepAliveFailure -> String)
-> ([KeepAliveFailure] -> String -> String)
-> Show KeepAliveFailure
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> KeepAliveFailure -> String -> String
showsPrec :: Int -> KeepAliveFailure -> String -> String
$cshow :: KeepAliveFailure -> String
show :: KeepAliveFailure -> String
$cshowList :: [KeepAliveFailure] -> String -> String
showList :: [KeepAliveFailure] -> String -> String
Show
keepAliveRspDec :: NodeVersion
-> CBOR.Decoder s (Either KeepAliveFailure Word16)
keepAliveRspDec :: forall s. NodeVersion -> Decoder s (Either KeepAliveFailure Word16)
keepAliveRspDec NodeVersion
v | NodeVersion
v NodeVersion -> NodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV7 Word32
forall a. Bounded a => a
minBound InitiatorOnly
forall a. Bounded a => a
minBound = do
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
key <- CBOR.decodeWord
case (len, key) of
(Int
2, Word
1) -> Word16 -> Either KeepAliveFailure Word16
forall a b. b -> Either a b
Right (Word16 -> Either KeepAliveFailure Word16)
-> Decoder s Word16 -> Decoder s (Either KeepAliveFailure Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
(Int
_, Word
k) -> Either KeepAliveFailure Word16
-> Decoder s (Either KeepAliveFailure Word16)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either KeepAliveFailure Word16
-> Decoder s (Either KeepAliveFailure Word16))
-> Either KeepAliveFailure Word16
-> Decoder s (Either KeepAliveFailure Word16)
forall a b. (a -> b) -> a -> b
$ KeepAliveFailure -> Either KeepAliveFailure Word16
forall a b. a -> Either a b
Left (KeepAliveFailure -> Either KeepAliveFailure Word16)
-> KeepAliveFailure -> Either KeepAliveFailure Word16
forall a b. (a -> b) -> a -> b
$ Word -> KeepAliveFailure
KeepAliveFailureKey Word
k
keepAliveRspDec NodeVersion
_ = do
key <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
case key of
Word
1 -> Word16 -> Either KeepAliveFailure Word16
forall a b. b -> Either a b
Right (Word16 -> Either KeepAliveFailure Word16)
-> Decoder s Word16 -> Decoder s (Either KeepAliveFailure Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
Word
k -> Either KeepAliveFailure Word16
-> Decoder s (Either KeepAliveFailure Word16)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either KeepAliveFailure Word16
-> Decoder s (Either KeepAliveFailure Word16))
-> Either KeepAliveFailure Word16
-> Decoder s (Either KeepAliveFailure Word16)
forall a b. (a -> b) -> a -> b
$ KeepAliveFailure -> Either KeepAliveFailure Word16
forall a b. a -> Either a b
Left (KeepAliveFailure -> Either KeepAliveFailure Word16)
-> KeepAliveFailure -> Either KeepAliveFailure Word16
forall a b. (a -> b) -> a -> b
$ Word -> KeepAliveFailure
KeepAliveFailureKey Word
k
handshakeDec :: CBOR.Decoder s (Either HandshakeFailure [NodeVersion])
handshakeDec :: forall s. Decoder s (Either HandshakeFailure [NodeVersion])
handshakeDec = do
_ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
key <- CBOR.decodeWord
case key of
Word
0 -> do
decodeVersions
Word
1 -> do
(NodeVersion -> [NodeVersion])
-> Either HandshakeFailure NodeVersion
-> Either HandshakeFailure [NodeVersion]
forall a b.
(a -> b) -> Either HandshakeFailure a -> Either HandshakeFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeVersion -> [NodeVersion]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandshakeFailure NodeVersion
-> Either HandshakeFailure [NodeVersion])
-> Decoder s (Either HandshakeFailure NodeVersion)
-> Decoder s (Either HandshakeFailure [NodeVersion])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Either HandshakeFailure NodeVersion)
forall s. Decoder s (Either HandshakeFailure NodeVersion)
decodeVersion
Word
2 -> do
_ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
tag <- CBOR.decodeWord
case tag of
Word
0 -> do
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
x <- replicateM len CBOR.decodeWord
return $ Left $ VersionMissmath x
Word
1 -> do
vn <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
msg <- unpack <$> CBOR.decodeString
return $ Left $ DecodeError vn msg
Word
2 -> do
vn <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
msg <- unpack <$> CBOR.decodeString
return $ Left $ Refused vn msg
Word
_ -> Either HandshakeFailure [NodeVersion]
-> Decoder s (Either HandshakeFailure [NodeVersion])
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HandshakeFailure [NodeVersion]
-> Decoder s (Either HandshakeFailure [NodeVersion]))
-> Either HandshakeFailure [NodeVersion]
-> Decoder s (Either HandshakeFailure [NodeVersion])
forall a b. (a -> b) -> a -> b
$ HandshakeFailure -> Either HandshakeFailure [NodeVersion]
forall a b. a -> Either a b
Left (HandshakeFailure -> Either HandshakeFailure [NodeVersion])
-> HandshakeFailure -> Either HandshakeFailure [NodeVersion]
forall a b. (a -> b) -> a -> b
$ Word -> HandshakeFailure
UnknownTag Word
tag
Word
3 -> do
decodeVersions
Word
k -> Either HandshakeFailure [NodeVersion]
-> Decoder s (Either HandshakeFailure [NodeVersion])
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HandshakeFailure [NodeVersion]
-> Decoder s (Either HandshakeFailure [NodeVersion]))
-> Either HandshakeFailure [NodeVersion]
-> Decoder s (Either HandshakeFailure [NodeVersion])
forall a b. (a -> b) -> a -> b
$ HandshakeFailure -> Either HandshakeFailure [NodeVersion]
forall a b. a -> Either a b
Left (HandshakeFailure -> Either HandshakeFailure [NodeVersion])
-> HandshakeFailure -> Either HandshakeFailure [NodeVersion]
forall a b. (a -> b) -> a -> b
$ Word -> HandshakeFailure
UnknownKey Word
k
where
decodeVersions :: CBOR.Decoder s (Either HandshakeFailure [NodeVersion])
decodeVersions :: forall s. Decoder s (Either HandshakeFailure [NodeVersion])
decodeVersions = do
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLen
runExceptT $ go len []
where
go :: Int -> [NodeVersion] -> ExceptT HandshakeFailure (CBOR.Decoder s) [NodeVersion]
go :: forall s.
Int
-> [NodeVersion]
-> ExceptT HandshakeFailure (Decoder s) [NodeVersion]
go Int
0 [NodeVersion]
acc = [NodeVersion] -> ExceptT HandshakeFailure (Decoder s) [NodeVersion]
forall a. a -> ExceptT HandshakeFailure (Decoder s) a
forall (m :: * -> *) a. Monad m => a -> m a
return [NodeVersion]
acc
go Int
i [NodeVersion]
acc = do
version <- Decoder s (Either HandshakeFailure NodeVersion)
-> ExceptT HandshakeFailure (Decoder s) NodeVersion
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT Decoder s (Either HandshakeFailure NodeVersion)
forall s. Decoder s (Either HandshakeFailure NodeVersion)
decodeVersion
go (pred i) $ version:acc
decodeVersion :: CBOR.Decoder s (Either HandshakeFailure NodeVersion)
decodeVersion :: forall s. Decoder s (Either HandshakeFailure NodeVersion)
decodeVersion = do
version <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
let cb = Word
version Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`clearBit` Int
nodeToClientVersionBit
let tb = Word
version Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
nodeToClientVersionBit
case (cb, tb) of
(Word
7, Bool
False) -> (Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithMode Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV7
(Word
8, Bool
False) -> (Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithMode Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV8
(Word
9, Bool
False) -> (Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithMode Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV9
(Word
10, Bool
False) -> (Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithMode Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV10
(Word
11, Bool
False) -> (Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithModeAndQuery Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV11
(Word
12, Bool
False) -> (Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithModeAndQuery Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV12
(Word
13, Bool
False) -> (Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
forall s.
(Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithModeQueryAndPeerSharing Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion
NodeToNodeVersionV13
(Word
9, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV9 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
(Word
10, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV10 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
(Word
11, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV11 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
(Word
12, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV12 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
(Word
13, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV13 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
(Word
14, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV14 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
(Word
15, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV15 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen Decoder s Int -> Decoder s Word32 -> Decoder s Word32
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32 Decoder s Word32 -> Decoder s InitiatorOnly -> Decoder s Word32
forall a b. Decoder s a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Bool -> InitiatorOnly
modeFromBool (Bool -> InitiatorOnly)
-> Decoder s Bool -> Decoder s InitiatorOnly
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBool))
(Word
16, Bool
True) -> NodeVersion -> Either HandshakeFailure NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either HandshakeFailure NodeVersion)
-> (Word32 -> NodeVersion)
-> Word32
-> Either HandshakeFailure NodeVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NodeVersion
NodeToClientVersionV16 (Word32 -> Either HandshakeFailure NodeVersion)
-> Decoder s Word32
-> Decoder s (Either HandshakeFailure NodeVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen Decoder s Int -> Decoder s Word32 -> Decoder s Word32
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32 Decoder s Word32 -> Decoder s InitiatorOnly -> Decoder s Word32
forall a b. Decoder s a -> Decoder s b -> Decoder s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Bool -> InitiatorOnly
modeFromBool (Bool -> InitiatorOnly)
-> Decoder s Bool -> Decoder s InitiatorOnly
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBool))
(Word, Bool)
_ -> Either HandshakeFailure NodeVersion
-> Decoder s (Either HandshakeFailure NodeVersion)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HandshakeFailure NodeVersion
-> Decoder s (Either HandshakeFailure NodeVersion))
-> Either HandshakeFailure NodeVersion
-> Decoder s (Either HandshakeFailure NodeVersion)
forall a b. (a -> b) -> a -> b
$ HandshakeFailure -> Either HandshakeFailure NodeVersion
forall a b. a -> Either a b
Left (HandshakeFailure -> Either HandshakeFailure NodeVersion)
-> HandshakeFailure -> Either HandshakeFailure NodeVersion
forall a b. (a -> b) -> a -> b
$ Word -> HandshakeFailure
UnknownVersionInRsp Word
version
decodeWithMode :: (Word32 -> InitiatorOnly -> NodeVersion) -> CBOR.Decoder s (Either HandshakeFailure NodeVersion)
decodeWithMode :: forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithMode Word32 -> InitiatorOnly -> NodeVersion
vnFun = do
_ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
magic <- CBOR.decodeWord32
Right . vnFun magic . modeFromBool <$> CBOR.decodeBool
decodeWithModeAndQuery :: (Word32 -> InitiatorOnly -> NodeVersion)
-> CBOR.Decoder s (Either HandshakeFailure NodeVersion)
decodeWithModeAndQuery :: forall s.
(Word32 -> InitiatorOnly -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithModeAndQuery Word32 -> InitiatorOnly -> NodeVersion
vnFun = do
_len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
magic <- CBOR.decodeWord32
mode <- modeFromBool <$> CBOR.decodeBool
_peerSharing <- CBOR.decodeWord32
_query <- CBOR.decodeBool
return $ Right $ vnFun magic mode
decodeWithModeQueryAndPeerSharing :: (Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion)
-> CBOR.Decoder s (Either HandshakeFailure NodeVersion)
decodeWithModeQueryAndPeerSharing :: forall s.
(Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion)
-> Decoder s (Either HandshakeFailure NodeVersion)
decodeWithModeQueryAndPeerSharing Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion
vnFun = do
_len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
magic <- CBOR.decodeWord32
mode <- modeFromBool <$> CBOR.decodeBool
peerSharing <- peerSharingFromWord32 <$> CBOR.decodeWord32
_query <- CBOR.decodeBool
return $ Right $ vnFun magic mode peerSharing
chainSyncIntersectNotFoundDec :: CBOR.Decoder s (Word64, Word64, ByteString)
chainSyncIntersectNotFoundDec :: forall s. Decoder s (Word64, Word64, ByteString)
chainSyncIntersectNotFoundDec = do
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
key <- CBOR.decodeWord
case (len, key) of
(Int
2, Word
6) -> do
_ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
_ <- CBOR.decodeListLen
slotNo <- CBOR.decodeWord64
hash <- CBOR.decodeBytes
blockNo <- CBOR.decodeWord64
return (slotNo, blockNo, LBS.fromStrict hash)
(Int, Word)
_ -> String -> Decoder s (Word64, Word64, ByteString)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"IntersectNotFound unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
key)
wrap :: MiniProtocolNum -> MiniProtocolDir -> LBS.ByteString -> MuxSDU
wrap :: MiniProtocolNum -> MiniProtocolDir -> ByteString -> MuxSDU
wrap MiniProtocolNum
ptclNum MiniProtocolDir
ptclDir ByteString
blob = MuxSDU
{ msHeader :: MuxSDUHeader
msHeader = MuxSDUHeader
{ mhTimestamp :: RemoteClockModel
mhTimestamp = Word32 -> RemoteClockModel
RemoteClockModel Word32
0
, mhNum :: MiniProtocolNum
mhNum = MiniProtocolNum
ptclNum
, mhDir :: MiniProtocolDir
mhDir = MiniProtocolDir
ptclDir
, mhLength :: Word16
mhLength = Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> Int64 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LBS.length ByteString
blob
}
, msBlob :: ByteString
msBlob = ByteString
blob
}
data StatPoint = StatPoint
{ StatPoint -> UTCTime
spTimestamp :: UTCTime
, StatPoint -> String
spHost :: String
, StatPoint -> Word16
spCookie :: Word16
, StatPoint -> Double
spSample :: Double
, StatPoint -> Double
spMedian :: Double
, StatPoint -> Double
spP90 :: Double
, StatPoint -> Double
spMean :: Double
, StatPoint -> Double
spMin :: Double
, StatPoint -> Double
spMax :: Double
, StatPoint -> Double
spStd :: Double
}
instance Show StatPoint where
show :: StatPoint -> String
show :: StatPoint -> String
show StatPoint {Double
String
Word16
UTCTime
spTimestamp :: StatPoint -> UTCTime
spHost :: StatPoint -> String
spCookie :: StatPoint -> Word16
spSample :: StatPoint -> Double
spMedian :: StatPoint -> Double
spP90 :: StatPoint -> Double
spMean :: StatPoint -> Double
spMin :: StatPoint -> Double
spMax :: StatPoint -> Double
spStd :: StatPoint -> Double
spTimestamp :: UTCTime
spHost :: String
spCookie :: Word16
spSample :: Double
spMedian :: Double
spP90 :: Double
spMean :: Double
spMin :: Double
spMax :: Double
spStd :: Double
..} =
String
-> String
-> String
-> Word16
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> String
forall r. PrintfType r => String -> r
printf String
"%-31s %-28s %7d, %7.3f, %7.3f, %7.3f, %7.3f, %7.3f, %7.3f, %7.3f"
(UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
spTimestamp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",") (String
spHost String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",") Word16
spCookie Double
spSample Double
spMedian Double
spP90 Double
spMean Double
spMin Double
spMax Double
spStd
instance ToJSON StatPoint where
toJSON :: StatPoint -> Value
toJSON :: StatPoint -> Value
toJSON StatPoint {Double
String
Word16
UTCTime
spTimestamp :: StatPoint -> UTCTime
spHost :: StatPoint -> String
spCookie :: StatPoint -> Word16
spSample :: StatPoint -> Double
spMedian :: StatPoint -> Double
spP90 :: StatPoint -> Double
spMean :: StatPoint -> Double
spMin :: StatPoint -> Double
spMax :: StatPoint -> Double
spStd :: StatPoint -> Double
spTimestamp :: UTCTime
spHost :: String
spCookie :: Word16
spSample :: Double
spMedian :: Double
spP90 :: Double
spMean :: Double
spMin :: Double
spMax :: Double
spStd :: Double
..} =
[Pair] -> Value
object
[ Key
"timestamp" Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
spTimestamp
, Key
"host" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
spHost
, Key
"cookie" Key -> Word16 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word16
spCookie
, Key
"sample" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
spSample
, Key
"median" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
spMedian
, Key
"p90" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
spP90
, Key
"mean" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
spMean
, Key
"min" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
spMin
, Key
"max" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double
spMax
]
toStatPoint :: UTCTime -> String -> Word16 -> Double -> TDigest 5 -> StatPoint
toStatPoint :: UTCTime -> String -> Word16 -> Double -> TDigest 5 -> StatPoint
toStatPoint UTCTime
ts String
host Word16
cookie Double
sample TDigest 5
td =
StatPoint
{ spTimestamp :: UTCTime
spTimestamp = UTCTime
ts
, spHost :: String
spHost = String
host
, spCookie :: Word16
spCookie = Word16
cookie
, spSample :: Double
spSample = Double
sample
, spMedian :: Double
spMedian = Double -> Double
quantile' Double
0.5
, spP90 :: Double
spP90 = Double -> Double
quantile' Double
0.9
, spMean :: Double
spMean = Double
mean'
, spMin :: Double
spMin = TDigest 5 -> Double
forall (comp :: Nat). TDigest comp -> Double
minimumValue TDigest 5
td
, spMax :: Double
spMax = TDigest 5 -> Double
forall (comp :: Nat). TDigest comp -> Double
maximumValue TDigest 5
td
, spStd :: Double
spStd = Double
stddev'
}
where
quantile' :: Double -> Double
quantile' :: Double -> Double
quantile' Double
q = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Double -> TDigest 5 -> Maybe Double
forall (comp :: Nat). Double -> TDigest comp -> Maybe Double
quantile Double
q TDigest 5
td)
mean' :: Double
mean' :: Double
mean' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (TDigest 5 -> Maybe Double
forall (comp :: Nat). TDigest comp -> Maybe Double
mean TDigest 5
td)
stddev' :: Double
stddev' :: Double
stddev' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (TDigest 5 -> Maybe Double
forall (comp :: Nat). TDigest comp -> Maybe Double
stddev TDigest 5
td)
keepAliveDelay :: MT.DiffTime
keepAliveDelay :: DiffTime
keepAliveDelay = DiffTime
1
idleTimeout :: MT.DiffTime
idleTimeout :: DiffTime
idleTimeout = DiffTime
5
sduTimeout :: MT.DiffTime
sduTimeout :: DiffTime
sduTimeout = DiffTime
30
data PingClientError = PingClientDeserialiseFailure DeserialiseFailure String
| PingClientFindIntersectDeserialiseFailure DeserialiseFailure String
| PingClientKeepAliveDeserialiseFailure DeserialiseFailure String
| PingClientKeepAliveProtocolFailure KeepAliveFailure String
| PingClientHandshakeFailure HandshakeFailure String
| PingClientNegotiationError String [NodeVersion] String
| PingClientIPAddressFailure String
deriving Int -> PingClientError -> String -> String
[PingClientError] -> String -> String
PingClientError -> String
(Int -> PingClientError -> String -> String)
-> (PingClientError -> String)
-> ([PingClientError] -> String -> String)
-> Show PingClientError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PingClientError -> String -> String
showsPrec :: Int -> PingClientError -> String -> String
$cshow :: PingClientError -> String
show :: PingClientError -> String
$cshowList :: [PingClientError] -> String -> String
showList :: [PingClientError] -> String -> String
Show
instance Exception PingClientError where
displayException :: PingClientError -> String
displayException (PingClientDeserialiseFailure DeserialiseFailure
err String
peerStr) =
String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s Decoding error: %s" String
peerStr (DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
err)
displayException (PingClientFindIntersectDeserialiseFailure DeserialiseFailure
err String
peerStr) =
String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s findIntersect decoding error %s" String
peerStr (DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
err)
displayException (PingClientKeepAliveDeserialiseFailure DeserialiseFailure
err String
peerStr) =
String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s keepalive decoding error %s" String
peerStr (DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
err)
displayException (PingClientKeepAliveProtocolFailure KeepAliveFailure
err String
peerStr) =
String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s keepalive protocol error %s" String
peerStr (KeepAliveFailure -> String
forall a. Show a => a -> String
show KeepAliveFailure
err)
displayException (PingClientHandshakeFailure HandshakeFailure
err String
peerStr) =
String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s Protocol error: %s" String
peerStr (HandshakeFailure -> String
forall a. Show a => a -> String
show HandshakeFailure
err)
displayException (PingClientNegotiationError String
err [NodeVersion]
recVersions String
peerStr) =
String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s Version negotiation error %s\nReceived versions: %s\n" String
peerStr String
err ([NodeVersion] -> String
forall a. Show a => a -> String
show [NodeVersion]
recVersions)
displayException (PingClientIPAddressFailure String
peerStr) =
String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s expected an IP address\n" String
peerStr
pingClient :: Tracer IO LogMsg -> Tracer IO String -> PingOpts -> [NodeVersion] -> AddrInfo -> IO ()
pingClient :: Tracer IO LogMsg
-> Tracer IO String
-> PingOpts
-> [NodeVersion]
-> AddrInfo
-> IO ()
pingClient Tracer IO LogMsg
stdout Tracer IO String
stderr PingOpts{Bool
String
Maybe String
Word32
pingOptsCount :: PingOpts -> Word32
pingOptsHost :: PingOpts -> Maybe String
pingOptsHandshakeQuery :: PingOpts -> Bool
pingOptsUnixSock :: PingOpts -> Maybe String
pingOptsPort :: PingOpts -> String
pingOptsMagic :: PingOpts -> Word32
pingOptsJson :: PingOpts -> Bool
pingOptsQuiet :: PingOpts -> Bool
pingOptsGetTip :: PingOpts -> Bool
pingOptsCount :: Word32
pingOptsHost :: Maybe String
pingOptsHandshakeQuery :: Bool
pingOptsUnixSock :: Maybe String
pingOptsPort :: String
pingOptsMagic :: Word32
pingOptsJson :: Bool
pingOptsQuiet :: Bool
pingOptsGetTip :: Bool
..} [NodeVersion]
versions AddrInfo
peer = IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Family -> SocketType -> CInt -> IO Socket
Socket.socket (AddrInfo -> Family
Socket.addrFamily AddrInfo
peer) SocketType
Socket.Stream CInt
Socket.defaultProtocol)
Socket -> IO ()
Socket.close
(\Socket
sd -> (TimeoutFn IO -> IO ()) -> IO ()
forall (m :: * -> *) b.
(MonadAsync m, MonadFork m, MonadMonotonicTime m, MonadTimer m,
MonadMask m, MonadThrow (STM m)) =>
(TimeoutFn m -> m b) -> m b
withTimeoutSerial ((TimeoutFn IO -> IO ()) -> IO ())
-> (TimeoutFn IO -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TimeoutFn IO
timeoutfn -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddrInfo -> Family
Socket.addrFamily AddrInfo
peer Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
/= Family
Socket.AF_UNIX) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Socket -> SocketOption -> Int -> IO ()
Socket.setSocketOption Socket
sd SocketOption
Socket.NoDelay Int
1
Socket -> SocketOption -> StructLinger -> IO ()
forall a. Storable a => Socket -> SocketOption -> a -> IO ()
Socket.setSockOpt Socket
sd SocketOption
Socket.Linger
StructLinger
{ sl_onoff :: CInt
sl_onoff = CInt
1
, sl_linger :: CInt
sl_linger = CInt
0
}
!t0_s <- IO Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
Socket.connect sd (Socket.addrAddress peer)
!t0_e <- getMonotonicTime
peerStr <- peerString
let peerStr' = String -> Text
TL.pack String
peerStr
unless pingOptsQuiet $ TL.hPutStrLn IO.stdout $ peerStr' <> " " <> (showNetworkRtt $ toSample t0_e t0_s)
bearer <- getBearer makeSocketBearer sduTimeout nullTracer sd
!t1_s <- write bearer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions pingOptsHandshakeQuery)
(msg, !t1_e) <- nextMsg bearer timeoutfn handshakeNum
unless pingOptsQuiet $ TL.hPutStrLn IO.stdout $ peerStr' <> " " <> (showHandshakeRtt $ diffTime t1_e t1_s)
case CBOR.deserialiseFromBytes handshakeDec msg of
Left DeserialiseFailure
err -> PingClientError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (DeserialiseFailure -> String -> PingClientError
PingClientDeserialiseFailure DeserialiseFailure
err String
peerStr)
Right (ByteString
_, Left HandshakeFailure
err) -> PingClientError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (HandshakeFailure -> String -> PingClientError
PingClientHandshakeFailure HandshakeFailure
err String
peerStr)
Right (ByteString
_, Right [NodeVersion]
recVersions) -> do
case [NodeVersion] -> Either String NodeVersion
acceptVersions [NodeVersion]
recVersions of
Left String
err -> PingClientError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> [NodeVersion] -> String -> PingClientError
PingClientNegotiationError String
err [NodeVersion]
recVersions String
peerStr)
Right NodeVersion
version -> do
let isUnixSocket :: Bool
isUnixSocket = case AddrInfo -> Family
Socket.addrFamily AddrInfo
peer of
Family
Socket.AF_UNIX -> Bool
True
Family
_ -> Bool
False
querySupported :: Bool
querySupported = Bool -> Bool
not Bool
isUnixSocket Bool -> Bool -> Bool
&& (NodeVersion
version NodeVersion -> NodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> InitiatorOnly -> NodeVersion
NodeToNodeVersionV11 Word32
forall a. Bounded a => a
minBound InitiatorOnly
forall a. Bounded a => a
minBound)
Bool -> Bool -> Bool
|| Bool
isUnixSocket Bool -> Bool -> Bool
&& (NodeVersion
version NodeVersion -> NodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> NodeVersion
NodeToClientVersionV15 Word32
forall a. Bounded a => a
minBound)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( (Bool -> Bool
not Bool
pingOptsHandshakeQuery Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
pingOptsQuiet)
Bool -> Bool -> Bool
|| ( Bool
pingOptsHandshakeQuery Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
querySupported)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> Text -> IO ()
TL.hPutStrLn Handle
IO.stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
peerStr' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (NodeVersion -> Text
showNegotiatedVersion NodeVersion
version)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
pingOptsHandshakeQuery Bool -> Bool -> Bool
&& Bool
querySupported) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> Text -> IO ()
TL.hPutStrLn Handle
IO.stdout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
peerStr' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([NodeVersion] -> Text
showQueriedVersions [NodeVersion]
recVersions)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
pingOptsHandshakeQuery Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isUnixSocket) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
if Bool
pingOptsGetTip
then MuxBearer IO -> TimeoutFn IO -> String -> IO ()
getTip MuxBearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn String
peerStr
else MuxBearer IO
-> TimeoutFn IO
-> String
-> NodeVersion
-> TDigest 5
-> Word32
-> IO ()
keepAlive MuxBearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn String
peerStr NodeVersion
version ([Double] -> TDigest 5
forall (f :: * -> *) (comp :: Nat).
(Foldable f, KnownNat comp) =>
f Double -> TDigest comp
tdigest []) Word32
0
_ <- MuxBearer IO -> TimeoutFn IO -> MuxSDU -> IO Time
forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> MuxSDU -> m Time
write MuxBearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn (MuxSDU -> IO Time) -> MuxSDU -> IO Time
forall a b. (a -> b) -> a -> b
$ MiniProtocolNum -> MiniProtocolDir -> ByteString -> MuxSDU
wrap MiniProtocolNum
keepaliveNum MiniProtocolDir
InitiatorDir (NodeVersion -> ByteString
keepAliveDone NodeVersion
version)
return ()
DiffTime -> IO ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
MT.threadDelay DiffTime
idleTimeout
)
where
acceptVersions :: [NodeVersion] -> Either String NodeVersion
acceptVersions :: [NodeVersion] -> Either String NodeVersion
acceptVersions [NodeVersion]
recVersions =
let intersects :: [NodeVersion]
intersects = (NodeVersion -> NodeVersion -> Bool)
-> [NodeVersion] -> [NodeVersion] -> [NodeVersion]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
L.intersectBy NodeVersion -> NodeVersion -> Bool
isSameVersionAndMagic [NodeVersion]
recVersions [NodeVersion]
versions in
case [NodeVersion]
intersects of
[] -> String -> Either String NodeVersion
forall a b. a -> Either a b
Left (String -> Either String NodeVersion)
-> String -> Either String NodeVersion
forall a b. (a -> b) -> a -> b
$ String
"No overlapping versions with " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [NodeVersion] -> String
forall a. Show a => a -> String
show [NodeVersion]
versions
[NodeVersion]
vs -> NodeVersion -> Either String NodeVersion
forall a b. b -> Either a b
Right (NodeVersion -> Either String NodeVersion)
-> NodeVersion -> Either String NodeVersion
forall a b. (a -> b) -> a -> b
$ (NodeVersion -> NodeVersion -> NodeVersion)
-> [NodeVersion] -> NodeVersion
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 NodeVersion -> NodeVersion -> NodeVersion
forall a. Ord a => a -> a -> a
max [NodeVersion]
vs
showNetworkRtt :: Double -> TL.Text
showNetworkRtt :: Double -> Text
showNetworkRtt Double
rtt =
if Bool
pingOptsJson
then Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"network_rtt" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
rtt]
else String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"network rtt: %.3f" Double
rtt
showHandshakeRtt :: DiffTime -> TL.Text
showHandshakeRtt :: DiffTime -> Text
showHandshakeRtt DiffTime
diff =
if Bool
pingOptsJson
then Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"handshake_rtt" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Double -> Value
forall a. ToJSON a => a -> Value
toJSON ((Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ DiffTime -> Rational
forall a. Real a => a -> Rational
toRational DiffTime
diff) :: Double)]
else String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"handshake rtt: %s" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ DiffTime -> String
forall a. Show a => a -> String
show DiffTime
diff
showNegotiatedVersion :: NodeVersion -> TL.Text
showNegotiatedVersion :: NodeVersion -> Text
showNegotiatedVersion NodeVersion
version =
if Bool
pingOptsJson
then Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"negotiated_version" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NodeVersion -> Value
forall a. ToJSON a => a -> Value
toJSON NodeVersion
version]
else String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Negotiated version %s" (NodeVersion -> String
forall a. Show a => a -> String
show NodeVersion
version)
showQueriedVersions :: [NodeVersion] -> TL.Text
showQueriedVersions :: [NodeVersion] -> Text
showQueriedVersions [NodeVersion]
recVersions =
if Bool
pingOptsJson
then Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"queried_versions" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [NodeVersion] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList [NodeVersion]
recVersions]
else String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Queried versions %s" ([NodeVersion] -> String
forall a. Show a => a -> String
show [NodeVersion]
recVersions)
peerString :: IO String
peerString :: IO String
peerString =
case AddrInfo -> Family
Socket.addrFamily AddrInfo
peer of
Family
Socket.AF_UNIX -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ SockAddr -> String
forall a. Show a => a -> String
show (SockAddr -> String) -> SockAddr -> String
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
Socket.addrAddress AddrInfo
peer
Family
_ -> do
(Just host, Just port) <-
[NameInfoFlag]
-> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String)
Socket.getNameInfo
[NameInfoFlag
Socket.NI_NUMERICHOST, NameInfoFlag
Socket.NI_NUMERICSERV]
Bool
True Bool
True (AddrInfo -> SockAddr
Socket.addrAddress AddrInfo
peer)
return $ host <> ":" <> port
toSample :: Time -> Time -> Double
toSample :: Time -> Time -> Double
toSample Time
t_e Time
t_s = DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime -> Double) -> DiffTime -> Double
forall a b. (a -> b) -> a -> b
$ Time -> Time -> DiffTime
diffTime Time
t_e Time
t_s
eprint :: String -> IO ()
eprint :: String -> IO ()
eprint = Tracer IO String -> String -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO String
stderr
nextMsg :: MuxBearer IO -> TimeoutFn IO -> MiniProtocolNum -> IO (LBS.ByteString, Time)
nextMsg :: MuxBearer IO
-> TimeoutFn IO -> MiniProtocolNum -> IO (ByteString, Time)
nextMsg MuxBearer IO
bearer TimeoutFn IO
timeoutfn MiniProtocolNum
ptclNum = do
(sdu, t_e) <- MuxBearer IO -> TimeoutFn IO -> IO (MuxSDU, Time)
forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> m (MuxSDU, Time)
Network.Mux.Types.read MuxBearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn
if mhNum (msHeader sdu) == ptclNum
then return (msBlob sdu, t_e)
else nextMsg bearer timeoutfn ptclNum
keepAlive :: MuxBearer IO
-> TimeoutFn IO
-> String
-> NodeVersion
-> TDigest 5
-> Word32
-> IO ()
keepAlive :: MuxBearer IO
-> TimeoutFn IO
-> String
-> NodeVersion
-> TDigest 5
-> Word32
-> IO ()
keepAlive MuxBearer IO
_ TimeoutFn IO
_ String
_ NodeVersion
_ TDigest 5
_ Word32
cookie | Word32
cookie Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
pingOptsCount = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
keepAlive MuxBearer IO
bearer TimeoutFn IO
timeoutfn String
peerStr NodeVersion
version TDigest 5
td !Word32
cookie = do
let cookie16 :: Word16
cookie16 = Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cookie
!t_s <- MuxBearer IO -> TimeoutFn IO -> MuxSDU -> IO Time
forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> MuxSDU -> m Time
write MuxBearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn (MuxSDU -> IO Time) -> MuxSDU -> IO Time
forall a b. (a -> b) -> a -> b
$ MiniProtocolNum -> MiniProtocolDir -> ByteString -> MuxSDU
wrap MiniProtocolNum
keepaliveNum MiniProtocolDir
InitiatorDir (NodeVersion -> Word16 -> ByteString
keepAliveReq NodeVersion
version Word16
cookie16)
(!msg, !t_e) <- nextMsg bearer timeoutfn keepaliveNum
let rtt = Time -> Time -> Double
toSample Time
t_e Time
t_s
td' = Double -> TDigest 5 -> TDigest 5
forall (comp :: Nat).
KnownNat comp =>
Double -> TDigest comp -> TDigest comp
insert Double
rtt TDigest 5
td
case CBOR.deserialiseFromBytes (keepAliveRspDec version) msg of
Left DeserialiseFailure
err -> PingClientError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (DeserialiseFailure -> String -> PingClientError
PingClientKeepAliveDeserialiseFailure DeserialiseFailure
err String
peerStr)
Right (ByteString
_, Left KeepAliveFailure
err) -> PingClientError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (KeepAliveFailure -> String -> PingClientError
PingClientKeepAliveProtocolFailure KeepAliveFailure
err String
peerStr)
Right (ByteString
_, Right Word16
cookie') -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
cookie' Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
cookie16) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
eprint (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Word16 -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"%s cookie missmatch %d /= %d"
String
peerStr Word16
cookie' Word32
cookie
now <- IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
let point = UTCTime -> String -> Word16 -> Double -> TDigest 5 -> StatPoint
toStatPoint UTCTime
now String
peerStr Word16
cookie16 Double
rtt TDigest 5
td'
if pingOptsJson
then traceWith stdout $ LogMsg (encode point)
else traceWith stdout $ LogMsg $ LBS.Char.pack $ show point <> "\n"
MT.threadDelay keepAliveDelay
keepAlive bearer timeoutfn peerStr version td' (cookie + 1)
getTip :: MuxBearer IO
-> TimeoutFn IO
-> String
-> IO ()
getTip :: MuxBearer IO -> TimeoutFn IO -> String -> IO ()
getTip MuxBearer IO
bearer TimeoutFn IO
timeoutfn String
peerStr = do
!t_s <- MuxBearer IO -> TimeoutFn IO -> MuxSDU -> IO Time
forall (m :: * -> *).
MuxBearer m -> TimeoutFn m -> MuxSDU -> m Time
write MuxBearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn (MuxSDU -> IO Time) -> MuxSDU -> IO Time
forall a b. (a -> b) -> a -> b
$ MiniProtocolNum -> MiniProtocolDir -> ByteString -> MuxSDU
wrap MiniProtocolNum
chainSyncNum MiniProtocolDir
InitiatorDir ByteString
chainSyncFindIntersect
(!msg, !t_e) <- nextMsg bearer timeoutfn chainSyncNum
case CBOR.deserialiseFromBytes chainSyncIntersectNotFoundDec msg of
Left DeserialiseFailure
err -> PingClientError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (DeserialiseFailure -> String -> PingClientError
PingClientFindIntersectDeserialiseFailure DeserialiseFailure
err String
peerStr)
Right (ByteString
_, (Word64
slotNo, Word64
blockNo, ByteString
hash)) ->
case SockAddr -> Maybe (IP, PortNumber)
fromSockAddr (SockAddr -> Maybe (IP, PortNumber))
-> SockAddr -> Maybe (IP, PortNumber)
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
Socket.addrAddress AddrInfo
peer of
Maybe (IP, PortNumber)
Nothing -> PingClientError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (String -> PingClientError
PingClientIPAddressFailure String
peerStr)
Just (IP, PortNumber)
host ->
let tip :: PingTip
tip = (IP, PortNumber)
-> Double -> ByteString -> Word64 -> Word64 -> PingTip
PingTip (IP, PortNumber)
host (Time -> Time -> Double
toSample Time
t_e Time
t_s) ByteString
hash Word64
blockNo Word64
slotNo in
if Bool
pingOptsJson then Tracer IO LogMsg -> LogMsg -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO LogMsg
stdout (LogMsg -> IO ()) -> LogMsg -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> LogMsg
LogMsg (PingTip -> ByteString
forall a. ToJSON a => a -> ByteString
encode PingTip
tip)
else Tracer IO LogMsg -> LogMsg -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO LogMsg
stdout (LogMsg -> IO ()) -> LogMsg -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> LogMsg
LogMsg (ByteString -> LogMsg) -> ByteString -> LogMsg
forall a b. (a -> b) -> a -> b
$ String -> ByteString
LBS.Char.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PingTip -> String
forall a. Show a => a -> String
show PingTip
tip String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"
isSameVersionAndMagic :: NodeVersion -> NodeVersion -> Bool
isSameVersionAndMagic :: NodeVersion -> NodeVersion -> Bool
isSameVersionAndMagic NodeVersion
v1 NodeVersion
v2 = NodeVersion -> (Int, Word32)
extract NodeVersion
v1 (Int, Word32) -> (Int, Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== NodeVersion -> (Int, Word32)
extract NodeVersion
v2
where extract :: NodeVersion -> (Int, Word32)
extract :: NodeVersion -> (Int, Word32)
extract (NodeToClientVersionV9 Word32
m) = (-Int
9, Word32
m)
extract (NodeToClientVersionV10 Word32
m) = (-Int
10, Word32
m)
extract (NodeToClientVersionV11 Word32
m) = (-Int
11, Word32
m)
extract (NodeToClientVersionV12 Word32
m) = (-Int
12, Word32
m)
extract (NodeToClientVersionV13 Word32
m) = (-Int
13, Word32
m)
extract (NodeToClientVersionV14 Word32
m) = (-Int
14, Word32
m)
extract (NodeToClientVersionV15 Word32
m) = (-Int
15, Word32
m)
extract (NodeToClientVersionV16 Word32
m) = (-Int
16, Word32
m)
extract (NodeToClientVersionV17 Word32
m) = (-Int
17, Word32
m)
extract (NodeToNodeVersionV1 Word32
m) = (Int
1, Word32
m)
extract (NodeToNodeVersionV2 Word32
m) = (Int
2, Word32
m)
extract (NodeToNodeVersionV3 Word32
m) = (Int
3, Word32
m)
extract (NodeToNodeVersionV4 Word32
m InitiatorOnly
_) = (Int
4, Word32
m)
extract (NodeToNodeVersionV5 Word32
m InitiatorOnly
_) = (Int
5, Word32
m)
extract (NodeToNodeVersionV6 Word32
m InitiatorOnly
_) = (Int
6, Word32
m)
extract (NodeToNodeVersionV7 Word32
m InitiatorOnly
_) = (Int
7, Word32
m)
extract (NodeToNodeVersionV8 Word32
m InitiatorOnly
_) = (Int
8, Word32
m)
extract (NodeToNodeVersionV9 Word32
m InitiatorOnly
_) = (Int
9, Word32
m)
extract (NodeToNodeVersionV10 Word32
m InitiatorOnly
_) = (Int
10, Word32
m)
extract (NodeToNodeVersionV11 Word32
m InitiatorOnly
_) = (Int
11, Word32
m)
extract (NodeToNodeVersionV12 Word32
m InitiatorOnly
_) = (Int
12, Word32
m)
extract (NodeToNodeVersionV13 Word32
m InitiatorOnly
_ PeerSharing
_) = (Int
13, Word32
m)