{-# LANGUAGE Strict #-}

module Foreign.Erlang.NodeData
    ( DistributionVersion(..)
    , matchDistributionVersion
    , DistributionFlag(..)
    , DistributionFlags(..)
    , NodeType(..)
    , NodeProtocol(..)
    , NodeData(..)
    ) where

import qualified Data.ByteString as BS
import           Data.Binary
import           Data.Binary.Put
import           Data.Binary.Get
import           Data.Bits
import           Data.Ix

import           Util.Binary

--------------------------------------------------------------------------------
data DistributionVersion = Zero | R4 | NeverUsed | R5C | R6 | R6B
    deriving (DistributionVersion -> DistributionVersion -> Bool
(DistributionVersion -> DistributionVersion -> Bool)
-> (DistributionVersion -> DistributionVersion -> Bool)
-> Eq DistributionVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistributionVersion -> DistributionVersion -> Bool
$c/= :: DistributionVersion -> DistributionVersion -> Bool
== :: DistributionVersion -> DistributionVersion -> Bool
$c== :: DistributionVersion -> DistributionVersion -> Bool
Eq, Int -> DistributionVersion -> ShowS
[DistributionVersion] -> ShowS
DistributionVersion -> String
(Int -> DistributionVersion -> ShowS)
-> (DistributionVersion -> String)
-> ([DistributionVersion] -> ShowS)
-> Show DistributionVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistributionVersion] -> ShowS
$cshowList :: [DistributionVersion] -> ShowS
show :: DistributionVersion -> String
$cshow :: DistributionVersion -> String
showsPrec :: Int -> DistributionVersion -> ShowS
$cshowsPrec :: Int -> DistributionVersion -> ShowS
Show, Int -> DistributionVersion
DistributionVersion -> Int
DistributionVersion -> [DistributionVersion]
DistributionVersion -> DistributionVersion
DistributionVersion -> DistributionVersion -> [DistributionVersion]
DistributionVersion
-> DistributionVersion
-> DistributionVersion
-> [DistributionVersion]
(DistributionVersion -> DistributionVersion)
-> (DistributionVersion -> DistributionVersion)
-> (Int -> DistributionVersion)
-> (DistributionVersion -> Int)
-> (DistributionVersion -> [DistributionVersion])
-> (DistributionVersion
    -> DistributionVersion -> [DistributionVersion])
-> (DistributionVersion
    -> DistributionVersion -> [DistributionVersion])
-> (DistributionVersion
    -> DistributionVersion
    -> DistributionVersion
    -> [DistributionVersion])
-> Enum DistributionVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DistributionVersion
-> DistributionVersion
-> DistributionVersion
-> [DistributionVersion]
$cenumFromThenTo :: DistributionVersion
-> DistributionVersion
-> DistributionVersion
-> [DistributionVersion]
enumFromTo :: DistributionVersion -> DistributionVersion -> [DistributionVersion]
$cenumFromTo :: DistributionVersion -> DistributionVersion -> [DistributionVersion]
enumFromThen :: DistributionVersion -> DistributionVersion -> [DistributionVersion]
$cenumFromThen :: DistributionVersion -> DistributionVersion -> [DistributionVersion]
enumFrom :: DistributionVersion -> [DistributionVersion]
$cenumFrom :: DistributionVersion -> [DistributionVersion]
fromEnum :: DistributionVersion -> Int
$cfromEnum :: DistributionVersion -> Int
toEnum :: Int -> DistributionVersion
$ctoEnum :: Int -> DistributionVersion
pred :: DistributionVersion -> DistributionVersion
$cpred :: DistributionVersion -> DistributionVersion
succ :: DistributionVersion -> DistributionVersion
$csucc :: DistributionVersion -> DistributionVersion
Enum, DistributionVersion
DistributionVersion
-> DistributionVersion -> Bounded DistributionVersion
forall a. a -> a -> Bounded a
maxBound :: DistributionVersion
$cmaxBound :: DistributionVersion
minBound :: DistributionVersion
$cminBound :: DistributionVersion
Bounded, Eq DistributionVersion
Eq DistributionVersion
-> (DistributionVersion -> DistributionVersion -> Ordering)
-> (DistributionVersion -> DistributionVersion -> Bool)
-> (DistributionVersion -> DistributionVersion -> Bool)
-> (DistributionVersion -> DistributionVersion -> Bool)
-> (DistributionVersion -> DistributionVersion -> Bool)
-> (DistributionVersion
    -> DistributionVersion -> DistributionVersion)
-> (DistributionVersion
    -> DistributionVersion -> DistributionVersion)
-> Ord DistributionVersion
DistributionVersion -> DistributionVersion -> Bool
DistributionVersion -> DistributionVersion -> Ordering
DistributionVersion -> DistributionVersion -> DistributionVersion
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
min :: DistributionVersion -> DistributionVersion -> DistributionVersion
$cmin :: DistributionVersion -> DistributionVersion -> DistributionVersion
max :: DistributionVersion -> DistributionVersion -> DistributionVersion
$cmax :: DistributionVersion -> DistributionVersion -> DistributionVersion
>= :: DistributionVersion -> DistributionVersion -> Bool
$c>= :: DistributionVersion -> DistributionVersion -> Bool
> :: DistributionVersion -> DistributionVersion -> Bool
$c> :: DistributionVersion -> DistributionVersion -> Bool
<= :: DistributionVersion -> DistributionVersion -> Bool
$c<= :: DistributionVersion -> DistributionVersion -> Bool
< :: DistributionVersion -> DistributionVersion -> Bool
$c< :: DistributionVersion -> DistributionVersion -> Bool
compare :: DistributionVersion -> DistributionVersion -> Ordering
$ccompare :: DistributionVersion -> DistributionVersion -> Ordering
$cp1Ord :: Eq DistributionVersion
Ord, Ord DistributionVersion
Ord DistributionVersion
-> ((DistributionVersion, DistributionVersion)
    -> [DistributionVersion])
-> ((DistributionVersion, DistributionVersion)
    -> DistributionVersion -> Int)
-> ((DistributionVersion, DistributionVersion)
    -> DistributionVersion -> Int)
-> ((DistributionVersion, DistributionVersion)
    -> DistributionVersion -> Bool)
-> ((DistributionVersion, DistributionVersion) -> Int)
-> ((DistributionVersion, DistributionVersion) -> Int)
-> Ix DistributionVersion
(DistributionVersion, DistributionVersion) -> Int
(DistributionVersion, DistributionVersion) -> [DistributionVersion]
(DistributionVersion, DistributionVersion)
-> DistributionVersion -> Bool
(DistributionVersion, DistributionVersion)
-> DistributionVersion -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (DistributionVersion, DistributionVersion) -> Int
$cunsafeRangeSize :: (DistributionVersion, DistributionVersion) -> Int
rangeSize :: (DistributionVersion, DistributionVersion) -> Int
$crangeSize :: (DistributionVersion, DistributionVersion) -> Int
inRange :: (DistributionVersion, DistributionVersion)
-> DistributionVersion -> Bool
$cinRange :: (DistributionVersion, DistributionVersion)
-> DistributionVersion -> Bool
unsafeIndex :: (DistributionVersion, DistributionVersion)
-> DistributionVersion -> Int
$cunsafeIndex :: (DistributionVersion, DistributionVersion)
-> DistributionVersion -> Int
index :: (DistributionVersion, DistributionVersion)
-> DistributionVersion -> Int
$cindex :: (DistributionVersion, DistributionVersion)
-> DistributionVersion -> Int
range :: (DistributionVersion, DistributionVersion) -> [DistributionVersion]
$crange :: (DistributionVersion, DistributionVersion) -> [DistributionVersion]
$cp1Ix :: Ord DistributionVersion
Ix)

