{-# 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 ()