zre 0.1.3.0 → 0.1.4.0

raw patch · 8 files changed

+47/−32 lines, 8 filesdep +lifted-basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: lifted-base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• src/Network/ZRE.hs +13/−2
• src/Network/ZRE/Beacon.hs +3/−3
• src/Network/ZRE/Options.hs +8/−8
• src/Network/ZRE/Peer.hs +4/−4
• src/Network/ZRE/Types.hs +10/−13
• src/Network/ZRE/Utils.hs +1/−1
• zre.cabal +2/−1

@@ -1,3 +1,9 @@+# Version [0.1.4.0](https://github.com/sorki/haskell-zre/compare/0.1.3.0...0.1.4.0) (2020-07-19)++* Changed `zfail` type from `String -> ZRE ()` to `String -> ZRE a`+* Handles errors in user application correctly instead of silently ignoring them+* Fixed incorrect time periods for pinger+ # Version [0.1.3.0](https://github.com/sorki/haskell-zre/compare/0.1.2.0...0.1.3.0) (2020-07-14)  * Cabal fixes

@@ -37,6 +37,8 @@ import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM+import Control.Exception (SomeException)+import qualified Control.Exception.Lifted  import Data.ByteString (ByteString) import Data.UUID@@ -143,14 +145,23 @@           Just end -> void $ async $ zgossipClient uuid end zreEndpoint (zgossipZRE outQ)          (mCastAddr:_) <- toAddrInfo zreMCast-        _beaconAsync <- async $ beacon mCastAddr uuid zrePort+        _beaconAsync <- async $ beacon zreBeaconPeriod mCastAddr uuid zrePort         _beaconRecvAsync <- async $ beaconRecv s zreMCast          mapM_ (runIface s zrePort) ifaces          apiAsync <- async $ api s         threadDelay 500000-        _userAppAsync <- async $ runZ (app >> zquit) inQ outQ+        _userAppAsync <- async+          $ runZ+              (app+                `Control.Exception.Lifted.catch`+                (\e -> do let err = show (e :: SomeException) in zfail err)+                `Control.Exception.Lifted.finally`+                zquit+              )+              inQ+              outQ          wait apiAsync         return ()

@@ -62,8 +62,8 @@   -- | Send UDP multicast beacons periodically-beacon :: AddrInfo -> ByteString -> Port -> IO ()-beacon addrInfo uuid port = do+beacon :: Float -> AddrInfo -> ByteString -> Port -> IO ()+beacon seconds addrInfo uuid port = do     withSocketsDo $ do       bracket (getSocket addrInfo) close (talk (addrAddress addrInfo) (zreBeacon uuid port))   where@@ -75,4 +75,4 @@     talk addr msg s =       forever $ do       void $ sendTo s msg addr-      threadDelay zreBeaconMs+      threadDelay $ sec seconds

