avahi 0.1.1 → 0.2.0

raw patch · 5 files changed

+102/−55 lines, 5 filesdep +avahidep +bytestringdep +dbusdep −dbus-corenew-component:exe:avahi-browsePVP ok

version bump matches the API change (PVP)

Dependencies added: avahi, bytestring, dbus

Dependencies removed: dbus-core

API changes (from Hackage documentation)

Files

• Network/Avahi/Announce.hs +7/−8
• Network/Avahi/Browse.hs +38/−35
• Network/Avahi/Common.hs +12/−1
• avahi.cabal +19/−11
• browse.hs +26/−0

@@ -5,8 +5,8 @@ import Data.Word import Data.Char import Data.Maybe-import qualified DBus.Client as C-import DBus.Client.Simple+import DBus.Client+import DBus.Internal.Types  import Network.Avahi.Common @@ -14,12 +14,11 @@ announce :: Service      -- ^ Service to announce          -> IO () announce (Service {..}) = do-  bus <- connectSystem-  server <- proxy bus avahiBus "/"-  [newGroup] <- call server serverInterface "EntryGroupNew" []-  new <- proxy bus avahiBus (fromJust $ fromVariant newGroup)+  client <- connectSystem+  [newGroup] <- call' client "/" serverInterface "EntryGroupNew" []+  let path = fromJust $ fromVariant newGroup   let text' = [map (fromIntegral . ord) serviceText] :: [[Word8]]-  call new entryGroupInterface "AddService" [toVariant (-1 :: Int32), -- IF_UNSPEC+  call' client path entryGroupInterface "AddService" [toVariant (-1 :: Int32), -- IF_UNSPEC                                              proto2variant serviceProtocol,                                              flags_empty,                                              toVariant serviceName,@@ -28,6 +27,6 @@                                              toVariant serviceHost,                                              toVariant servicePort,                                              toVariant text']-  call new entryGroupInterface "Commit" []+  call' client path entryGroupInterface "Commit" []   return () 

@@ -10,57 +10,60 @@ import Data.Word import Data.Int import Data.Char-import qualified DBus.Client as C-import DBus.Message-import DBus.Client.Simple+import DBus.Client as C+import DBus.Internal.Types+import DBus.Internal.Message  import Network.Avahi.Common+import Data.ByteString (ByteString)+import Data.Text.Encoding (decodeUtf8)+import qualified Data.Text as Text -listenAvahi ::  Maybe BusName -> C.MatchRule-listenAvahi name = C.MatchRule {-  C.matchSender = name,-  C.matchDestination = Nothing,-  C.matchPath = Nothing,-  C.matchInterface = Nothing,-  C.matchMember = Nothing }+listenAvahi ::  Maybe BusName -> Maybe MemberName -> C.MatchRule+listenAvahi name member = matchAny { matchSender = name, matchMember = member }  -- | Browse for specified service browse :: BrowseQuery -> IO () browse (BrowseQuery {..}) = do-  bus <- connectSystem-  server <- proxy bus avahiBus "/"-  [sb] <- call server serverInterface "ServiceBrowserNew" [iface_unspec,-                                                        proto2variant lookupProtocol,-                                                        toVariant lookupServiceName,-                                                        toVariant lookupDomain,-                                                        flags_empty ]-  C.listen bus (listenAvahi $ fromVariant sb) (handler server lookupCallback)-  C.listen bus (listenAvahi $ Just serviceResolver) (handler server lookupCallback)+  client <- connectSystem+  -- We have to set up callback for ItemNew signal before we actually create a browser.+  -- Otherwise, the signal can arrive sooner then we managed to set up a callback for it.+  -- See also https://github.com/cocagne/txdbus/issues/8, https://github.com/lathiat/avahi/issues/9+  addMatch client (listenAvahi Nothing Nothing) (handler client lookupCallback)+  [sb] <- call' client "/" serverInterface "ServiceBrowserNew" [iface_unspec,+                                                               proto2variant lookupProtocol,+                                                               toVariant lookupServiceName,+                                                               toVariant lookupDomain,+                                                               flags_empty ]+  -- print sb+  addMatch client (listenAvahi (Just serviceResolver) (Just "Found")) (handler client lookupCallback)+  return ()  -- | Dispatch signal and call corresponding function.-dispatch ::  [(Text, Signal -> IO b)] -> Signal -> IO ()+dispatch ::  [(String, Signal -> IO b)] -> Signal -> IO () dispatch pairs signal = do   let signame = signalMember signal+  -- putStrLn $ "signame: " ++ show signame ++ ", sender: " ++ show (signalSender signal)   let good = [callback | (name, callback) <- pairs, memberName_ name == signame]   forM_ good $ \callback ->       callback signal -handler ::  Proxy -> (Service -> IO ()) -> BusName -> Signal -> IO ()-handler server callback busname signal = do-  dispatch [("ItemNew", on_new_item server),+handler ::  Client -> (Service -> IO ()) -> Signal -> IO ()+handler client callback signal = do+  dispatch [("ItemNew", on_new_item client),             ("Found",   on_service_found callback) ] signal -on_new_item ::  Proxy -> Signal -> IO ()-on_new_item server signal = do+on_new_item ::  Client -> Signal -> IO ()+on_new_item client signal = do   let body = signalBody signal       [iface,proto,name,stype,domain,flags] = body-  call server serverInterface "ServiceResolverNew" [iface,-                                                    proto,-                                                    name,-                                                    stype,-                                                    domain, -                                                    proto2variant PROTO_UNSPEC,-                                                    flags_empty ]+  call' client "/" serverInterface "ServiceResolverNew" [iface,+                                                         proto,+                                                         name,+                                                         stype,+                                                         domain, +                                                         proto2variant PROTO_UNSPEC,+                                                         flags_empty ]   return ()  on_service_found :: (Service -> IO ()) -> Signal -> IO ()@@ -75,9 +78,9 @@                   serviceHost = fromVariant_ "service host" host,                   serviceAddress = fromVariant addr,                   servicePort = fromVariant_ "service port" port,-                  serviceText = maybe "" toString (fromVariant text :: Maybe [[Word8]]) }+                  serviceText = maybe "" toString (fromVariant text :: Maybe [ByteString]) }   callback service -toString :: [[Word8]] -> String-toString list = concatMap (map (chr . fromIntegral)) list+toString :: [ByteString] -> String+toString = Text.unpack . Text.concat . fmap (decodeUtf8) 

