1. ppavel
  2. hs-bonjour

Commits

Pavel Perikov  committed 572eb5b

First usage attempts. Had to stop using data kinds due to internal bug of ghc

  • Participants
  • Parent commits 5bed940
  • Branches default

Comments (0)

Files changed (5)

File Browser.hs

View file
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+module Main where
+import Network.DNSSD.Services
+import Network.DNSSD.InterfaceIndex 
+import Network.DNSSD.Flags
+import Network.DNSSD.ServicesUtils
+import Control.Concurrent
+import Foreign.Ptr
+import Network.Socket
+
+main :: IO ()
+main = 
+    do
+       srv <- browse "_ssh._tcp" Nothing print [DNSServiceFlagsBrowseDomains] DNSServiceInterfaceIndexAny 
+       print srv
+       tid <- forkIO $ return ()
+       case srv of
+            Left _ -> return ()
+            Right s -> threadDelay 50000000 >> stopService s

File Main.hs

View file
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+module Main where
+import Network.DNSSD.Services
+import Network.DNSSD.InterfaceIndex 
+import Network.DNSSD.Flags
+import Network.DNSSD.ServicesUtils
+import Control.Concurrent
+import Foreign.Ptr
+import Network.Socket
+
+main :: IO ()
+main = 
+    do
+       regs <- register Nothing "_ssh._tcp" Nothing Nothing (PortNum 1234) print [] DNSServiceInterfaceIndexAny 
+       print regs
+       srv <- browse "_ssh._tcp" Nothing print [DNSServiceFlagsBrowseDomains] DNSServiceInterfaceIndexAny 
+       print srv
+
+       tid <- forkIO $ return ()
+       case srv of
+            Left _ -> return ()
+            Right s -> threadDelay 50000000 >> stopService s

File Network/DNSSD/Services.chs

View file
 -- Service replies {{{
 data ReplyWithInterface = ReplyWithInterface Flags InterfaceIndex deriving Show 
 data EnumerateDomainsReply t = EnumerateDomainsReply ReplyWithInterface t deriving Show
-data BrowseReply t = BrowseReply {brIfaceFlag :: ReplyWithInterface , brServiceName :: t, brRegType :: t, brDomain :: t}
+data BrowseReply t = BrowseReply {brIfaceFlag :: ReplyWithInterface , brServiceName :: t, brRegType :: t, brDomain :: t} deriving Show
 data RegisterReply t = RegisterReply 
     Flags
     t     -- name
             undefined -}
 --- }}}
 
--- Browse {{{
+-- Browse {{{ 
 
 type DNSServiceBrowseReply = {# type DNSServiceBrowseReply #} 
 
 marshalPort (PortNum n) = fromIntegral n
 
 -- TODO : TXT, result type
-register :: StringLike t => Maybe t -> t -> Maybe t -> Maybe t -> PortNumber -> CallbackFunc (RegisterReply t) -> Flags -> InterfaceIndex -> IO (ServiceResult (RecServiceRef Add))
+register :: StringLike t => Maybe t -> t -> Maybe t -> Maybe t -> PortNumber -> CallbackFunc (RegisterReply t) -> Flags -> InterfaceIndex -> IO (ServiceResult (RecServiceRefAdd))
 register nq rq dq hq p cb = 
         createAll
             {# call DNSServiceRegister as ^ #}
 
 -- }}}
 
-addRecord :: RecServiceRef Add -> RDATA -> Int -> Flags -> IO (ServiceResult RecordRef)
-addRecord (RecServiceRef _ srv) rdata ttl flags = 
+addRecord :: RecServiceRefAdd -> RDATA -> Int -> Flags -> IO (ServiceResult RecordRef)
+addRecord (RecServiceRefAdd _ srv) rdata ttl flags = 
     alloca $ \rref ->
     withRDATA rdata $ \ rt len dat ->  
         do

File Network/DNSSD/ServicesUtils.chs

View file
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Network.DNSSD.ServicesUtils where
 import Foreign.C.Types
 type DNSRecordRef  = {# type DNSRecordRef  #}
 data ServiceRef = ServiceRef ThreadId deriving Show
 
-data RecOp = Add | Register
 
-data RecServiceRef (a :: RecOp) = RecServiceRef ThreadId DNSServiceRef
+data RecServiceRefAdd = RecServiceRefAdd ThreadId DNSServiceRef deriving Show
+data RecServiceRefRegister = RecServiceRefRegister ThreadId DNSServiceRef deriving Show
 data RecordRef = RecordRef DNSServiceRef DNSRecordRef 
 
 
 instance CreateServiceRef ServiceRef where
     createServiceRef tid _ = ServiceRef tid
 
-instance CreateServiceRef (RecServiceRef a) where
-    createServiceRef = RecServiceRef
+instance CreateServiceRef (RecServiceRefAdd) where
+    createServiceRef = RecServiceRefAdd
+
+instance CreateServiceRef (RecServiceRefRegister) where
+    createServiceRef = RecServiceRefRegister
 
 createService :: CreateServiceRef t => 
     Flags ->

File hs-bonjour.cabal

View file
                     , Network.DNSSD.Flags
                     , Network.DNSSD.InterfaceIndex
                     , Network.DNSSD.Records
-  other-modules     : Network.DNSSD.ServicesUtils
+                    , Network.DNSSD.ServicesUtils
   build-depends     : base ==4.5.* 
                     , bytestring == 0.9.*
                     , network    == 2.3.*
+
+executable demo
+    build-tools     : c2hs
+    main-is         : Main.hs
+    build-depends     : base ==4.5.* 
+                      , hs-bonjour
+                      , network == 2.3.*
+executable browser
+    main-is : Browser.hs
+    build-depends : base == 4.5.*
+                  , hs-bonjour
+                  , network == 2.3.*