instance Binary DistributionVersion where
    put :: DistributionVersion -> Put
put = Word16 -> Put
putWord16be (Word16 -> Put)
-> (DistributionVersion -> Word16) -> DistributionVersion -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16)
-> (DistributionVersion -> Int) -> DistributionVersion -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistributionVersion -> Int
forall a. Enum a => a -> Int
fromEnum
    get :: Get DistributionVersion
get = do
        Word16
c <- Get Word16
getWord16be
        DistributionVersion -> Get DistributionVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (DistributionVersion -> Get DistributionVersion)
-> DistributionVersion -> Get DistributionVersion
forall a b. (a -> b) -> a -> b
$ Int -> DistributionVersion
forall a. Enum a => Int -> a
toEnum (Int -> DistributionVersion) -> Int -> DistributionVersion
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
c

--------------------------------------------------------------------------------
matchDistributionVersion :: NodeData -> NodeData -> Maybe DistributionVersion
matchDistributionVersion :: NodeData -> NodeData -> Maybe DistributionVersion
matchDistributionVersion NodeData{protocol :: NodeData -> NodeProtocol
protocol = NodeProtocol
localProto,hiVer :: NodeData -> DistributionVersion
hiVer = DistributionVersion
localHi,loVer :: NodeData -> DistributionVersion
loVer = DistributionVersion
localLo} NodeData{protocol :: NodeData -> NodeProtocol
protocol = NodeProtocol
remoteProto,hiVer :: NodeData -> DistributionVersion
hiVer = DistributionVersion
remoteHi,loVer :: NodeData -> DistributionVersion
loVer = DistributionVersion
remoteLo}
    | NodeProtocol
