module Network.Subnet.Network where
import Network.Subnet.Binary
import Network.Subnet.Ip
import Data.List
import Data.List.Split
network :: LogIp -> SubnetMask -> LogIp
network x y = showLogIp $ (readLogIp x) .&&. (readSubnetMask y)
nextNetwork :: LogIp -> SubnetMask -> LogIp
nextNetwork x y
| network x y == network (addOneLogIp x) y = nextNetwork (addOneLogIp x) y
| otherwise = addOneLogIp x
allInSubnet :: LogIp -> SubnetMask -> [LogIp]
allInSubnet x y = f (network x y) y
where
f x y = takeWhile (/= (nextNetwork x y)) $ iterate addOneLogIp x
broadcast :: LogIp -> SubnetMask -> LogIp
broadcast x y = last $ allInSubnet x y
hosts :: LogIp -> SubnetMask -> [LogIp]
hosts x y = (tail . init) $ allInSubnet x y
summarize :: [LogIp] -> SubnetMask
summarize = mkSubnetMask .
getLogIp .
showLogIp .
mkBinary .
k .
takeWhile (/='0') .
map (\x -> if x then '1' else '0') .
map g .
transpose .
map (getBinary . readLogIp)
where
f = getBinary . readLogIp
g xs = all (== head xs) (tail xs)
k x | length x < 32 = k $ x ++ "0"
| True = x