ea1b3b8 · distributed-process

git.iko.soy/distributed-process

Similar to getProcessInfo, these give developers a means to query node

statistics for debugging or monitoring purposes without leaking internal details and process references.

commitea1b3b8542aeae0ff6d19926a8b8803d5fc688a8 authorRoman Gonzalez <roman@birdseye-sw.com> dateWed 12 Mar 2014, 13:08 (13 years ago) parent283c287

4 files changed+80−1

compare with master

unifiedsplit

src/Control/Distributed/Process.hs+6−1 src/Control/Distributed/Process/Internal/Primitives.hs+31 src/Control/Distributed/Process/Internal/Types.hs+21 src/Control/Distributed/Process/Node.hs+22

src/Control/Distributed/Process.hs+6−1

@@ -82,6 +82,9 @@ module Control.Distributed.Process

8282 , getSelfNode

8383 , ProcessInfo(..)

8484 , getProcessInfo

85+ , NodeStats(..)

86+ , getNodeStats

87+ , getLocalNodeStats

8588 -- * Monitoring and linking

8689 , link

8790 , linkNode

@@ -237,6 +240,9 @@ import Control.Distributed.Process.Internal.Primitives

237240 , getSelfNode

238241 , ProcessInfo(..)

239242 , getProcessInfo

243+ , NodeStats(..)

244+ , getNodeStats

245+ , getLocalNodeStats

240246 -- Monitoring and linking

241247 , link

242248 , linkNode

@@ -383,4 +389,3 @@ spawnChannelLocal proc = do

383389 liftIO $ putMVar mvar sport

384390 proc rport

385391 takeMVar mvar

386−

src/Control/Distributed/Process/Internal/Primitives.hs+31

@@ -58,6 +58,9 @@ module Control.Distributed.Process.Internal.Primitives

5858 , getSelfNode

5959 , ProcessInfo(..)

6060 , getProcessInfo

61+ , NodeStats(..)

62+ , getNodeStats

63+ , getLocalNodeStats

6164 -- * Monitoring and linking

6265 , link

6366 , unlink

@@ -160,6 +163,7 @@ import Control.Distributed.Process.Internal.Types

160163 , MonitorRef(..)

161164 , SpawnRef(..)

162165 , ProcessSignal(..)

166+ , NodeMonitorNotification(..)

163167 , monitorCounter

164168 , spawnCounter

165169 , SendPort(..)

@@ -170,6 +174,7 @@ import Control.Distributed.Process.Internal.Types

170174 , SendPortId(..)

171175 , Identifier(..)

172176 , ProcessExitException(..)

177+ , DiedReason(..)

173178 , DidUnmonitor(..)

174179 , DidUnlinkProcess(..)

175180 , DidUnlinkNode(..)

@@ -179,6 +184,7 @@ import Control.Distributed.Process.Internal.Types

179184 , ProcessRegistrationException(..)

180185 , ProcessInfo(..)

181186 , ProcessInfoNone(..)

187+ , NodeStats(..)

182188 , isEncoded

183189 , createMessage

184190 , createUnencodedMessage

@@ -719,6 +725,31 @@ getSelfPid = processId <$> ask

719725getSelfNode :: Process NodeId

720726getSelfNode = localNodeId . processNode <$> ask

721727

728+

729+-- | Get statistics about the specified node

730+getNodeStats :: NodeId -> Process (Either DiedReason NodeStats)

731+getNodeStats nid = do

732+ selfNode <- getSelfNode

733+ if nid == selfNode

734+ then Right `fmap` getLocalNodeStats -- optimisation

735+ else getNodeStatsRemote nid

736+ where

737+ getNodeStatsRemote :: NodeId -> Process (Either DiedReason NodeStats)

738+ getNodeStatsRemote nid = do

739+ sendCtrlMsg (Just nid) $ GetNodeStats nid

740+ bracket (monitorNode nid) unmonitor $ \mRef ->

741+ receiveWait [ match (\(stats :: NodeStats) -> return $ Right stats)

742+ , matchIf (\(NodeMonitorNotification ref _ _) -> ref == mRef)

743+ (\(NodeMonitorNotification _ _ dr) -> return $ Left dr)

744+ ]

745+

746+-- | Get statistics about our local node

747+getLocalNodeStats :: Process NodeStats

748+getLocalNodeStats = do

749+ self <- getSelfNode

750+ sendCtrlMsg Nothing $ GetNodeStats self

751+ receiveWait [ match (\(stats :: NodeStats) -> return stats) ]

752+

722753-- | Get information about the specified process

723754getProcessInfo :: ProcessId -> Process (Maybe ProcessInfo)

724755getProcessInfo pid =

src/Control/Distributed/Process/Internal/Types.hs+21

@@ -59,6 +59,7 @@ module Control.Distributed.Process.Internal.Types

5959 , RegisterReply(..)

6060 , ProcessInfo(..)

6161 , ProcessInfoNone(..)

62+ , NodeStats(..)

6263 -- * Node controller internal data types

6364 , NCMsg(..)

6465 , ProcessSignal(..)

@@ -522,6 +523,15 @@ data WhereIsReply = WhereIsReply String (Maybe ProcessId)

522523data RegisterReply = RegisterReply String Bool

523524 deriving (Show, Typeable)

524525

526+data NodeStats = NodeStats {

527+ nodeStatsNode :: NodeId

528+ , nodeStatsRegisteredNames :: Int

529+ , nodeStatsMonitors :: Int

530+ , nodeStatsLinks :: Int

531+ , nodeStatsProcesses :: Int

532+ }