localProto NodeProtocol -> NodeProtocol -> Bool
forall a. Eq a => a -> a -> Bool
/= NodeProtocol
remoteProto =
          Maybe DistributionVersion
forall a. Maybe a
Nothing
    | DistributionVersion
localHi DistributionVersion -> DistributionVersion -> Bool
forall a. Ord a => a -> a -> Bool
< DistributionVersion
remoteLo = Maybe DistributionVersion
forall a. Maybe a
Nothing
    | DistributionVersion
localLo DistributionVersion -> DistributionVersion -> Bool
forall a. Ord a => a -> a -> Bool
> DistributionVersion
remoteHi = Maybe DistributionVersion
forall a. Maybe a
Nothing
    | Bool
otherwise = DistributionVersion -> Maybe DistributionVersion
forall a. a -> Maybe a
Just (DistributionVersion -> DistributionVersion -> DistributionVersion
forall a. Ord a => a -> a -> a
max DistributionVersion
localHi DistributionVersion
remoteHi)

--------------------------------------------------------------------------------
data DistributionFlag = PUBLISHED            --  The node should be published and part of the global namespace
                      | ATOM_CACHE           --  The node implements an atom cache (obsolete)
                      | EXTENDED_REFERENCES  --  The node implements extended (3 * 32 bits) references. This is required today. If not present connection will be refused.
                      | DIST_MONITOR         --  The node implements distributed process monitoring.
                      | FUN_TAGS             --  The node uses separate tag for fun's (lambdas) in the distribution protocol.
                      | DIST_MONITOR_NAME    --  The node implements distributed named process monitoring.
                      | HIDDEN_ATOM_CACHE    --  The (hidden) node implements atom cache (obsolete)
                      | NEW_FUN_TAGS         --  The node understand new fun-tags
                      | EXTENDED_PIDS_PORTS  --  The node is capable of handling extended pids and ports. This is required today. If not present connection will be refused.
                      | EXPORT_PTR_TAG
                      | BIT_BINARIES
                      | NEW_FLOATS           --  The node understands new float format
                      | UNICODE_IO
                      | DIST_HDR_ATOM_CACHE  --  The node implements atom cache in distribution header.
                      | SMALL_ATOM_TAGS      --  The node understand the smallAtomExt tag
                      | UTF8_ATOMS           --  The node understand UTF-8 encoded atoms
    deriving (DistributionFlag -> DistributionFlag -> Bool
(DistributionFlag -> DistributionFlag -> Bool)
-> (DistributionFlag -> DistributionFlag -> Bool)
-> Eq DistributionFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistributionFlag -> DistributionFlag -> Bool
$c/= :: DistributionFlag -> DistributionFlag -> Bool
== :: DistributionFlag -> DistributionFlag -> Bool
$c== :: DistributionFlag -> DistributionFlag -> Bool
Eq, Int -> DistributionFlag -> ShowS
[DistributionFlag] -> ShowS
DistributionFlag -> String
(Int -> DistributionFlag -> ShowS)
-> (DistributionFlag -> String)
-> ([DistributionFlag] -> ShowS)
-> Show DistributionFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistributionFlag] -> ShowS
$cshowList :: [DistributionFlag] -> ShowS
show :: DistributionFlag -> String
$cshow :: DistributionFlag -> String
showsPrec :: Int -> DistributionFlag -> ShowS
$cshowsPrec :: Int -> DistributionFlag -> ShowS
Show, Int -> DistributionFlag
DistributionFlag -> Int
DistributionFlag -> [DistributionFlag]
DistributionFlag -> DistributionFlag
DistributionFlag -> DistributionFlag -> [DistributionFlag]
DistributionFlag
-> DistributionFlag -> DistributionFlag -> [DistributionFlag]
(DistributionFlag -> DistributionFlag)
-> (DistributionFlag -> DistributionFlag)
-> (Int -> DistributionFlag)
-> (DistributionFlag -> Int)
-> (DistributionFlag -> [DistributionFlag])
-> (DistributionFlag -> DistributionFlag -> [DistributionFlag])
-> (DistributionFlag -> DistributionFlag -> [DistributionFlag])
-> (DistributionFlag
    -> DistributionFlag -> DistributionFlag -> [DistributionFlag])
