{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.ZRE.Utils (
    uuidByteString
  , exitFail
  , bshow
  , getDefRoute
  , getIface
  , getIfaceReport
  , getName
  , randPort
  , emit
  , emitdbg) where


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 -> B.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 :: B.ByteString -> IO b
exitFail :: ByteString -> IO b
exitFail msg :: ByteString
msg = do
  ByteString -> IO ()
B.putStrLn ByteString
msg
  IO b
forall a. IO a
exitFailure

bshow :: (Show a) => a -> B.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 (B.ByteString, B.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 "ip" ["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 ("default":"via":gw :: String
gw:"dev":dev :: String
dev:_) = (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (String -> ByteString
B.pack String
gw, String -> ByteString
B.pack String
dev)
    getDef _ = Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing

getIface :: B.ByteString -> IO (Maybe NetworkInterface)
getIface :: ByteString -> IO (Maybe NetworkInterface)
getIface iname :: 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 (\x :: 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 :: B.ByteString
               -> IO (B.ByteString, B.ByteString, B.ByteString)
getIfaceReport :: ByteString -> IO (ByteString, ByteString, ByteString)
getIfaceReport iname :: ByteString
iname = do
  Maybe NetworkInterface
i <- ByteString -> IO (Maybe NetworkInterface)
getIface ByteString
iname
  case Maybe NetworkInterface
i of
    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
$ "Unable to get info for interace " ByteString -> ByteString -> ByteString
`B.append` ByteString
iname
    (Just NetworkInterface{..}) -> (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 :: B.ByteString -> IO B.ByteString
getName :: ByteString -> IO ByteString
getName "" = (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 x :: ByteString
x  = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x

randPort :: B.ByteString -> IO Port
randPort :: ByteString -> IO Port
randPort ip :: ByteString
ip = Port -> IO Port
forall b a. (Random b, Show b, Ord a, Num b, Num a) => a -> IO b
loop (100 :: Int)
  where
    loop :: a -> IO b
loop cnt :: a
cnt = do
      b
port <- (b, b) -> IO b
forall a. Random a => (a, a) -> IO a
randomRIO (41000, 41100)
      (xAddr :: AddrInfo
xAddr:_) <- 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 e :: IOException
e
            | a
cnt a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
                [ "Unable to bind to random port, last tried was "
                , b -> String
forall a. Show a => a -> String
show b
port
                , ". 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
- 1

        Right s :: 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 addr :: 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 s :: TVar ZREState
s x :: 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 -> B.ByteString -> STM ()
emitdbg :: TVar ZREState -> ByteString -> STM ()
emitdbg s :: TVar ZREState
s x :: 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
    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
    _ -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()