{-# 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 (Eq, Show, Enum, Bounded, Ord, Ix)
instance Binary DistributionVersion where
put = putWord16be . fromIntegral . fromEnum
get = do
c <- getWord16be
return $ toEnum $ fromIntegral c
matchDistributionVersion :: NodeData -> NodeData -> Maybe DistributionVersion
matchDistributionVersion NodeData{protocol = localProto,hiVer = localHi,loVer = localLo} NodeData{protocol = remoteProto,hiVer = remoteHi,loVer = remoteLo}
| localProto /= remoteProto =
Nothing
| localHi < remoteLo = Nothing
| localLo > remoteHi = Nothing
| otherwise = Just (max localHi remoteHi)
data DistributionFlag = PUBLISHED
| ATOM_CACHE
| EXTENDED_REFERENCES
| DIST_MONITOR
| FUN_TAGS
| DIST_MONITOR_NAME
| HIDDEN_ATOM_CACHE
| NEW_FUN_TAGS
| EXTENDED_PIDS_PORTS
| EXPORT_PTR_TAG
| BIT_BINARIES
| NEW_FLOATS
| UNICODE_IO
| DIST_HDR_ATOM_CACHE
| SMALL_ATOM_TAGS
| UTF8_ATOMS
deriving (Eq, Show, Enum, Bounded, Ord)
newtype DistributionFlags = DistributionFlags [DistributionFlag]
deriving (Eq, Show)
instance Binary DistributionFlags where
put (DistributionFlags flags) = do
putWord32be $ toBits flags
where
toBits :: [DistributionFlag] -> Word32
toBits = foldl (flip $ (.|.) . toBit) 0
get = do
(DistributionFlags . fromBits) <$> getWord32be
where
fromBits :: Word32 -> [DistributionFlag]
fromBits bits = [ flag
| flag <- [minBound .. maxBound]
, bits .&. toBit flag /= 0 ]
toBit :: DistributionFlag -> Word32
toBit PUBLISHED = 0x00001
toBit ATOM_CACHE = 0x00002
toBit EXTENDED_REFERENCES =
0x00004
toBit DIST_MONITOR = 0x00008
toBit FUN_TAGS = 0x00010
toBit DIST_MONITOR_NAME =
0x00020
toBit HIDDEN_ATOM_CACHE =
0x00040
toBit NEW_FUN_TAGS = 0x00080
toBit EXTENDED_PIDS_PORTS =
0x00100
toBit EXPORT_PTR_TAG = 0x00200
toBit BIT_BINARIES = 0x00400
toBit NEW_FLOATS = 0x00800
toBit UNICODE_IO = 0x01000
toBit DIST_HDR_ATOM_CACHE =
0x02000
toBit SMALL_ATOM_TAGS = 0x04000
toBit UTF8_ATOMS = 0x10000
data NodeType = NormalNode | HiddenNode
deriving (Eq, Show, Enum, Bounded)
instance Binary NodeType where
put NormalNode = putWord8 77
put HiddenNode = putWord8 72
get = do
nodeType <- getWord8
case nodeType of
77 -> return NormalNode
72 -> return HiddenNode
_ -> fail $ "Bad node type: " ++ show nodeType
data NodeProtocol = TcpIpV4
deriving (Eq, Show, Enum, Bounded)
instance Binary NodeProtocol where
put = putWord8 . fromIntegral . fromEnum
get = do
c <- getWord8
return $ toEnum $ fromIntegral c
data NodeData = NodeData { portNo :: Word16
, nodeType :: NodeType
, protocol :: NodeProtocol
, hiVer :: DistributionVersion
, loVer :: DistributionVersion
, aliveName :: BS.ByteString
, extra :: BS.ByteString
}
deriving (Eq, Show)
instance Binary NodeData where
put NodeData{portNo,nodeType,protocol,hiVer,loVer,aliveName,extra} = do
putWord16be portNo
put nodeType
put protocol
put hiVer
put loVer
putLength16beByteString aliveName
putLength16beByteString extra
get = do
NodeData <$> getWord16be
<*> get
<*> get
<*> get
<*> get
<*> getLength16beByteString
<*> getLength16beByteString