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,
ipAddr OCTET STRING (SIZE(16)),
dhtPort INTEGER,
apPort INTEGER,
servicePort INTEGER,
vServerID INTEGER (0..255)
}

View file

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