{-# 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 qualified Network.Mux as Mx
import           Network.Mux.Bearer (MakeBearer (..), makeSocketBearer)
import           Network.Mux.Timeout (TimeoutFn, withTimeoutSerial)
import           Network.Mux.Types (MiniProtocolNum(..), MiniProtocolDir(InitiatorDir), Bearer(read, write), RemoteClockModel(RemoteClockModel))
import qualified Network.Mux.Types as Mx
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
    -- ^ Number of messages to send to the server
  , PingOpts -> Maybe String
pingOptsHost     :: Maybe String
    -- ^ The host to connect to
  , PingOpts -> Bool
pingOptsHandshakeQuery :: Bool
    -- ^ Whether to send a query during the handshake to request the available protocol versions
  , PingOpts -> Maybe String
pingOptsUnixSock :: Maybe String
    -- ^ The unix socket to connect to
  , PingOpts -> String
pingOptsPort     :: String
    -- ^ The port to connect to
  , PingOpts -> Word32
pingOptsMagic    :: Word32
    -- ^ The network magic to use for the connection
  , PingOpts -> Bool
pingOptsJson     :: Bool
    -- ^ Print output in JSON
  , PingOpts -> Bool
pingOptsQuiet    :: Bool
    -- ^ Less verbose output
  , PingOpts -> Bool
pingOptsGetTip   :: Bool
    -- ^ Get Tip after handshake
  } 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
  , Word32 -> InitiatorOnly -> PeerSharing -> NodeVersion
NodeToNodeVersionV14 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
  , Word32 -> NodeVersion
NodeToClientVersionV17 Word32
magic
  , Word32 -> NodeVersion
NodeToClientVersionV18 Word32
magic
  , Word32 -> NodeVersion
NodeToClientVersionV19 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
  | NodeToClientVersionV18 Word32
  | NodeToClientVersionV19 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
  | NodeToNodeVersionV14   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
      NodeToClientVersionV18 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV18" Word32
m
      NodeToClientVersionV19 Word32
m -> String -> Word32 -> [Pair]
forall {e} {a} {v}. (KeyValue e a, ToJSON v) => String -> v -> [a]
go2 String
"NodeToClientVersionV19" 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
      NodeToNodeVersionV14   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
"NodeToNodeVersionV14" 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
    -- Query is only available for NodeToNodeVersionV11 and higher, for smaller
    -- versions we send `InitiatorAndResponder`, in which case the remote side
    -- will do the handshake negotiation but it will reply with the right data.
    -- We shutdown the connection right after query, in most cases the remote
    -- side will not even have a chance to start using this connection as
    -- duplex (which could be possible if the node is using
    -- `NodeToNodeVersionV10`).
    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

    -- node-to-client
    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 (NodeToClientVersionV18 Word32
magic) =
          Word -> Encoding