-> Enum DistributionFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DistributionFlag
-> DistributionFlag -> DistributionFlag -> [DistributionFlag]
$cenumFromThenTo :: DistributionFlag
-> DistributionFlag -> DistributionFlag -> [DistributionFlag]
enumFromTo :: DistributionFlag -> DistributionFlag -> [DistributionFlag]
$cenumFromTo :: DistributionFlag -> DistributionFlag -> [DistributionFlag]
enumFromThen :: DistributionFlag -> DistributionFlag -> [DistributionFlag]
$cenumFromThen :: DistributionFlag -> DistributionFlag -> [DistributionFlag]
enumFrom :: DistributionFlag -> [DistributionFlag]
$cenumFrom :: DistributionFlag -> [DistributionFlag]
fromEnum :: DistributionFlag -> Int
$cfromEnum :: DistributionFlag -> Int
toEnum :: Int -> DistributionFlag
$ctoEnum :: Int -> DistributionFlag
pred :: DistributionFlag -> DistributionFlag
$cpred :: DistributionFlag -> DistributionFlag
succ :: DistributionFlag -> DistributionFlag
$csucc :: DistributionFlag -> DistributionFlag
Enum, DistributionFlag
DistributionFlag -> DistributionFlag -> Bounded DistributionFlag
forall a. a -> a -> Bounded a
maxBound :: DistributionFlag
$cmaxBound :: DistributionFlag
minBound :: DistributionFlag
$cminBound :: DistributionFlag
Bounded, Eq DistributionFlag
Eq DistributionFlag
-> (DistributionFlag -> DistributionFlag -> Ordering)
-> (DistributionFlag -> DistributionFlag -> Bool)
-> (DistributionFlag -> DistributionFlag -> Bool)
-> (DistributionFlag -> DistributionFlag -> Bool)
-> (DistributionFlag -> DistributionFlag -> Bool)
-> (DistributionFlag -> DistributionFlag -> DistributionFlag)
-> (DistributionFlag -> DistributionFlag -> DistributionFlag)
-> Ord DistributionFlag
DistributionFlag -> DistributionFlag -> Bool
DistributionFlag -> DistributionFlag -> Ordering
DistributionFlag -> DistributionFlag -> DistributionFlag
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
min :: DistributionFlag -> DistributionFlag -> DistributionFlag
$cmin :: DistributionFlag -> DistributionFlag -> DistributionFlag
max :: DistributionFlag -> DistributionFlag -> DistributionFlag
$cmax :: DistributionFlag -> DistributionFlag -> DistributionFlag
>= :: DistributionFlag -> DistributionFlag -> Bool
$c>= :: DistributionFlag -> DistributionFlag -> Bool
> :: DistributionFlag -> DistributionFlag -> Bool
$c> :: DistributionFlag -> DistributionFlag -> Bool
<= :: DistributionFlag -> DistributionFlag -> Bool
$c<= :: DistributionFlag -> DistributionFlag -> Bool
< :: DistributionFlag -> DistributionFlag -> Bool
$c< :: DistributionFlag -> DistributionFlag -> Bool
compare :: DistributionFlag -> DistributionFlag -> Ordering
$ccompare :: DistributionFlag -> DistributionFlag -> Ordering
$cp1Ord :: Eq DistributionFlag
Ord)

