distributed-process-p2p 0.1.0.0 → 0.1.0.1
raw patch · 2 files changed
+19/−5 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
distributed-process-p2p.cabal view
@@ -1,5 +1,5 @@ name: distributed-process-p2p-version: 0.1.0.0+version: 0.1.0.1 synopsis: Peer-to-peer node discovery for Cloud Haskell description: Bootstraps a peer-to-peer connection network from a set of known hosts. homepage: https://bitbucket.org/dpwiz/distributed-process-p2p/@@ -7,7 +7,7 @@ license-file: LICENSE author: Alexander Bondarenko maintainer: aenor.realm@gmail.com-copyright: Alexannder Bondarenko+copyright: Alexander Bondarenko category: Network build-type: Simple cabal-version: >=1.8
src/Control/Distributed/Backend/P2P.hs view
@@ -8,7 +8,7 @@ -- > import Control.Monad.Trans (liftIO) -- > import Control.Concurrent (threadDelay) -- > --- > main = P2P.bootstrap "myhostname" "9001" (P2P.makeNodeId "seedhost:9000") $ do+-- > main = P2P.bootstrap "myhostname" "9001" [P2P.makeNodeId "seedhost:9000"] $ do -- > liftIO $ threadDelay 1000000 -- give dispatcher a second to discover other nodes -- > P2P.nsendPeers "myService" ("some", "message") @@ -36,7 +36,12 @@ import qualified Data.Set as S import Data.Typeable import Data.Binary+import Data.Maybe (isJust) +-- * Peer-to-peer API++-- ** Initialization+ -- | Make a NodeId from "host:port" string. makeNodeId :: String -> DPT.NodeId makeNodeId addr = DPT.NodeId . EndPointAddress . BS.concat $ [BS.pack addr, ":0"]@@ -56,12 +61,14 @@ forever $ receiveWait [ match $ onPeerMsg peerSet , match $ onMonitor peerSet- , match $ onDiscover pid , match $ onQuery peerSet+ , matchIf isPeerDiscover $ onDiscover pid ] DPN.runProcess node proc +-- ** Discovery+ -- | Request and response to query peer controller for remote nodes. data QueryMessage = QueryMessage (DPT.SendPort QueryMessage) | QueryResult [DPT.NodeId]@@ -89,10 +96,14 @@ QueryResult nodes <- receiveChan r return nodes +-- ** Messaging+ -- | Broadcast a message to a specific service on all peers. nsendPeers :: Serializable a => String -> a -> Process () nsendPeers service msg = getPeers >>= mapM_ (\peer -> nsendRemote peer service msg) +-- * Peer protocol+ -- | A set of p2p messages. data PeerMessage = PeerPing | PeerExchange [DPT.ProcessId]@@ -149,8 +160,11 @@ current <- takeMVar peers putMVar peers $ S.delete pid current +isPeerDiscover :: WhereIsReply -> Bool+isPeerDiscover (WhereIsReply service pid) = service == "peerController" && isJust pid+ onDiscover :: DPT.ProcessId -> WhereIsReply -> Process ()-onDiscover myPid (WhereIsReply "peerController" (Just seed)) = do+onDiscover myPid (WhereIsReply _ (Just seed)) = do say $ "Seed discovered: " ++ show seed send seed $ PeerJoined myPid