make NodeState a typeclasse, define setters and getters on its representations

contributes to #20
This commit is contained in:
Trolli Schmittlauch 2020-05-21 21:13:58 +02:00
parent 99a2b0ba09
commit fe673dc255
2 changed files with 68 additions and 26 deletions

View file

@ -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)
} }

View file

@ -125,7 +125,7 @@ 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
@ -133,18 +133,18 @@ data NodeState = NodeState
-- 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