newtype DistributionFlags = DistributionFlags [DistributionFlag]
    deriving (DistributionFlags -> DistributionFlags -> Bool
(DistributionFlags -> DistributionFlags -> Bool)
-> (DistributionFlags -> DistributionFlags -> Bool)
-> Eq DistributionFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistributionFlags -> DistributionFlags -> Bool
$c/= :: DistributionFlags -> DistributionFlags -> Bool
== :: DistributionFlags -> DistributionFlags -> Bool
$c== :: DistributionFlags -> DistributionFlags -> Bool
Eq, Int -> DistributionFlags -> ShowS
[DistributionFlags] -> ShowS
DistributionFlags -> String
(Int -> DistributionFlags -> ShowS)
-> (DistributionFlags -> String)
-> ([DistributionFlags] -> ShowS)
-> Show DistributionFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistributionFlags] -> ShowS
$cshowList :: [DistributionFlags] -> ShowS
show :: DistributionFlags -> String
$cshow :: DistributionFlags -> String
showsPrec :: Int -> DistributionFlags -> ShowS
$cshowsPrec :: Int -> DistributionFlags -> ShowS
Show)

instance Binary DistributionFlags where
    put :: DistributionFlags -> Put
put (DistributionFlags [DistributionFlag]
flags) = do
        Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ [DistributionFlag] -> Word32
toBits [DistributionFlag]
flags
      where
        toBits :: [DistributionFlag] -> Word32
        toBits :: [DistributionFlag] -> Word32
toBits = (Word32 -> DistributionFlag -> Word32)
-> Word32 -> [DistributionFlag] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((DistributionFlag -> Word32 -> Word32)
-> Word32 -> DistributionFlag -> Word32
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((DistributionFlag -> Word32 -> Word32)
 -> Word32 -> DistributionFlag -> Word32)
-> (DistributionFlag -> Word32 -> Word32)
-> Word32
-> DistributionFlag
-> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.|.) (Word32 -> Word32 -> Word32)
-> (DistributionFlag -> Word32)
-> DistributionFlag
-> Word32
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistributionFlag -> Word32
toBit) Word32
0
    get :: Get DistributionFlags
get = do
        ([DistributionFlag] -> DistributionFlags
DistributionFlags ([DistributionFlag] -> DistributionFlags)
-> (Word32 -> [DistributionFlag]) -> Word32 -> DistributionFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [DistributionFlag]
fromBits) (Word32 -> DistributionFlags)
-> Get Word32 -> Get DistributionFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
      where
        fromBits :: Word32 -> [DistributionFlag]
        fromBits :: Word32 -> [DistributionFlag]
fromBits Word32
bits = [ DistributionFlag
flag
                        | DistributionFlag
flag <- [DistributionFlag
forall a. Bounded a => a
minBound .. DistributionFlag
forall a. Bounded a => a
maxBound]
                        , Word32
bits Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. DistributionFlag -> Word32
toBit DistributionFlag
flag Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 ]

toBit :: DistributionFlag -> Word32
toBit :: DistributionFlag -> Word32
toBit DistributionFlag
PUBLISHED = Word32
0x00001
toBit DistributionFlag
ATOM_CACHE = Word32
0x00002
toBit DistributionFlag
EXTENDED_REFERENCES =
    Word32
0x00004
toBit DistributionFlag
DIST_MONITOR = Word32
0x00008
toBit DistributionFlag
FUN_TAGS = Word32
0x00010
toBit DistributionFlag
DIST_MONITOR_NAME =
    Word32
0x00020 -- NOT USED
toBit DistributionFlag
HIDDEN_ATOM_CACHE =
    Word32
0x00040 -- NOT SUPPORTED
toBit DistributionFlag
NEW_FUN_TAGS = Word32
0x00080
toBit DistributionFlag
EXTENDED_PIDS_PORTS =
    Word32
0x00100
toBit DistributionFlag
EXPORT_PTR_TAG = Word32
0x00200 -- NOT SUPPORTED
toBit DistributionFlag
BIT_BINARIES = Word32
0x00400
toBit DistributionFlag
NEW_FLOATS = Word32
0x00800
toBit DistributionFlag
UNICODE_IO = Word32
0x01000
toBit DistributionFlag
DIST_HDR_ATOM_CACHE =
    Word32
