module Jenkins.Discover
( Discover(..), discover
) where
import Control.Applicative (Applicative(..), (<$>))
import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Network.BSD
import Network.Socket
import Network.Socket.ByteString as B
import System.Timeout (timeout)
import qualified Text.XML as X
import qualified Text.XML.Lens as X
data Discover = Discover
{ version :: Text
, url :: Text
, server_id :: Maybe Text
} deriving (Show, Read)
discover
:: Int
-> IO [Discover]
discover t = do
(b, addr) <- broadcastSocket
B.sendTo b (B.pack [0, 0, 0, 0]) addr
msgs <- while (timeout t (readAnswer b))
close b
return (mapMaybe parse msgs)
where
while :: IO (Maybe a) -> IO [a]
while io = go where
go = do
mr <- io
case mr of
Nothing -> return []
Just r -> (r :) <$> go
broadcastSocket :: IO (Socket, SockAddr)
broadcastSocket = do
s <- getProtocolNumber "udp" >>= socket AF_INET Datagram
setSocketOption s Broadcast 1
return (s, SockAddrInet port (1) )
where
port = 33848
readAnswer :: Socket -> IO ByteString
readAnswer s = fst <$> B.recvFrom s 4096
parse :: ByteString -> Maybe Discover
parse (X.parseLBS X.def . fromStrict -> bs) = case bs of
Left _ -> Nothing
Right parsed ->
let v = parsed^?deeper.X.el "version".content
u = parsed^?deeper.X.el "url".content
s = parsed^?deeper.X.el "server-id".content
in Discover <$> v <*> u <*> pure s
where
content = X.nodes.traverse.X._Content
deeper = X.root.X.nodes.traverse.X._Element
fromStrict :: ByteString -> BL.ByteString
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706)
fromStrict = BL.fromStrict
#else
fromStrict = BL.fromChunks . pure
#endif