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,
|
||||
ipAddr OCTET STRING (SIZE(16)),
|
||||
dhtPort INTEGER,
|
||||
apPort INTEGER,
|
||||
servicePort INTEGER,
|
||||
vServerID INTEGER (0..255)
|
||||
}
|
||||
|
||||
|
|
|
@ -125,7 +125,7 @@ a `localCompare` b
|
|||
|
||||
|
||||
-- | represents a node and all its important state
|
||||
data NodeState = NodeState
|
||||
data RemoteNodeState = RemoteNodeState
|
||||
{ nid :: NodeID
|
||||
, domain :: String
|
||||
-- ^ full public domain name the node is reachable under
|
||||
|
@ -133,18 +133,18 @@ data NodeState = NodeState
|
|||
-- the node's public IPv6 address
|
||||
, dhtPort :: PortNumber
|
||||
-- ^ port of the DHT itself
|
||||
, apPort :: Maybe PortNumber
|
||||
-- ^ port of the ActivityPub relay and storage service
|
||||
, servicePort :: PortNumber
|
||||
-- ^ port of the service provided on top of the DHT
|
||||
, vServerID :: Integer
|
||||
-- ^ ID of this vserver
|
||||
, internals :: Maybe InternalNodeState
|
||||
-- ^ data not present in the representation of remote nodes
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | encapsulates all data and parameters that are not present for remote nodes
|
||||
data InternalNodeState = InternalNodeState
|
||||
{ nodeCache :: IORef NodeCache
|
||||
-- | represents a node and encapsulates all data and parameters that are not present for remote nodes
|
||||
data LocalNodeState = LocalNodeState
|
||||
{ nodeState :: RemoteNodeState
|
||||
-- ^ represents common data present both in remote and local node representations
|
||||
, nodeCache :: IORef NodeCache
|
||||
-- ^ EpiChord node cache with expiry times for nodes
|
||||
, cacheWriteQueue :: TQueue (NodeCache -> NodeCache)
|
||||
-- ^ cache updates are not written directly to the 'nodeCache' but queued and
|
||||
|
@ -163,6 +163,60 @@ data InternalNodeState = InternalNodeState
|
|||
}
|
||||
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
|
||||
instance Typeable a => Show (IORef a) where
|
||||
show x = show (typeOf x)
|
||||
|
@ -170,18 +224,6 @@ instance Typeable a => Show (IORef a) where
|
|||
instance Typeable a => Show (TQueue a) where
|
||||
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'
|
||||
getNodeCacheRef :: NodeState -> Maybe (IORef NodeCache)
|
||||
getNodeCacheRef = getInternals_ nodeCache
|
||||
|
|
Loading…
Reference in a new issue