0x02000
toBit DistributionFlag
SMALL_ATOM_TAGS = Word32
0x04000
toBit DistributionFlag
UTF8_ATOMS = Word32
0x10000

--------------------------------------------------------------------------------
data NodeType = NormalNode | HiddenNode
    deriving (NodeType -> NodeType -> Bool
(NodeType -> NodeType -> Bool)
-> (NodeType -> NodeType -> Bool) -> Eq NodeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeType -> NodeType -> Bool
$c/= :: NodeType -> NodeType -> Bool
== :: NodeType -> NodeType -> Bool
$c== :: NodeType -> NodeType -> Bool
Eq, Int -> NodeType -> ShowS
[NodeType] -> ShowS
NodeType -> String
(Int -> NodeType -> ShowS)
-> (NodeType -> String) -> ([NodeType] -> ShowS) -> Show NodeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeType] -> ShowS
$cshowList :: [NodeType] -> ShowS
show :: NodeType -> String
$cshow :: NodeType -> String
showsPrec :: Int -> NodeType -> ShowS
$cshowsPrec :: Int -> NodeType -> ShowS
Show, Int -> NodeType
NodeType -> Int
NodeType -> [NodeType]
NodeType -> NodeType
NodeType -> NodeType -> [NodeType]
NodeType -> NodeType -> NodeType -> [NodeType]
(NodeType -> NodeType)
-> (NodeType -> NodeType)
-> (Int -> NodeType)
-> (NodeType -> Int)
-> (NodeType -> [NodeType])
-> (NodeType -> NodeType -> [NodeType])
-> (NodeType -> NodeType -> [NodeType])
-> (NodeType -> NodeType -> NodeType -> [NodeType])
-> Enum NodeType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NodeType -> NodeType -> NodeType -> [NodeType]
$cenumFromThenTo :: NodeType -> NodeType -> NodeType -> [NodeType]
enumFromTo :: NodeType -> NodeType -> [NodeType]
$cenumFromTo :: NodeType -> NodeType -> [NodeType]
enumFromThen :: NodeType -> NodeType -> [NodeType]
$cenumFromThen :: NodeType -> NodeType -> [NodeType]
enumFrom :: NodeType -> [NodeType]
$cenumFrom :: NodeType -> [NodeType]
fromEnum :: NodeType -> Int
$cfromEnum :: NodeType -> Int
toEnum :: Int -> NodeType
$ctoEnum :: Int -> NodeType
pred :: NodeType -> NodeType
$cpred :: NodeType -> NodeType
succ :: NodeType -> NodeType
$csucc :: NodeType -> NodeType
Enum, NodeType
NodeType -> NodeType -> Bounded NodeType
forall a. a -> a -> Bounded a
maxBound :: NodeType
$cmaxBound :: NodeType
minBound :: NodeType
$cminBound :: NodeType
Bounded)

instance Binary NodeType where
    put :: NodeType -> Put
put NodeType
NormalNode = Word8 -> Put
putWord8 Word8
77
    put NodeType
HiddenNode = Word8 -> Put
putWord8 Word8
72
    get :: Get NodeType
get = do
        Word8
nodeType <- Get Word8
getWord8
        case Word8
nodeType of
            Word8
77 -> NodeType -> Get NodeType
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
NormalNode
            Word8
72 -> NodeType -> Get NodeType
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
HiddenNode
            Word8
_ -> String -> Get NodeType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get NodeType) -> String -> Get NodeType
forall a b. (a -> b) -> a -> b
$ String
"Bad node type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
nodeType