CBOR.encodeWord (Word
18 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 (NodeToClientVersionV19 Word32
magic) =
          Word -> Encoding
CBOR.encodeWord (Word
18 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

    -- node-to-node
    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
    encodeVersion (NodeToNodeVersionV14 Word32
magic InitiatorOnly
mode PeerSharing
_) = Word -> Word32 -> InitiatorOnly -> Encoding
encodeWithMode Word
14 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 -- NoPeerSharing
       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 -- NoPeerSharing
       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 -- VersionMismatch
          len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
          x <- replicateM len CBOR.decodeWord
          return $ Left $ VersionMissmath x
        Word
1 -> do -- HandshakeDecodeError
          vn <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
          msg <- unpack <$> CBOR.decodeString
          return $ Left $ DecodeError vn msg
        Word
2 -> do -- Refused
          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 -- MsgQueryReply
      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
14, 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
NodeToNodeVersionV14

        (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
17, 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
NodeToClientVersionV17 (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
18, 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
NodeToClientVersionV18 (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
19, 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
NodeToClientVersionV19 (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 -> Mx.SDU
wrap :: MiniProtocolNum -> MiniProtocolDir -> ByteString -> SDU
wrap MiniProtocolNum
ptclNum MiniProtocolDir
ptclDir ByteString
blob = Mx.SDU
  { msHeader :: SDUHeader
Mx.msHeader = Mx.SDUHeader
    { mhTimestamp :: RemoteClockModel
Mx.mhTimestamp = Word32 -> RemoteClockModel
RemoteClockModel Word32
0
    , mhNum :: MiniProtocolNum
Mx.mhNum       = MiniProtocolNum
ptclNum
    , mhDir :: MiniProtocolDir
Mx.mhDir       = MiniProtocolDir
ptclDir
    , mhLength :: Word16
Mx.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
Mx.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
$
              -- print the negotiated version iff not quiet or querying but, query
              -- is not supported by the remote host.
              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
$
              -- print query results if it was supported by the remote side
              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 Bearer IO -> TimeoutFn IO -> String -> IO ()
getTip Bearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn String
peerStr
                 else Bearer IO
-> TimeoutFn IO
-> String
-> NodeVersion
-> TDigest 5
-> Word32
-> IO ()
keepAlive Bearer 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
              -- send terminating message
              _ <- Bearer IO -> TimeoutFn IO -> SDU -> IO Time
forall (m :: * -> *). Bearer m -> TimeoutFn m -> SDU -> m Time
write Bearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn (SDU -> IO Time) -> SDU -> IO Time
forall a b. (a -> b) -> a -> b
$ MiniProtocolNum -> MiniProtocolDir -> ByteString -> SDU
wrap MiniProtocolNum
keepaliveNum MiniProtocolDir
InitiatorDir (NodeVersion -> ByteString
keepAliveDone NodeVersion
version)
              return ()
            -- protocol idle timeout
            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 ::  Mx.Bearer IO -> TimeoutFn IO -> MiniProtocolNum -> IO (LBS.ByteString, Time)
    nextMsg :: Bearer IO
-> TimeoutFn IO -> MiniProtocolNum -> IO (ByteString, Time)
nextMsg Bearer IO
bearer TimeoutFn IO
timeoutfn MiniProtocolNum
ptclNum = do
      (sdu, t_e) <- Bearer IO -> TimeoutFn IO -> IO (SDU, Time)
forall (m :: * -> *). Bearer m -> TimeoutFn m -> m (SDU, Time)
Network.Mux.Types.read Bearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn
      if Mx.mhNum (Mx.msHeader sdu) == ptclNum
        then return (Mx.msBlob sdu, t_e)
        else nextMsg bearer timeoutfn ptclNum

    keepAlive :: Mx.Bearer IO
              -> TimeoutFn IO
              -> String
              -> NodeVersion
              -> TDigest 5
              -> Word32
              -> IO ()
    keepAlive :: Bearer IO
-> TimeoutFn IO
-> String
-> NodeVersion
-> TDigest 5
-> Word32
-> IO ()
keepAlive Bearer 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 Bearer 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 <- Bearer IO -> TimeoutFn IO -> SDU -> IO Time
forall (m :: * -> *). Bearer m -> TimeoutFn m -> SDU -> m Time
write Bearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn (SDU -> IO Time) -> SDU -> IO Time
forall a b. (a -> b) -> a -> b
$ MiniProtocolNum -> MiniProtocolDir -> ByteString -> SDU
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 :: Mx.Bearer IO
           -> TimeoutFn IO
           -> String
           -> IO ()
    getTip :: Bearer IO -> TimeoutFn IO -> String -> IO ()
getTip Bearer IO
bearer TimeoutFn IO
timeoutfn String
peerStr = do
      !t_s <- Bearer IO -> TimeoutFn IO -> SDU -> IO Time
forall (m :: * -> *). Bearer m -> TimeoutFn m -> SDU -> m Time
write Bearer IO
bearer DiffTime -> IO a -> IO (Maybe a)
TimeoutFn IO
timeoutfn (SDU -> IO Time) -> SDU -> IO Time
forall a b. (a -> b) -> a -> b
$ MiniProtocolNum -> MiniProtocolDir -> ByteString -> SDU
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 (NodeToClientVersionV18 Word32
m) = (-Int
18, Word32
m)
        extract (NodeToClientVersionV19 Word32
m) = (-Int
19, 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)
        extract (NodeToNodeVersionV14 Word32
m InitiatorOnly
_ PeerSharing
_) = (Int
14, Word32
m)