module Jenkins.Discover
( Discover(..)
, discover
#ifdef TEST
, parse
#endif
) where
import Control.Applicative (Applicative(..), (<$>))
import Control.Lens hiding (element)
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 Text.XML
import Text.XML.Cursor
data Discover = Discover
{ version :: Text
, url :: Text
, server_id :: Maybe Text
} deriving (Show, Eq)
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 bs = either (const Nothing) Just (parseLBS def (BL.fromStrict bs)) >>= \doc ->
let
cursor = fromDocument doc
tag t = preview _head (cursor $/ element t &// content)
in Discover
<$> tag "version"
<*> tag "url"
<*> pure (tag "server-id")