--------------------------------------------------------------------------------
data NodeProtocol = TcpIpV4
    deriving (NodeProtocol -> NodeProtocol -> Bool
(NodeProtocol -> NodeProtocol -> Bool)
-> (NodeProtocol -> NodeProtocol -> Bool) -> Eq NodeProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeProtocol -> NodeProtocol -> Bool
$c/= :: NodeProtocol -> NodeProtocol -> Bool
== :: NodeProtocol -> NodeProtocol -> Bool
$c== :: NodeProtocol -> NodeProtocol -> Bool
Eq, Int -> NodeProtocol -> ShowS
[NodeProtocol] -> ShowS
NodeProtocol -> String
(Int -> NodeProtocol -> ShowS)
-> (NodeProtocol -> String)
-> ([NodeProtocol] -> ShowS)
-> Show NodeProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeProtocol] -> ShowS
$cshowList :: [NodeProtocol] -> ShowS
show :: NodeProtocol -> String
$cshow :: NodeProtocol -> String
showsPrec :: Int -> NodeProtocol -> ShowS
$cshowsPrec :: Int -> NodeProtocol -> ShowS
Show, Int -> NodeProtocol
NodeProtocol -> Int
NodeProtocol -> [NodeProtocol]
NodeProtocol -> NodeProtocol
NodeProtocol -> NodeProtocol -> [NodeProtocol]
NodeProtocol -> NodeProtocol -> NodeProtocol -> [NodeProtocol]
(NodeProtocol -> NodeProtocol)
-> (NodeProtocol -> NodeProtocol)
-> (Int -> NodeProtocol)
-> (NodeProtocol -> Int)
-> (NodeProtocol -> [NodeProtocol])
-> (NodeProtocol -> NodeProtocol -> [NodeProtocol])
-> (NodeProtocol -> NodeProtocol -> [NodeProtocol])
-> (NodeProtocol -> NodeProtocol -> NodeProtocol -> [NodeProtocol])
-> Enum NodeProtocol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NodeProtocol -> NodeProtocol -> NodeProtocol -> [NodeProtocol]
$cenumFromThenTo :: NodeProtocol -> NodeProtocol -> NodeProtocol -> [NodeProtocol]
enumFromTo :: NodeProtocol -> NodeProtocol -> [NodeProtocol]
$cenumFromTo :: NodeProtocol -> NodeProtocol -> [NodeProtocol]
enumFromThen :: NodeProtocol -> NodeProtocol -> [NodeProtocol]
$cenumFromThen :: NodeProtocol -> NodeProtocol -> [NodeProtocol]
enumFrom :: NodeProtocol -> [NodeProtocol]
$cenumFrom :: NodeProtocol -> [NodeProtocol]
fromEnum :: NodeProtocol -> Int
$cfromEnum :: NodeProtocol -> Int
toEnum :: Int -> NodeProtocol
$ctoEnum :: Int -> NodeProtocol
pred :: NodeProtocol -> NodeProtocol
$cpred :: NodeProtocol -> NodeProtocol
succ :: NodeProtocol -> NodeProtocol
$csucc :: NodeProtocol -> NodeProtocol
Enum, NodeProtocol
NodeProtocol -> NodeProtocol -> Bounded NodeProtocol
forall a. a -> a -> Bounded a
maxBound :: NodeProtocol
$cmaxBound :: NodeProtocol
minBound :: NodeProtocol
$cminBound :: NodeProtocol
Bounded)

instance Binary NodeProtocol where
    put :: NodeProtocol -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (NodeProtocol -> Word8) -> NodeProtocol -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (NodeProtocol -> Int) -> NodeProtocol -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeProtocol -> Int
forall a. Enum a => a -> Int
fromEnum
    get :: Get NodeProtocol
get = do
        Word8
c <- Get Word8
getWord8
        NodeProtocol -> Get NodeProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeProtocol -> Get NodeProtocol)
-> NodeProtocol -> Get NodeProtocol
forall a b. (a -> b) -> a -> b
$ Int -> NodeProtocol
forall a. Enum a => Int -> a
toEnum (Int -> NodeProtocol) -> Int -> NodeProtocol
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c

--------------------------------------------------------------------------------
data NodeData = NodeData { NodeData -> Word16
portNo    :: Word16
                         , NodeData -> NodeType
nodeType  :: NodeType
                         , NodeData -> NodeProtocol
protocol  :: NodeProtocol
                         , NodeData -> DistributionVersion
hiVer     :: DistributionVersion
                         , NodeData -> DistributionVersion
loVer     :: DistributionVersion
                         , NodeData -> ByteString
aliveName :: BS.ByteString
                         , NodeData -> ByteString
extra     :: BS.ByteString
                         }
    deriving (NodeData -> NodeData -> Bool
(NodeData -> NodeData -> Bool)
-> (NodeData -> NodeData -> Bool) -> Eq NodeData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeData -> NodeData -> Bool
$c/= :: NodeData -> NodeData -> Bool
== :: NodeData -> NodeData -> Bool
$c== :: NodeData -> NodeData -> Bool
Eq, Int -> NodeData -> ShowS
[NodeData] -> ShowS
NodeData -> String
(Int -> NodeData -> ShowS)
-> (NodeData -> String) -> ([NodeData] -> ShowS) -> Show NodeData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeData] -> ShowS
$cshowList :: [NodeData] -> ShowS
show :: NodeData -> String
$cshow :: NodeData -> String
showsPrec :: Int -> NodeData -> ShowS
$cshowsPrec :: Int -> NodeData -> ShowS
Show)

