{-# 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 forall b c a. (b -> c) -> (a -> b) -> a -> c . UUID -> ByteString toByteString exitFail :: ByteString -> IO b exitFail :: forall b. ByteString -> IO b exitFail ByteString msg = do ByteString -> IO () B.putStrLn ByteString msg forall a. IO a exitFailure bshow :: (Show a) => a -> ByteString bshow :: forall a. Show a => a -> ByteString bshow = String -> ByteString B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Show a => a -> String show getDefRoute :: IO (Maybe (ByteString, ByteString)) getDefRoute :: IO (Maybe (ByteString, ByteString)) getDefRoute = do [String] ipr <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap String -> [String] lines forall a b. (a -> b) -> a -> b $ String -> [String] -> String -> IO String readProcess String "ip" [String "route"] [] forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. [a] -> Maybe a listToMaybe forall a b. (a -> b) -> a -> b $ forall a. [Maybe a] -> [a] catMaybes forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map [String] -> Maybe (ByteString, ByteString) getDef (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] _) = forall a. a -> Maybe a Just (String -> ByteString B.pack String gw, String -> ByteString B.pack String dev) getDef [String] _ = forall a. Maybe a Nothing getIface :: ByteString -> IO (Maybe NetworkInterface) getIface :: ByteString -> IO (Maybe NetworkInterface) getIface ByteString iname = do [NetworkInterface] ns <- IO [NetworkInterface] getNetworkInterfaces forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. [a] -> Maybe a listToMaybe forall a b. (a -> b) -> a -> b $ forall a. (a -> Bool) -> [a] -> [a] filter (\NetworkInterface x -> NetworkInterface -> String name NetworkInterface x 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 -> forall b. ByteString -> IO b exitFail 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 ..}) -> forall (m :: * -> *) a. Monad m => a -> m a return (ByteString iname, String -> ByteString B.pack forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show IPv4 ipv4, String -> ByteString B.pack forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show IPv6 ipv6) getName :: ByteString -> IO ByteString getName :: ByteString -> IO ByteString getName ByteString "" = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap String -> ByteString B.pack IO String getHostName getName ByteString x = forall (m :: * -> *) a. Monad m => a -> m a return ByteString x randPort :: ByteString -> IO Port randPort :: ByteString -> IO Port randPort ByteString ip = 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 <- forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a randomRIO (b 41000, b 41100) (AddrInfo xAddr:[AddrInfo] _) <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo] getAddrInfo forall a. Maybe a Nothing (forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ ByteString -> String B.unpack ByteString ip) (forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show b port) Either IOException Socket esocket <- forall e a. Exception e => IO a -> IO (Either e a) try 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 forall a. Ord a => a -> a -> Bool <= a 1 -> forall a. HasCallStack => String -> a error forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ String "Unable to bind to random port, last tried was " , forall a. Show a => a -> String show b port , String ". Exception was: " , forall a. Show a => a -> String show IOException e ] | Bool otherwise -> do a -> IO b loop forall a b. (a -> b) -> a -> b $! a cnt forall a. Num a => a -> a -> a - a 1 Right Socket s -> do Socket -> IO () close Socket s 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) 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 <- forall a. TVar a -> STM a readTVar TVar ZREState s forall a. TBQueue a -> a -> STM () writeTBQueue (ZREState -> EventQueue zreIn ZREState st) Event x emitdbg :: TVar ZREState -> ByteString -> STM () emitdbg :: TVar ZREState -> ByteString -> STM () emitdbg TVar ZREState s ByteString x = do ZREState st <- forall a. TVar a -> STM a readTVar TVar ZREState s case ZREState -> Bool zreDebug ZREState st of Bool True -> forall a. TBQueue a -> a -> STM () writeTBQueue (ZREState -> EventQueue zreIn ZREState st) forall a b. (a -> b) -> a -> b $ ByteString -> Event Debug ByteString x Bool _ -> forall (m :: * -> *) a. Monad m => a -> m a return ()