3b1335e · distributed-process

git.iko.soy/distributed-process

More informative ProcessRegistrationException.

Now includes the identifier of the process that owns the name, if any. The exception used to only mention the name. However, that made it impossible to implement many algorithms, such as "return registered process or spawn new one" in a race free way. If you catch ProcessRegistrationException after attempting `register`, doing `whereis` after that to find out who owns the name is racy. This is a BREAKING CHANGE, albeit to a peripheral part of the current API, so the next release of distributed-process that includes this change will have to bump the major version number according to the PVP.

commit3b1335eae2866223c9e6400f3ffe98f2ce9c4f48 authorMathieu Boespflug <m@tweag.io> dateSun 7 Dec 2014, 21:43 (12 years ago) parentfc0a1cc

3 files changed+21−17

compare with master

unifiedsplit

src/Control/Distributed/Process/Internal/Primitives.hs+11−9 src/Control/Distributed/Process/Internal/Types.hs+7−6 src/Control/Distributed/Process/Node.hs+3−2

src/Control/Distributed/Process/Internal/Primitives.hs+11−9

@@ -1044,9 +1044,10 @@ registerImpl :: Bool -> String -> ProcessId -> Process ()

10441044registerImpl force label pid = do

10451045 mynid <- getSelfNode

10461046 sendCtrlMsg Nothing (Register label mynid (Just pid) force)

1047− receiveWait [ matchIf (\(RegisterReply label' _) -> label == label')

1048− (\(RegisterReply _ ok) -> handleRegistrationReply label ok)

1049− ]

1047+ receiveWait

1048+ [ matchIf (\(RegisterReply label' _ _) -> label == label')

1049+ (\(RegisterReply _ ok owner) -> handleRegistrationReply label ok owner)

1050+ ]

10501051

10511052-- | Register a process with a remote registry (asynchronous).

10521053--

@@ -1069,16 +1070,17 @@ unregister :: String -> Process ()

10691070unregister label = do

10701071 mynid <- getSelfNode

10711072 sendCtrlMsg Nothing (Register label mynid Nothing False)

1072− receiveWait [ matchIf (\(RegisterReply label' _) -> label == label')

1073− (\(RegisterReply _ ok) -> handleRegistrationReply label ok)

1074− ]

1073+ receiveWait

1074+ [ matchIf (\(RegisterReply label' _ _) -> label == label')

1075+ (\(RegisterReply _ ok owner) -> handleRegistrationReply label ok owner)

1076+ ]

10751077

10761078-- | Deal with the result from an attempted registration or unregistration

10771079-- by throwing an exception if necessary

1078−handleRegistrationReply :: String -> Bool -> Process ()

1079−handleRegistrationReply label ok =

1080+handleRegistrationReply :: String -> Bool -> Maybe ProcessId -> Process ()

1081+handleRegistrationReply label ok owner =

10801082 when (not ok) $

1081− liftIO $ throwIO $ ProcessRegistrationException label

1083+ liftIO $ throwIO $ ProcessRegistrationException label owner

10821084

10831085-- | Remove a process from a remote registry (asynchronous).

10841086--

src/Control/Distributed/Process/Internal/Types.hs+7−6

@@ -461,9 +461,11 @@ data PortLinkException =

461461

462462-- | Exception thrown when a process attempts to register

463463-- a process under an already-registered name or to

464−-- unregister a name that hasn't been registered

464+-- unregister a name that hasn't been registered. Returns

465+-- the name and the identifier of the process that owns it,

466+-- if any.

465467data ProcessRegistrationException =

466− ProcessRegistrationException !String

468+ ProcessRegistrationException !String !(Maybe ProcessId)

467469 deriving (Typeable, Show)

468470

469471-- | Internal exception thrown indirectly by 'exit'

@@ -524,7 +526,7 @@ data WhereIsReply = WhereIsReply String (Maybe ProcessId)

524526 deriving (Show, Typeable)

525527

526528-- | (Asynchronous) reply from 'register' and 'unregister'

527−data RegisterReply = RegisterReply String Bool

529+data RegisterReply = RegisterReply String Bool (Maybe ProcessId)

528530 deriving (Show, Typeable)

529531

530532data NodeStats = NodeStats {

@@ -693,8 +695,8 @@ instance Binary WhereIsReply where

693695 get = WhereIsReply <$> get <*> get

694696

695697instance Binary RegisterReply where

696− put (RegisterReply label ok) = put label >> put ok

697− get = RegisterReply <$> get <*> get

698+ put (RegisterReply label ok owner) = put label >> put ok >> put owner

699+ get = RegisterReply <$> get <*> get <*> get

698700

699701instance Binary ProcessInfo where

700702 get = ProcessInfo <$> get <*> get <*> get <*> get <*> get

@@ -761,4 +763,3 @@ typedChannelWithId cid = typedChannels >>> DAC.mapMaybe cid

761763{-# INLINE forever' #-}

762764forever' :: Monad m => m a -> m b

763765forever' a = let a' = a >> a' in a'

764−

src/Control/Distributed/Process/Node.hs+3−2

@@ -841,17 +841,18 @@ ncEffectRegister from label atnode mPid reregistration = do

841841 return $ (isNothing currentVal /= reregistration) &&

842842 (not (isLocal node (ProcessIdentifier thepid) ) || isvalidlocal )

843843 if isLocal node (NodeIdentifier atnode)

844− then do when (isOk) $

844+ then do when isOk $

845845 do modify' $ registeredHereFor label ^= mPid

846846 updateRemote node currentVal mPid

847847 case mPid of

848848 (Just p) -> liftIO $ trace node (MxRegistered p label)

849849 Nothing -> liftIO $ trace node (MxUnRegistered (fromJust currentVal) label)

850+ newVal <- gets (^. registeredHereFor label)

850851 liftIO $ sendMessage node

851852 (NodeIdentifier (localNodeId node))

852853 (ProcessIdentifier from)

853854 WithImplicitReconnect

854− (RegisterReply label isOk)

855+ (RegisterReply label isOk newVal)

855856 else let operation =

856857 case reregistration of

857858 True -> flip decList