make NodeState a typeclasse, define setters and getters on its representations
contributes to #20
This commit is contained in:
parent
99a2b0ba09
commit
fe673dc255
|
@ -44,7 +44,7 @@ NodeState ::= SEQUENCE {
|
||||||
domain Domain,
|
domain Domain,
|
||||||
ipAddr OCTET STRING (SIZE(16)),
|
ipAddr OCTET STRING (SIZE(16)),
|
||||||
dhtPort INTEGER,
|
dhtPort INTEGER,
|
||||||
apPort INTEGER,
|
servicePort INTEGER,
|
||||||
vServerID INTEGER (0..255)
|
vServerID INTEGER (0..255)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -125,26 +125,26 @@ a `localCompare` b
|
||||||
|
|
||||||
|
|
||||||
-- | represents a node and all its important state
|
-- | represents a node and all its important state
|
||||||
data NodeState = NodeState
|
data RemoteNodeState = RemoteNodeState
|
||||||
{ nid :: NodeID
|
{ nid :: NodeID
|
||||||
, domain :: String
|
, domain :: String
|
||||||
-- ^ full public domain name the node is reachable under
|
-- ^ full public domain name the node is reachable under
|
||||||
, ipAddr :: HostAddress6
|
, ipAddr :: HostAddress6
|
||||||
-- the node's public IPv6 address
|
-- the node's public IPv6 address
|
||||||
, dhtPort :: PortNumber
|
, dhtPort :: PortNumber
|
||||||
-- ^ port of the DHT itself
|
-- ^ port of the DHT itself
|
||||||
, apPort :: Maybe PortNumber
|
, servicePort :: PortNumber
|
||||||
-- ^ port of the ActivityPub relay and storage service
|
-- ^ port of the service provided on top of the DHT
|
||||||
, vServerID :: Integer
|
, vServerID :: Integer
|
||||||
-- ^ ID of this vserver
|
-- ^ ID of this vserver
|
||||||
, internals :: Maybe InternalNodeState
|
|
||||||
-- ^ data not present in the representation of remote nodes
|
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- | encapsulates all data and parameters that are not present for remote nodes
|
-- | represents a node and encapsulates all data and parameters that are not present for remote nodes
|
||||||
data InternalNodeState = InternalNodeState
|
data LocalNodeState = LocalNodeState
|
||||||
{ nodeCache :: IORef NodeCache
|
{ nodeState :: RemoteNodeState
|
||||||
|
-- ^ represents common data present both in remote and local node representations
|
||||||
|
, nodeCache :: IORef NodeCache
|
||||||
-- ^ EpiChord node cache with expiry times for nodes
|
-- ^ EpiChord node cache with expiry times for nodes
|
||||||
, cacheWriteQueue :: TQueue (NodeCache -> NodeCache)
|
, cacheWriteQueue :: TQueue (NodeCache -> NodeCache)
|
||||||
-- ^ cache updates are not written directly to the 'nodeCache' but queued and
|
-- ^ cache updates are not written directly to the 'nodeCache' but queued and
|
||||||
|
@ -163,6 +163,60 @@ data InternalNodeState = InternalNodeState
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- | class for various NodeState representations, providing
|
||||||
|
-- getters and setters for common values
|
||||||
|
class NodeState a where
|
||||||
|
-- getters for common properties
|
||||||
|
getNid :: a -> NodeID
|
||||||
|
getDomain :: a -> String
|
||||||
|
getIpAddr :: a -> HostAddress6
|
||||||
|
getDhtPort :: a -> PortNumber
|
||||||
|
getServicePort :: a -> PortNumber
|
||||||
|
getVServerID :: a -> Integer
|
||||||
|
-- setters for common properties
|
||||||
|
setNid :: NodeID -> a -> a
|
||||||
|
setDomain :: String -> a -> a
|
||||||
|
setIpAddr :: HostAddress6 -> a -> a
|
||||||
|
setDhtPort :: PortNumber -> a -> a
|
||||||
|
setServicePort :: PortNumber -> a -> a
|
||||||
|
setVServerID :: Integer -> a -> a
|
||||||
|
|
||||||
|
instance NodeState RemoteNodeState where
|
||||||
|
getNid = nid
|
||||||
|
getDomain = domain
|
||||||
|
getIpAddr = ipAddr
|
||||||
|
getDhtPort = dhtPort
|
||||||
|
getServicePort = servicePort
|
||||||
|
getVServerID = vServerID
|
||||||
|
setNid nid' ns = ns {nid = nid'}
|
||||||
|
setDomain domain' ns = ns {domain = domain'}
|
||||||
|
setIpAddr ipAddr' ns = ns {ipAddr = ipAddr'}
|
||||||
|
setDhtPort dhtPort' ns = ns {dhtPort = dhtPort'}
|
||||||
|
setServicePort servicePort' ns = ns {servicePort = servicePort'}
|
||||||
|
setVServerID vServerID' ns = ns {vServerID = vServerID'}
|
||||||
|
|
||||||
|
-- | helper function for setting values on the 'RemoteNodeState' contained in the 'LocalNodeState'
|
||||||
|
propagateNodeStateSet_ :: (RemoteNodeState -> RemoteNodeState) -> LocalNodeState -> LocalNodeState
|
||||||
|
propagateNodeStateSet_ func ns = let
|
||||||
|
newNs = func $ nodeState ns
|
||||||
|
in
|
||||||
|
ns {nodeState = newNs}
|
||||||
|
|
||||||
|
|
||||||
|
instance NodeState LocalNodeState where
|
||||||
|
getNid = getNid . nodeState
|
||||||
|
getDomain = getDomain . nodeState
|
||||||
|
getIpAddr = getIpAddr . nodeState
|
||||||
|
getDhtPort = getDhtPort . nodeState
|
||||||
|
getServicePort = getServicePort . nodeState
|
||||||
|
getVServerID = getVServerID . nodeState
|
||||||
|
setNid nid' = propagateNodeStateSet_ $ setNid nid'
|
||||||
|
setDomain domain' = propagateNodeStateSet_ $ setDomain domain'
|
||||||
|
setIpAddr ipAddr' = propagateNodeStateSet_ $ setIpAddr ipAddr'
|
||||||
|
setDhtPort dhtPort' = propagateNodeStateSet_ $ setDhtPort dhtPort'
|
||||||
|
setServicePort servicePort' = propagateNodeStateSet_ $ setServicePort servicePort'
|
||||||
|
setVServerID vServerID' = propagateNodeStateSet_ $ setVServerID vServerID'
|
||||||
|
|
||||||
-- | defining Show instances to be able to print NodeState for debug purposes
|
-- | defining Show instances to be able to print NodeState for debug purposes
|
||||||
instance Typeable a => Show (IORef a) where
|
instance Typeable a => Show (IORef a) where
|
||||||
show x = show (typeOf x)
|
show x = show (typeOf x)
|
||||||
|
@ -170,18 +224,6 @@ instance Typeable a => Show (IORef a) where
|
||||||
instance Typeable a => Show (TQueue a) where
|
instance Typeable a => Show (TQueue a) where
|
||||||
show x = show (typeOf x)
|
show x = show (typeOf x)
|
||||||
|
|
||||||
-- | extract a value from the internals of a 'NodeState'
|
|
||||||
getInternals_ :: (InternalNodeState -> a) -> NodeState -> Maybe a
|
|
||||||
getInternals_ func ns = func <$> internals ns
|
|
||||||
|
|
||||||
-- could be done better with lenses
|
|
||||||
-- | convenience function that updates an internal value of a NodeState
|
|
||||||
putInternals_ :: (InternalNodeState -> InternalNodeState) -> NodeState -> NodeState
|
|
||||||
putInternals_ func ns = let
|
|
||||||
newInternals = func <$> internals ns
|
|
||||||
in
|
|
||||||
ns {internals = newInternals }
|
|
||||||
|
|
||||||
-- | convenience function for extracting the 'NodeCache' from a 'NodeState'
|
-- | convenience function for extracting the 'NodeCache' from a 'NodeState'
|
||||||
getNodeCacheRef :: NodeState -> Maybe (IORef NodeCache)
|
getNodeCacheRef :: NodeState -> Maybe (IORef NodeCache)
|
||||||
getNodeCacheRef = getInternals_ nodeCache
|
getNodeCacheRef = getInternals_ nodeCache
|
||||||
|
|
Loading…
Reference in a new issue