@@ -18,29 +18,29 @@       <> short 'n'       <> value ""       <> help "Node name"))-  <*> (isec <$> option auto+  <*> (option auto         (long "quiet-period"       <> short 'q'       <> metavar "N"-      <> value (sec (1.0 :: Float))+      <> value 1.0       <> help "Ping peer after N seconds"))-  <*> (isec <$> option auto+  <*> (option auto         (long "quiet-ping-rate"       <> short 'p'       <> metavar "N"-      <> value (sec (1.0 :: Float))+      <> value 1.0       <> help "Peer ping rate after quiet period passed"))-  <*> ((*100000) <$> option auto+  <*> (option auto         (long "dead-period"       <> short 'd'       <> metavar "N"-      <> value (sec (1.0 :: Float))+      <> value 5.0       <> help "Mark peer dead after N seconds"))-  <*> ((*100000) <$> option auto+  <*> (option auto          (long "beacon-period"       <> short 'b'       <> metavar "N"-      <> value (sec (0.9 :: Float))+      <> value 0.9       <> help "Send beacon every N seconds"))   <*> ((map B.pack) <$> many (strOption         (long "interface"

@@ -181,19 +181,19 @@   cfg <- atomically $ zreCfg <$> readTVar s    now <- getCurrentTime-  if diffUTCTime now peerLastHeard > (fromIntegral $ zreDeadPeriod cfg)+  if diffUTCTime now peerLastHeard > (realToFrac $ zreDeadPeriod cfg)     then do       atomically $ emitdbg s $ B.unwords ["Peer over deadPeriod, destroying", bshow p]       destroyPeer s peerUUID     else do       let tdiff = diffUTCTime now peerLastHeard-      if tdiff > (fromIntegral $ zreQuietPeriod cfg)+      if tdiff > (realToFrac $ zreQuietPeriod cfg)         then do           atomically $ emitdbg s $ B.unwords ["Peer over quietPeriod, sending hugz", bshow p]           atomically $ writeTBQueue peerQueue $ Ping-          threadDelay (zreQuietPingRate cfg)+          threadDelay $ sec (zreQuietPingRate cfg)         else do-          threadDelay $ sec $ (fromIntegral $ zreQuietPeriod cfg) - tdiff+          threadDelay $ sec $ (realToFrac $ zreQuietPeriod cfg) - tdiff  lookupPeer :: TVar ZREState -> UUID -> STM (Maybe (TVar Peer)) lookupPeer s uuid = do

@@ -28,16 +28,12 @@ msec :: (RealFrac a) => a -> Int msec = round . (*1000) --- send beacon every 0.9 seconds-zreBeaconMs :: Int-zreBeaconMs = 900000- data ZRECfg = ZRECfg {     zreNamed         :: ByteString-  , zreQuietPeriod   :: Int-  , zreQuietPingRate :: Int-  , zreDeadPeriod    :: Int-  , zreBeaconPeriod  :: Int+  , zreQuietPeriod   :: Float+  , zreQuietPingRate :: Float+  , zreDeadPeriod    :: Float+  , zreBeaconPeriod  :: Float   , zreInterfaces    :: [ByteString]   , zreMCast         :: Endpoint   , zreZGossip       :: Maybe Endpoint@@ -50,10 +46,10 @@ defaultConf :: ZRECfg defaultConf = ZRECfg {     zreNamed         = "zre"-  , zreQuietPeriod   = sec (1.0 :: Float)-  , zreQuietPingRate = sec (1.0 :: Float)-  , zreDeadPeriod    = sec (5.0 :: Float)-  , zreBeaconPeriod  = sec (0.9 :: Float)+  , zreQuietPeriod   = 1.0+  , zreQuietPingRate = 1.0+  , zreDeadPeriod    = 5.0+  , zreBeaconPeriod  = 0.9   , zreInterfaces    = []   , zreZGossip       = Nothing   , zreMCast         = defMCastEndpoint@@ -193,10 +189,11 @@ zquit :: ZRE () zquit = writeZ $ DoQuit -zfail :: String -> ZRE ()+zfail :: String -> ZRE a zfail errorMsg = do   liftIO $ putStrLn errorMsg   writeZ $ DoQuit+  error errorMsg  zrecv :: ZRE (Event) zrecv = readZ

@@ -61,7 +61,7 @@ getIfaceReport iname = do   i <- getIface iname   case i of-    Nothing -> exitFail $ "Unable to get info for interace " `B.append` iname+    Nothing -> exitFail $ "Unable to get info for interface " `B.append` iname     (Just NetworkInterface{..}) -> return (iname, B.pack $ show ipv4, B.pack $ show ipv6)  getName :: ByteString -> IO ByteString

@@ -1,5 +1,5 @@ name:                zre-version:             0.1.3.0+version:             0.1.4.0 synopsis:            ZRE protocol implementation description:         Peer-to-peer local area networking with reliable group messaging                      and automatic peer discovery.@@ -49,6 +49,7 @@   build-depends:       base >= 4 && < 5                      , async                      , lifted-async+                     , lifted-base                      , attoparsec ^>= 0.13                      , cereal                      , data-default