{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Network.ZRE.Utils ( uuidByteString , exitFail , bshow , getDefRoute , getIface , getIfaceReport , getName , randPort , emit , emitdbg ) where import Data.ByteString (ByteString) import System.Exit import System.Process import System.Random import System.ZMQ4.Endpoint import Network.BSD (getHostName) import Network.Info import Network.ZRE.Types import Control.Concurrent.STM import Control.Exception import Network.Socket hiding (Debug) import Data.UUID (UUID, toByteString) import Data.Maybe import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as BL uuidByteString :: UUID -> ByteString uuidByteString :: UUID -> ByteString uuidByteString = ByteString -> ByteString BL.toStrict (ByteString -> ByteString) -> (UUID -> ByteString) -> UUID -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . UUID -> ByteString toByteString exitFail :: ByteString -> IO b exitFail :: ByteString -> IO b exitFail ByteString msg = do ByteString -> IO () B.putStrLn ByteString msg IO b forall a. IO a exitFailure bshow :: (Show a) => a -> ByteString bshow :: a -> ByteString bshow = String -> ByteString B.pack (String -> ByteString) -> (a -> String) -> a -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> String forall a. Show a => a -> String show getDefRoute :: IO (Maybe (ByteString, ByteString)) getDefRoute :: IO (Maybe (ByteString, ByteString)) getDefRoute = do [String] ipr <- (String -> [String]) -> IO String -> IO [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap String -> [String] lines (IO String -> IO [String]) -> IO String -> IO [String] forall a b. (a -> b) -> a -> b $ String -> [String] -> String -> IO String readProcess String "ip" [String "route"] [] Maybe (ByteString, ByteString) -> IO (Maybe (ByteString, ByteString)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (ByteString, ByteString) -> IO (Maybe (ByteString, ByteString))) -> Maybe (ByteString, ByteString) -> IO (Maybe (ByteString, ByteString)) forall a b. (a -> b) -> a -> b $ [(ByteString, ByteString)] -> Maybe (ByteString, ByteString) forall a. [a] -> Maybe a listToMaybe ([(ByteString, ByteString)] -> Maybe (ByteString, ByteString)) -> [(ByteString, ByteString)] -> Maybe (ByteString, ByteString) forall a b. (a -> b) -> a -> b $ [Maybe (ByteString, ByteString)] -> [(ByteString, ByteString)] forall a. [Maybe a] -> [a] catMaybes ([Maybe (ByteString, ByteString)] -> [(ByteString, ByteString)]) -> [Maybe (ByteString, ByteString)] -> [(ByteString, ByteString)] forall a b. (a -> b) -> a -> b $ ([String] -> Maybe (ByteString, ByteString)) -> [[String]] -> [Maybe (ByteString, ByteString)] forall a b. (a -> b) -> [a] -> [b] map [String] -> Maybe (ByteString, ByteString) getDef ((String -> [String]) -> [String] -> [[String]] forall a b. (a -> b) -> [a] -> [b] map String -> [String] words [String] ipr) where getDef :: [String] -> Maybe (ByteString, ByteString) getDef (String "default":String "via":String gw:String "dev":String dev:[String] _) = (ByteString, ByteString) -> Maybe (ByteString, ByteString) forall a. a -> Maybe a Just (String -> ByteString B.pack String gw, String -> ByteString B.pack String dev) getDef [String] _ = Maybe (ByteString, ByteString) forall a. Maybe a Nothing getIface :: ByteString -> IO (Maybe NetworkInterface) getIface :: ByteString -> IO (Maybe NetworkInterface) getIface ByteString iname = do [NetworkInterface] ns <- IO [NetworkInterface] getNetworkInterfaces Maybe NetworkInterface -> IO (Maybe NetworkInterface) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe NetworkInterface -> IO (Maybe NetworkInterface)) -> Maybe NetworkInterface -> IO (Maybe NetworkInterface) forall a b. (a -> b) -> a -> b $ [NetworkInterface] -> Maybe NetworkInterface forall a. [a] -> Maybe a listToMaybe ([NetworkInterface] -> Maybe NetworkInterface) -> [NetworkInterface] -> Maybe NetworkInterface forall a b. (a -> b) -> a -> b $ (NetworkInterface -> Bool) -> [NetworkInterface] -> [NetworkInterface] forall a. (a -> Bool) -> [a] -> [a] filter (\NetworkInterface x -> NetworkInterface -> String name NetworkInterface x String -> String -> Bool forall a. Eq a => a -> a -> Bool == ByteString -> String B.unpack ByteString iname) [NetworkInterface] ns getIfaceReport :: ByteString -> IO (ByteString, ByteString, ByteString) getIfaceReport :: ByteString -> IO (ByteString, ByteString, ByteString) getIfaceReport ByteString iname = do Maybe NetworkInterface i <- ByteString -> IO (Maybe NetworkInterface) getIface ByteString iname case Maybe NetworkInterface i of Maybe NetworkInterface Nothing -> ByteString -> IO (ByteString, ByteString, ByteString) forall b. ByteString -> IO b exitFail (ByteString -> IO (ByteString, ByteString, ByteString)) -> ByteString -> IO (ByteString, ByteString, ByteString) forall a b. (a -> b) -> a -> b $ ByteString "Unable to get info for interface " ByteString -> ByteString -> ByteString `B.append` ByteString iname (Just NetworkInterface{String IPv4 IPv6 MAC ipv4 :: NetworkInterface -> IPv4 ipv6 :: NetworkInterface -> IPv6 mac :: NetworkInterface -> MAC mac :: MAC ipv6 :: IPv6 ipv4 :: IPv4 name :: String name :: NetworkInterface -> String ..}) -> (ByteString, ByteString, ByteString) -> IO (ByteString, ByteString, ByteString) forall (m :: * -> *) a. Monad m => a -> m a return (ByteString iname, String -> ByteString B.pack (String -> ByteString) -> String -> ByteString forall a b. (a -> b) -> a -> b $ IPv4 -> String forall a. Show a => a -> String show IPv4 ipv4, String -> ByteString B.pack (String -> ByteString) -> String -> ByteString forall a b. (a -> b) -> a -> b $ IPv6 -> String forall a. Show a => a -> String show IPv6 ipv6) getName :: ByteString -> IO ByteString getName :: ByteString -> IO ByteString getName ByteString "" = (String -> ByteString) -> IO String -> IO ByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap String -> ByteString B.pack IO String getHostName getName ByteString x = ByteString -> IO ByteString forall (m :: * -> *) a. Monad m => a -> m a return ByteString x randPort :: ByteString -> IO Port randPort :: ByteString -> IO Port randPort ByteString ip = Port -> IO Port forall b a. (Random b, Show b, Ord a, Num b, Num a) => a -> IO b loop (Port 100 :: Int) where loop :: a -> IO b loop a cnt = do b port <- (b, b) -> IO b forall a. Random a => (a, a) -> IO a randomRIO (b 41000, b 41100) (AddrInfo xAddr:[AddrInfo] _) <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo] getAddrInfo Maybe AddrInfo forall a. Maybe a Nothing (String -> Maybe String forall a. a -> Maybe a Just (String -> Maybe String) -> String -> Maybe String forall a b. (a -> b) -> a -> b $ ByteString -> String B.unpack ByteString ip) (String -> Maybe String forall a. a -> Maybe a Just (String -> Maybe String) -> String -> Maybe String forall a b. (a -> b) -> a -> b $ b -> String forall a. Show a => a -> String show b port) Either IOException Socket esocket <- IO Socket -> IO (Either IOException Socket) forall e a. Exception e => IO a -> IO (Either e a) try (IO Socket -> IO (Either IOException Socket)) -> IO Socket -> IO (Either IOException Socket) forall a b. (a -> b) -> a -> b $ AddrInfo -> IO Socket getSocket AddrInfo xAddr case Either IOException Socket esocket :: Either IOException Socket of Left IOException e | a cnt a -> a -> Bool forall a. Ord a => a -> a -> Bool <= a 1 -> String -> IO b forall a. HasCallStack => String -> a error (String -> IO b) -> String -> IO b forall a b. (a -> b) -> a -> b $ [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ String "Unable to bind to random port, last tried was " , b -> String forall a. Show a => a -> String show b port , String ". Exception was: " , IOException -> String forall a. Show a => a -> String show IOException e ] | Bool otherwise -> do a -> IO b loop (a -> IO b) -> a -> IO b forall a b. (a -> b) -> a -> b $! a cnt a -> a -> a forall a. Num a => a -> a -> a - a 1 Right Socket s -> do Socket -> IO () close Socket s b -> IO b forall (m :: * -> *) a. Monad m => a -> m a return b port getSocket :: AddrInfo -> IO Socket getSocket AddrInfo addr = do Socket s <- Family -> SocketType -> ProtocolNumber -> IO Socket socket (AddrInfo -> Family addrFamily AddrInfo addr) SocketType Stream ProtocolNumber defaultProtocol Socket -> SockAddr -> IO () bind Socket s (AddrInfo -> SockAddr addrAddress AddrInfo addr) Socket -> IO Socket forall (m :: * -> *) a. Monad m => a -> m a return Socket s emit :: TVar ZREState -> Event -> STM () emit :: TVar ZREState -> Event -> STM () emit TVar ZREState s Event x = do ZREState st <- TVar ZREState -> STM ZREState forall a. TVar a -> STM a readTVar TVar ZREState s TBQueue Event -> Event -> STM () forall a. TBQueue a -> a -> STM () writeTBQueue (ZREState -> TBQueue Event zreIn ZREState st) Event x emitdbg :: TVar ZREState -> ByteString -> STM () emitdbg :: TVar ZREState -> ByteString -> STM () emitdbg TVar ZREState s ByteString x = do ZREState st <- TVar ZREState -> STM ZREState forall a. TVar a -> STM a readTVar TVar ZREState s case ZREState -> Bool zreDebug ZREState st of Bool True -> TBQueue Event -> Event -> STM () forall a. TBQueue a -> a -> STM () writeTBQueue (ZREState -> TBQueue Event zreIn ZREState st) (Event -> STM ()) -> Event -> STM () forall a b. (a -> b) -> a -> b $ ByteString -> Event Debug ByteString x Bool _ -> () -> STM () forall (m :: * -> *) a. Monad m => a -> m a return ()