--------------------------------------------------------------------------------
instance Binary NodeData where
    put :: NodeData -> Put
put NodeData{Word16
portNo :: Word16
portNo :: NodeData -> Word16
portNo,NodeType
nodeType :: NodeType
nodeType :: NodeData -> NodeType
nodeType,NodeProtocol
protocol :: NodeProtocol
protocol :: NodeData -> NodeProtocol
protocol,DistributionVersion
hiVer :: DistributionVersion
hiVer :: NodeData -> DistributionVersion
hiVer,DistributionVersion
loVer :: DistributionVersion
loVer :: NodeData -> DistributionVersion
loVer,ByteString
aliveName :: ByteString
aliveName :: NodeData -> ByteString
aliveName,ByteString
extra :: ByteString
extra :: NodeData -> ByteString
extra} = do
        Word16 -> Put
putWord16be Word16
portNo
        NodeType -> Put
forall t. Binary t => t -> Put
put NodeType
nodeType
        NodeProtocol -> Put
forall t. Binary t => t -> Put
put NodeProtocol
protocol
        DistributionVersion -> Put
forall t. Binary t => t -> Put
put DistributionVersion
hiVer
        DistributionVersion -> Put
forall t. Binary t => t -> Put
put DistributionVersion
loVer
        HasCallStack => ByteString -> Put
ByteString -> Put
putLength16beByteString ByteString
aliveName
        HasCallStack => ByteString -> Put
ByteString -> Put
putLength16beByteString ByteString
extra
    get :: Get NodeData
get = do
        Word16
-> NodeType
-> NodeProtocol
-> DistributionVersion
-> DistributionVersion
-> ByteString
-> ByteString
-> NodeData
NodeData (Word16
 -> NodeType
 -> NodeProtocol
 -> DistributionVersion
 -> DistributionVersion
 -> ByteString
 -> ByteString
 -> NodeData)
-> Get Word16
-> Get
     (NodeType
      -> NodeProtocol
      -> DistributionVersion
      -> DistributionVersion
      -> ByteString
      -> ByteString
      -> NodeData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
                 Get
  (NodeType
   -> NodeProtocol
   -> DistributionVersion
   -> DistributionVersion
   -> ByteString
   -> ByteString
   -> NodeData)
-> Get NodeType
-> Get
     (NodeProtocol
      -> DistributionVersion
      -> DistributionVersion
      -> ByteString
      -> ByteString
      -> NodeData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get NodeType
forall t. Binary t => Get t
get
                 Get
  (NodeProtocol
   -> DistributionVersion
   -> DistributionVersion
   -> ByteString
   -> ByteString
   -> NodeData)
-> Get NodeProtocol
-> Get
     (DistributionVersion
      -> DistributionVersion -> ByteString -> ByteString -> NodeData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get NodeProtocol
forall t. Binary t => Get t
get
                 Get
  (DistributionVersion
   -> DistributionVersion -> ByteString -> ByteString -> NodeData)
-> Get DistributionVersion
-> Get
     (DistributionVersion -> ByteString -> ByteString -> NodeData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DistributionVersion
forall t. Binary t => Get t
get
                 Get (DistributionVersion -> ByteString -> ByteString -> NodeData)
-> Get DistributionVersion
-> Get (ByteString -> ByteString -> NodeData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DistributionVersion
forall t. Binary t => Get t
get
                 Get (ByteString -> ByteString -> NodeData)
-> Get ByteString -> Get (ByteString -> NodeData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
HasCallStack => Get ByteString
getLength16beByteString
                 Get (ByteString -> NodeData) -> Get ByteString -> Get NodeData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
HasCallStack => Get ByteString
getLength16beByteString