@@ -1,9 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Avahi.Common where +import Control.Exception import Data.Int import Data.Word-import DBus.Client.Simple+import DBus+import DBus.Client+import DBus.Internal.Types  -- | Service specification data Service = Service {@@ -76,4 +79,12 @@  entryGroupInterface :: InterfaceName entryGroupInterface = interfaceName_ "org.freedesktop.Avahi.EntryGroup"++call' :: Client -> ObjectPath -> InterfaceName -> MemberName -> [Variant] -> IO [Variant]+call' client object interface method args = do+  reply <- call_ client (methodCall object interface method) {+             methodCallDestination = Just avahiBus,+             methodCallBody = args+           }+  return $ methodReturnBody reply 

@@ -1,7 +1,7 @@ -- The name of the package. Name:                avahi -Version:             0.1.1+Version:             0.2.0  Synopsis:            Minimal DBus bindings for Avahi daemon (http://avahi.org) @@ -30,10 +30,10 @@  -- Extra files to be distributed with the package, such as examples or -- a README.--- Extra-source-files:  +Extra-source-files:  browse.hs  -- Constraint on the version of Cabal needed to build this package.-Cabal-version:       >=1.6+Cabal-version:       >=1.8   Library@@ -44,12 +44,20 @@                        Network.Avahi.Announce      -- Packages needed in order to build this package.-  Build-depends:       base >= 4 && < 5, dbus-core >= 0.9.2.1,-                       text >= 0.11.1-  -  -- Modules not exported by this package.-  -- Other-modules:       -  -  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.-  -- Build-tools:         +  Build-depends:       base >= 4 && < 5, dbus >= 0.10.13,+                       text >= 0.11.1, bytestring++Executable avahi-browse+  Main-is: browse.hs+  Other-modules: Network.Avahi+                 Network.Avahi.Announce+                 Network.Avahi.Browse+                 Network.Avahi.Common+  Build-depends:       base >= 4 && < 5, dbus >= 0.10.13,+                       text >= 0.11.1,+                       avahi, bytestring   +Source-repository head+  type:     git+  location: https://github.com/portnov/hs-avahi.git+

@@ -0,0 +1,26 @@++import Network.Avahi+import System.Environment++main :: IO ()+main = do+  args <- getArgs+  case args of+    [domain, service] -> do+      let query = BrowseQuery {+                    lookupProtocol = PROTO_UNSPEC,+                    lookupServiceName = service,+                    lookupDomain = domain,+                    lookupCallback = callback+                  }+      browse query+      putStrLn "hit enter when done"+      getLine+      return ()++    _ -> putStrLn "Synopsis: browse DOMAIN SERVICE\n\n\tFor example: browse local _printer._tcp"++callback :: Service -> IO ()+callback service = do+  print service+