533+ deriving (Show, Eq, Typeable)

534+

525535-- | Provide information about a running process

526536data ProcessInfo = ProcessInfo {

527537 infoNode :: NodeId

@@ -562,6 +572,7 @@ data ProcessSignal =

562572 | Exit !ProcessId !Message

563573 | GetInfo !ProcessId

564574 | SigShutdown

575+ | GetNodeStats !NodeId

565576 deriving Show

566577

567578--------------------------------------------------------------------------------

@@ -612,6 +623,7 @@ instance Binary ProcessSignal where

612623 put (LocalPortSend sid msg) = putWord8 12 >> put sid >> put (messageToPayload msg)

613624 put (GetInfo about) = putWord8 30 >> put about

614625 put (SigShutdown) = putWord8 31

626+ put (GetNodeStats nid) = putWord8 32 >> put nid

615627 get = do

616628 header <- getWord8

617629 case header of

@@ -630,6 +642,7 @@ instance Binary ProcessSignal where

630642 12 -> LocalPortSend <$> get <*> (payloadToMessage <$> get)

631643 30 -> GetInfo <$> get

632644 31 -> return SigShutdown

645+ 32 -> GetNodeStats <$> get

633646 _ -> fail "ProcessSignal.get: invalid"

634647

635648instance Binary DiedReason where

@@ -687,6 +700,14 @@ instance Binary ProcessInfo where

687700 >> put (infoMonitors pInfo)

688701 >> put (infoLinks pInfo)

689702

703+instance Binary NodeStats where

704+ get = NodeStats <$> get <*> get <*> get <*> get <*> get

705+ put nStats = put (nodeStatsNode nStats)

706+ >> put (nodeStatsRegisteredNames nStats)

707+ >> put (nodeStatsMonitors nStats)

708+ >> put (nodeStatsLinks nStats)

709+ >> put (nodeStatsProcesses nStats)

710+

690711instance Binary ProcessInfoNone where

691712 get = ProcessInfoNone <$> get

692713 put (ProcessInfoNone r) = put r

src/Control/Distributed/Process/Node.hs+22

@@ -30,6 +30,7 @@ import qualified Data.Map as Map

3030 , filter

3131 , partitionWithKey

3232 , elems

33+ , size

3334 , filterWithKey

3435 , foldlWithKey

3536 )

@@ -68,6 +69,7 @@ import Control.Distributed.Process.Internal.StrictMVar

6869 , newEmptyMVar

6970 , putMVar

7071 , takeMVar

72+ , readMVar

7173 )

7274import Control.Concurrent.Chan (newChan, writeChan, readChan)

7375import qualified Control.Concurrent.MVar as MVar (newEmptyMVar, takeMVar)

@@ -119,6 +121,7 @@ import Control.Distributed.Process.Internal.Types

119121 , localPidCounter

120122 , localPidUnique

121123 , localProcessWithId

124+ , localProcesses

122125 , localConnections

123126 , forever'

124127 , MonitorRef(..)

@@ -141,6 +144,7 @@ import Control.Distributed.Process.Internal.Types

141144 , nodeOf

142145 , ProcessInfo(..)

143146 , ProcessInfoNone(..)

147+ , NodeStats(..)

144148 , SendPortId(..)

145149 , typedChannelWithId

146150 , RegisterReply(..)

@@ -686,6 +690,8 @@ nodeController = do

686690 NT.closeEndPoint (localEndPoint node)

687691 `Exception.finally` throwIO ThreadKilled

688692 -- ThreadKilled seems to make more sense than fail/error here

693+ NCMsg (ProcessIdentifier from) (GetNodeStats nid) ->

694+ ncEffectGetNodeStats from nid

689695 unexpected ->

690696 error $ "nodeController: unexpected message " ++ show unexpected

691697

@@ -983,6 +989,21 @@ ncEffectGetInfo from pid =

983989 then (k:ks)

984990 else ks) []

985991

992+ncEffectGetNodeStats :: ProcessId -> NodeId -> NC ()

993+ncEffectGetNodeStats from _nid = do

994+ node <- ask

995+ ncState <- StateT.get

996+ nodeState <- liftIO $ readMVar (localState node)

997+ let localProcesses' = nodeState ^. localProcesses

998+ stats =

999+ NodeStats {

1000+ nodeStatsNode = localNodeId node

1001+ , nodeStatsRegisteredNames = Map.size $ ncState ^. registeredHere

1002+ , nodeStatsMonitors = Map.size $ ncState ^. monitors

1003+ , nodeStatsLinks = Map.size $ ncState ^. links

1004+ , nodeStatsProcesses = Map.size localProcesses'

1005+ }

1006+ postAsMessage from stats

9861007--------------------------------------------------------------------------------

9871008-- Auxiliary --

9881009--------------------------------------------------------------------------------

@@ -1035,6 +1056,7 @@ destNid (Died _ _) = Nothing

10351056destNid (Kill pid _) = Just $ processNodeId pid

10361057destNid (Exit pid _) = Just $ processNodeId pid

10371058destNid (GetInfo pid) = Just $ processNodeId pid

1059+destNid (GetNodeStats nid) = Just nid

10381060destNid (LocalSend pid _) = Just $ processNodeId pid

10391061destNid (LocalPortSend cid _) = Just $ processNodeId (sendPortProcessId cid)

10401062destNid (SigShutdown) = Nothing