{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.IP.RouteTable.Internal where
import Control.Applicative hiding (empty)
import qualified Control.Applicative as A (empty)
import Control.Monad
import Data.Bits
import Data.Foldable (Foldable(..))
import Data.IP.Addr
import Data.IP.Op
import Data.IP.Range
import Data.IntMap (IntMap, (!))
import qualified Data.IntMap as IM (fromList)
import Data.Monoid hiding ((<>))
import Data.Semigroup
import Data.Traversable
import Data.Word
import GHC.Generics (Generic, Generic1)
import Prelude hiding (lookup)
class Addr a => Routable a where
intToTBit :: Int -> a
isZero :: a -> a -> Bool
instance Routable IPv4 where
intToTBit :: Int -> IPv4
intToTBit = Int -> IPv4
intToTBitIPv4
isZero :: IPv4 -> IPv4 -> Bool
isZero IPv4
a IPv4
b = IPv4
a IPv4 -> IPv4 -> IPv4
forall a. Addr a => a -> a -> a
`masked` IPv4
b IPv4 -> IPv4 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv4Addr -> IPv4
IP4 IPv4Addr
0
instance Routable IPv6 where
intToTBit :: Int -> IPv6
intToTBit = Int -> IPv6
intToTBitIPv6
isZero :: IPv6 -> IPv6 -> Bool
isZero IPv6
a IPv6
b = IPv6
a IPv6 -> IPv6 -> IPv6
forall a. Addr a => a -> a -> a
`masked` IPv6
b IPv6 -> IPv6 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6Addr -> IPv6
IP6 (IPv4Addr
0,IPv4Addr
0,IPv4Addr
0,IPv4Addr
0)
intToTBitIPv4 :: Int -> IPv4
intToTBitIPv4 :: Int -> IPv4
intToTBitIPv4 Int
len = IPv4Addr -> IPv4
IP4 (IntMap IPv4Addr
intToTBitsIPv4 IntMap IPv4Addr -> Int -> IPv4Addr
forall a. IntMap a -> Int -> a
! Int
len)
intToTBitIPv6 :: Int -> IPv6
intToTBitIPv6 :: Int -> IPv6
intToTBitIPv6 Int
len = IPv6Addr -> IPv6
IP6 (IntMap IPv6Addr
intToTBitsIPv6 IntMap IPv6Addr -> Int -> IPv6Addr
forall a. IntMap a -> Int -> a
! Int
len)
intToTBitsWord32 :: [Word32]
intToTBitsWord32 :: [IPv4Addr]
intToTBitsWord32 = (IPv4Addr -> IPv4Addr) -> IPv4Addr -> [IPv4Addr]
forall a. (a -> a) -> a -> [a]
iterate (IPv4Addr -> Int -> IPv4Addr
forall a. Bits a => a -> Int -> a
`shift` (-Int
1)) IPv4Addr
0x80000000
intToTBitsIPv4 :: IntMap IPv4Addr
intToTBitsIPv4 :: IntMap IPv4Addr
intToTBitsIPv4 = [(Int, IPv4Addr)] -> IntMap IPv4Addr
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, IPv4Addr)] -> IntMap IPv4Addr)
-> [(Int, IPv4Addr)] -> IntMap IPv4Addr
forall a b. (a -> b) -> a -> b
$ [Int] -> [IPv4Addr] -> [(Int, IPv4Addr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
32] [IPv4Addr]
intToTBitsWord32
intToTBitsIPv6 :: IntMap IPv6Addr
intToTBitsIPv6 :: IntMap IPv6Addr
intToTBitsIPv6 = [(Int, IPv6Addr)] -> IntMap IPv6Addr
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, IPv6Addr)] -> IntMap IPv6Addr)
-> [(Int, IPv6Addr)] -> IntMap IPv6Addr
forall a b. (a -> b) -> a -> b
$ [Int] -> [IPv6Addr] -> [(Int, IPv6Addr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
128] [IPv6Addr]
bs
where
bs :: [IPv6Addr]
bs = [IPv6Addr]
b1 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b2 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b3 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b4 [IPv6Addr] -> [IPv6Addr] -> [IPv6Addr]
forall a. [a] -> [a] -> [a]
++ [IPv6Addr]
b5
b1 :: [IPv6Addr]
b1 = (IPv4Addr -> IPv6Addr) -> [IPv4Addr] -> [IPv6Addr]
forall a b. (a -> b) -> [a] -> [b]
map (\IPv4Addr
vbit -> (IPv4Addr
vbit,IPv4Addr
all0,IPv4Addr
all0,IPv4Addr
all0)) [IPv4Addr]
intToTBits
b2 :: [IPv6Addr]
b2 = (IPv4Addr -> IPv6Addr) -> [IPv4Addr] -> [IPv6Addr]
forall a b. (a -> b) -> [a] -> [b]
map (\IPv4Addr
vbit -> (IPv4Addr
all0,IPv4Addr
vbit,IPv4Addr
all0,IPv4Addr
all0)) [IPv4Addr]
intToTBits
b3 :: [IPv6Addr]
b3 = (IPv4Addr -> IPv6Addr) -> [IPv4Addr] -> [IPv6Addr]
forall a b. (a -> b) -> [a] -> [b]
map (\IPv4Addr
vbit -> (IPv4Addr
all0,IPv4Addr
all0,IPv4Addr
vbit,IPv4Addr
all0)) [IPv4Addr]
intToTBits
b4 :: [IPv6Addr]
b4 = (IPv4Addr -> IPv6Addr) -> [IPv4Addr] -> [IPv6Addr]
forall a b. (a -> b) -> [a] -> [b]
map (\IPv4Addr
vbit -> (IPv4Addr
all0,IPv4Addr
all0,IPv4Addr
all0,IPv4Addr
vbit)) [IPv4Addr]
intToTBits
b5 :: [IPv6Addr]
b5 = [(IPv4Addr
all0,IPv4Addr
all0,IPv4Addr
all0,IPv4Addr
all0)]
intToTBits :: [IPv4Addr]
intToTBits = Int -> [IPv4Addr] -> [IPv4Addr]
forall a. Int -> [a] -> [a]
take Int
32 [IPv4Addr]
intToTBitsWord32
all0 :: IPv4Addr
all0 = IPv4Addr
0x00000000
data IPRTable k a =
Nil
| Node !(AddrRange k) !k !(Maybe a) !(IPRTable k a) !(IPRTable k a)
deriving (IPRTable k a -> IPRTable k a -> Bool
(IPRTable k a -> IPRTable k a -> Bool)
-> (IPRTable k a -> IPRTable k a -> Bool) -> Eq (IPRTable k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq k, Eq a) => IPRTable k a -> IPRTable k a -> Bool
/= :: IPRTable k a -> IPRTable k a -> Bool
$c/= :: forall k a. (Eq k, Eq a) => IPRTable k a -> IPRTable k a -> Bool
== :: IPRTable k a -> IPRTable k a -> Bool
$c== :: forall k a. (Eq k, Eq a) => IPRTable k a -> IPRTable k a -> Bool
Eq, (forall x. IPRTable k a -> Rep (IPRTable k a) x)
-> (forall x. Rep (IPRTable k a) x -> IPRTable k a)
-> Generic (IPRTable k a)
forall x. Rep (IPRTable k a) x -> IPRTable k a
forall x. IPRTable k a -> Rep (IPRTable k a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k a x. Rep (IPRTable k a) x -> IPRTable k a
forall k a x. IPRTable k a -> Rep (IPRTable k a) x
$cto :: forall k a x. Rep (IPRTable k a) x -> IPRTable k a
$cfrom :: forall k a x. IPRTable k a -> Rep (IPRTable k a) x
Generic, (forall a. IPRTable k a -> Rep1 (IPRTable k) a)
-> (forall a. Rep1 (IPRTable k) a -> IPRTable k a)
-> Generic1 (IPRTable k)
forall a. Rep1 (IPRTable k) a -> IPRTable k a
forall a. IPRTable k a -> Rep1 (IPRTable k) a
forall k a. Rep1 (IPRTable k) a -> IPRTable k a
forall k a. IPRTable k a -> Rep1 (IPRTable k) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k a. Rep1 (IPRTable k) a -> IPRTable k a
$cfrom1 :: forall k a. IPRTable k a -> Rep1 (IPRTable k) a
Generic1, Int -> IPRTable k a -> ShowS
[IPRTable k a] -> ShowS
IPRTable k a -> String
(Int -> IPRTable k a -> ShowS)
-> (IPRTable k a -> String)
-> ([IPRTable k a] -> ShowS)
-> Show (IPRTable k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> IPRTable k a -> ShowS
forall k a. (Show k, Show a) => [IPRTable k a] -> ShowS
forall k a. (Show k, Show a) => IPRTable k a -> String
showList :: [IPRTable k a] -> ShowS
$cshowList :: forall k a. (Show k, Show a) => [IPRTable k a] -> ShowS
show :: IPRTable k a -> String
$cshow :: forall k a. (Show k, Show a) => IPRTable k a -> String
showsPrec :: Int -> IPRTable k a -> ShowS
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> IPRTable k a -> ShowS
Show)
empty :: Routable k => IPRTable k a
empty :: IPRTable k a
empty = IPRTable k a
forall k a. IPRTable k a
Nil
instance Functor (IPRTable k) where
fmap :: (a -> b) -> IPRTable k a -> IPRTable k b
fmap a -> b
_ IPRTable k a
Nil = IPRTable k b
forall k a. IPRTable k a
Nil
fmap a -> b
f (Node AddrRange k
r k
a Maybe a
mv IPRTable k a
b1 IPRTable k a
b2) = AddrRange k
-> k -> Maybe b -> IPRTable k b -> IPRTable k b -> IPRTable k b
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
r k
a (a -> b
f (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mv) ((a -> b) -> IPRTable k a -> IPRTable k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IPRTable k a
b1) ((a -> b) -> IPRTable k a -> IPRTable k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IPRTable k a
b2)
instance Foldable (IPRTable k) where
foldMap :: (a -> m) -> IPRTable k a -> m
foldMap a -> m
_ IPRTable k a
Nil = m
forall a. Monoid a => a
mempty
foldMap a -> m
f (Node AddrRange k
_ k
_ Maybe a
mv IPRTable k a
b1 IPRTable k a
b2) = (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Maybe a
mv m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> IPRTable k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f IPRTable k a
b1 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> IPRTable k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f IPRTable k a
b2
instance Traversable (IPRTable k) where
traverse :: (a -> f b) -> IPRTable k a -> f (IPRTable k b)
traverse a -> f b
_ IPRTable k a
Nil = IPRTable k b -> f (IPRTable k b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IPRTable k b
forall k a. IPRTable k a
Nil
traverse a -> f b
f (Node AddrRange k
r k
a Maybe a
mv IPRTable k a
b1 IPRTable k a
b2) = AddrRange k
-> k -> Maybe b -> IPRTable k b -> IPRTable k b -> IPRTable k b
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
r k
a (Maybe b -> IPRTable k b -> IPRTable k b -> IPRTable k b)
-> f (Maybe b) -> f (IPRTable k b -> IPRTable k b -> IPRTable k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Maybe a -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Maybe a
mv f (IPRTable k b -> IPRTable k b -> IPRTable k b)
-> f (IPRTable k b) -> f (IPRTable k b -> IPRTable k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> IPRTable k a -> f (IPRTable k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IPRTable k a
b1 f (IPRTable k b -> IPRTable k b)
-> f (IPRTable k b) -> f (IPRTable k b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> IPRTable k a -> f (IPRTable k b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IPRTable k a
b2
instance Routable k => Semigroup (IPRTable k a) where
IPRTable k a
a <> :: IPRTable k a -> IPRTable k a -> IPRTable k a
<> IPRTable k a
b = (IPRTable k a -> AddrRange k -> a -> IPRTable k a)
-> IPRTable k a -> IPRTable k a -> IPRTable k a
forall b k a.
(b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b
foldlWithKey (\IPRTable k a
rt AddrRange k
k a
v -> AddrRange k -> a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k a
v IPRTable k a
rt) IPRTable k a
a IPRTable k a
b
stimes :: b -> IPRTable k a -> IPRTable k a
stimes = b -> IPRTable k a -> IPRTable k a
forall b a. Integral b => b -> a -> a
stimesIdempotent
instance Routable k => Monoid (IPRTable k a) where
mempty :: IPRTable k a
mempty = IPRTable k a
forall k a. Routable k => IPRTable k a
empty
mappend :: IPRTable k a -> IPRTable k a -> IPRTable k a
mappend = IPRTable k a -> IPRTable k a -> IPRTable k a
forall a. Semigroup a => a -> a -> a
(<>)
insert :: (Routable k) => AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert :: AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k1 a
v1 IPRTable k a
Nil = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
forall k a. IPRTable k a
Nil IPRTable k a
forall k a. IPRTable k a
Nil
where
tb1 :: k
tb1 = AddrRange k -> k
forall k. Routable k => AddrRange k -> k
keyToTestBit AddrRange k
k1
insert AddrRange k
k1 a
v1 s :: IPRTable k a
s@(Node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
l IPRTable k a
r
| AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k2 k
tb2 Maybe a
v2 (AddrRange k -> a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k1 a
v1 IPRTable k a
l) IPRTable k a
r
else
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l (AddrRange k -> a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k1 a
v1 IPRTable k a
r)
| AddrRange k
k1 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k2 k
tb1 then
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
s IPRTable k a
forall k a. IPRTable k a
Nil
else
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
forall k a. IPRTable k a
Nil IPRTable k a
s
| Bool
otherwise = let n :: IPRTable k a
n = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k1 k
tb1 (a -> Maybe a
forall a. a -> Maybe a
Just a
v1) IPRTable k a
forall k a. IPRTable k a
Nil IPRTable k a
forall k a. IPRTable k a
Nil
in IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
IPRTable k a -> IPRTable k a -> IPRTable k a
link IPRTable k a
n IPRTable k a
s
where
tb1 :: k
tb1 = AddrRange k -> k
forall k. Routable k => AddrRange k -> k
keyToTestBit AddrRange k
k1
link :: Routable k => IPRTable k a -> IPRTable k a -> IPRTable k a
link :: IPRTable k a -> IPRTable k a -> IPRTable k a
link s1 :: IPRTable k a
s1@(Node AddrRange k
k1 k
_ Maybe a
_ IPRTable k a
_ IPRTable k a
_) s2 :: IPRTable k a
s2@(Node AddrRange k
k2 k
_ Maybe a
_ IPRTable k a
_ IPRTable k a
_)
| AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tbg = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
kg k
tbg Maybe a
forall a. Maybe a
Nothing IPRTable k a
s1 IPRTable k a
s2
| Bool
otherwise = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
kg k
tbg Maybe a
forall a. Maybe a
Nothing IPRTable k a
s2 IPRTable k a
s1
where
kg :: AddrRange k
kg = Int -> AddrRange k -> AddrRange k -> AddrRange k
forall k.
Routable k =>
Int -> AddrRange k -> AddrRange k -> AddrRange k
glue Int
0 AddrRange k
k1 AddrRange k
k2
tbg :: k
tbg = AddrRange k -> k
forall k. Routable k => AddrRange k -> k
keyToTestBit AddrRange k
kg
link IPRTable k a
_ IPRTable k a
_ = String -> IPRTable k a
forall a. HasCallStack => String -> a
error String
"link"
glue :: (Routable k) => Int -> AddrRange k -> AddrRange k -> AddrRange k
glue :: Int -> AddrRange k -> AddrRange k -> AddrRange k
glue Int
n AddrRange k
k1 AddrRange k
k2
| AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
k1 k -> k -> k
forall a. Addr a => a -> a -> a
`masked` k
mk k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
k2 k -> k -> k
forall a. Addr a => a -> a -> a
`masked` k
mk = Int -> AddrRange k -> AddrRange k -> AddrRange k
forall k.
Routable k =>
Int -> AddrRange k -> AddrRange k -> AddrRange k
glue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) AddrRange k
k1 AddrRange k
k2
| Bool
otherwise = k -> Int -> AddrRange k
forall a. Addr a => a -> Int -> AddrRange a
makeAddrRange (AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
k1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
mk :: k
mk = Int -> k
forall a. Addr a => Int -> a
intToMask Int
n
keyToTestBit :: Routable k => AddrRange k -> k
keyToTestBit :: AddrRange k -> k
keyToTestBit = Int -> k
forall a. Routable a => Int -> a
intToTBit (Int -> k) -> (AddrRange k -> Int) -> AddrRange k -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrRange k -> Int
forall a. AddrRange a -> Int
mlen
isLeft :: Routable k => AddrRange k -> k -> Bool
isLeft :: AddrRange k -> k -> Bool
isLeft AddrRange k
adr = k -> k -> Bool
forall a. Routable a => a -> a -> Bool
isZero (AddrRange k -> k
forall a. AddrRange a -> a
addr AddrRange k
adr)
delete :: (Routable k) => AddrRange k -> IPRTable k a -> IPRTable k a
delete :: AddrRange k -> IPRTable k a -> IPRTable k a
delete AddrRange k
_ IPRTable k a
Nil = IPRTable k a
forall k a. IPRTable k a
Nil
delete AddrRange k
k1 s :: IPRTable k a
s@(Node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
k2 k
tb2 Maybe a
forall a. Maybe a
Nothing IPRTable k a
l IPRTable k a
r
| AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
k2 k
tb2 Maybe a
v2 (AddrRange k -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> IPRTable k a -> IPRTable k a
delete AddrRange k
k1 IPRTable k a
l) IPRTable k a
r
else
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
k2 k
tb2 Maybe a
v2 IPRTable k a
l (AddrRange k -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> IPRTable k a -> IPRTable k a
delete AddrRange k
k1 IPRTable k a
r)
| Bool
otherwise = IPRTable k a
s
node :: (Routable k) => AddrRange k -> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node :: AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
Nil IPRTable k a
r = IPRTable k a
r
node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
Nil = IPRTable k a
l
node AddrRange k
k k
tb Maybe a
v IPRTable k a
l IPRTable k a
r = AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
forall k a.
AddrRange k
-> k -> Maybe a -> IPRTable k a -> IPRTable k a -> IPRTable k a
Node AddrRange k
k k
tb Maybe a
v IPRTable k a
l IPRTable k a
r
lookup :: Routable k => AddrRange k -> IPRTable k a -> Maybe a
lookup :: AddrRange k -> IPRTable k a -> Maybe a
lookup AddrRange k
k IPRTable k a
s = ((AddrRange k, a) -> a) -> Maybe (AddrRange k, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AddrRange k, a) -> a
forall a b. (a, b) -> b
snd (AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k IPRTable k a
s Maybe (AddrRange k, a)
forall a. Maybe a
Nothing)
lookupKeyValue :: Routable k => AddrRange k -> IPRTable k a -> Maybe (AddrRange k, a)
lookupKeyValue :: AddrRange k -> IPRTable k a -> Maybe (AddrRange k, a)
lookupKeyValue AddrRange k
k IPRTable k a
s = AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k IPRTable k a
s Maybe (AddrRange k, a)
forall a. Maybe a
Nothing
search :: Routable k => AddrRange k
-> IPRTable k a
-> Maybe (AddrRange k, a)
-> Maybe (AddrRange k, a)
search :: AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
_ IPRTable k a
Nil Maybe (AddrRange k, a)
res = Maybe (AddrRange k, a)
res
search AddrRange k
k1 (Node AddrRange k
k2 k
tb2 Maybe a
Nothing IPRTable k a
l IPRTable k a
r) Maybe (AddrRange k, a)
res
| AddrRange k
k1 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = Maybe (AddrRange k, a)
res
| AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
l Maybe (AddrRange k, a)
res
else
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
r Maybe (AddrRange k, a)
res
| Bool
otherwise = Maybe (AddrRange k, a)
res
search AddrRange k
k1 (Node AddrRange k
k2 k
tb2 (Just a
vl) IPRTable k a
l IPRTable k a
r) Maybe (AddrRange k, a)
res
| AddrRange k
k1 AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
k2 = (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a. a -> Maybe a
Just (AddrRange k
k1, a
vl)
| AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
k1 k
tb2 then
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
l (Maybe (AddrRange k, a) -> Maybe (AddrRange k, a))
-> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a b. (a -> b) -> a -> b
$ (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a. a -> Maybe a
Just (AddrRange k
k2, a
vl)
else
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall k a.
Routable k =>
AddrRange k
-> IPRTable k a -> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
search AddrRange k
k1 IPRTable k a
r (Maybe (AddrRange k, a) -> Maybe (AddrRange k, a))
-> Maybe (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a b. (a -> b) -> a -> b
$ (AddrRange k, a) -> Maybe (AddrRange k, a)
forall a. a -> Maybe a
Just (AddrRange k
k2, a
vl)
| Bool
otherwise = Maybe (AddrRange k, a)
res
lookupAll :: Routable k => AddrRange k -> IPRTable k a -> [(AddrRange k, a)]
lookupAll :: AddrRange k -> IPRTable k a -> [(AddrRange k, a)]
lookupAll AddrRange k
range = [(AddrRange k, a)] -> IPRTable k a -> [(AddrRange k, a)]
forall b. [(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go []
where
go :: [(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go [(AddrRange k, b)]
acc IPRTable k b
Nil = [(AddrRange k, b)]
acc
go [(AddrRange k, b)]
acc (Node AddrRange k
k k
tb Maybe b
Nothing IPRTable k b
l IPRTable k b
r)
| AddrRange k
k AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
range = [(AddrRange k, b)]
acc
| AddrRange k
k AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
range = [(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go [(AddrRange k, b)]
acc (IPRTable k b -> [(AddrRange k, b)])
-> IPRTable k b -> [(AddrRange k, b)]
forall a b. (a -> b) -> a -> b
$ if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
range k
tb then IPRTable k b
l else IPRTable k b
r
| Bool
otherwise = [(AddrRange k, b)]
acc
go [(AddrRange k, b)]
acc (Node AddrRange k
k k
tb (Just b
v) IPRTable k b
l IPRTable k b
r)
| AddrRange k
k AddrRange k -> AddrRange k -> Bool
forall a. Eq a => a -> a -> Bool
== AddrRange k
range = (AddrRange k
k,b
v)(AddrRange k, b) -> [(AddrRange k, b)] -> [(AddrRange k, b)]
forall a. a -> [a] -> [a]
:[(AddrRange k, b)]
acc
| AddrRange k
k AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
range = [(AddrRange k, b)] -> IPRTable k b -> [(AddrRange k, b)]
go ((AddrRange k
k,b
v)(AddrRange k, b) -> [(AddrRange k, b)] -> [(AddrRange k, b)]
forall a. a -> [a] -> [a]
:[(AddrRange k, b)]
acc) (IPRTable k b -> [(AddrRange k, b)])
-> IPRTable k b -> [(AddrRange k, b)]
forall a b. (a -> b) -> a -> b
$ if AddrRange k -> k -> Bool
forall k. Routable k => AddrRange k -> k -> Bool
isLeft AddrRange k
range k
tb then IPRTable k b
l else IPRTable k b
r
| Bool
otherwise = [(AddrRange k, b)]
acc
findMatch :: Alternative m => Routable k => AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch :: AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
_ IPRTable k a
Nil = m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a
A.empty
findMatch AddrRange k
k1 (Node AddrRange k
k2 k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| Bool
otherwise = m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a
A.empty
findMatch AddrRange k
k1 (Node AddrRange k
k2 k
_ (Just a
vl) IPRTable k a
l IPRTable k a
r)
| AddrRange k
k1 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k2 = (AddrRange k, a) -> m (AddrRange k, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddrRange k
k2, a
vl) m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| AddrRange k
k2 AddrRange k -> AddrRange k -> Bool
forall a. Addr a => AddrRange a -> AddrRange a -> Bool
>:> AddrRange k
k1 = AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
l m (AddrRange k, a) -> m (AddrRange k, a) -> m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AddrRange k -> IPRTable k a -> m (AddrRange k, a)
forall (m :: * -> *) k a.
(Alternative m, Routable k) =>
AddrRange k -> IPRTable k a -> m (AddrRange k, a)
findMatch AddrRange k
k1 IPRTable k a
r
| Bool
otherwise = m (AddrRange k, a)
forall (f :: * -> *) a. Alternative f => f a
A.empty
fromList :: Routable k => [(AddrRange k, a)] -> IPRTable k a
fromList :: [(AddrRange k, a)] -> IPRTable k a
fromList = (IPRTable k a -> (AddrRange k, a) -> IPRTable k a)
-> IPRTable k a -> [(AddrRange k, a)] -> IPRTable k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IPRTable k a
s (AddrRange k
k,a
v) -> AddrRange k -> a -> IPRTable k a -> IPRTable k a
forall k a.
Routable k =>
AddrRange k -> a -> IPRTable k a -> IPRTable k a
insert AddrRange k
k a
v IPRTable k a
s) IPRTable k a
forall k a. Routable k => IPRTable k a
empty
toList :: Routable k => IPRTable k a -> [(AddrRange k, a)]
toList :: IPRTable k a -> [(AddrRange k, a)]
toList = (IPRTable k a -> [(AddrRange k, a)] -> [(AddrRange k, a)])
-> [(AddrRange k, a)] -> IPRTable k a -> [(AddrRange k, a)]
forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> [(AddrRange k, a)] -> [(AddrRange k, a)]
forall k b.
IPRTable k b -> [(AddrRange k, b)] -> [(AddrRange k, b)]
toL []
where
toL :: IPRTable k b -> [(AddrRange k, b)] -> [(AddrRange k, b)]
toL IPRTable k b
Nil [(AddrRange k, b)]
xs = [(AddrRange k, b)]
xs
toL (Node AddrRange k
_ k
_ Maybe b
Nothing IPRTable k b
_ IPRTable k b
_) [(AddrRange k, b)]
xs = [(AddrRange k, b)]
xs
toL (Node AddrRange k
k k
_ (Just b
a) IPRTable k b
_ IPRTable k b
_) [(AddrRange k, b)]
xs = (AddrRange k
k,b
a) (AddrRange k, b) -> [(AddrRange k, b)] -> [(AddrRange k, b)]
forall a. a -> [a] -> [a]
: [(AddrRange k, b)]
xs
foldt :: (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt :: (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> b -> b
_ b
v IPRTable k a
Nil = b
v
foldt IPRTable k a -> b -> b
func b
v rt :: IPRTable k a
rt@(Node AddrRange k
_ k
_ Maybe a
_ IPRTable k a
l IPRTable k a
r) = (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> b -> b
func ((IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
forall k a b. (IPRTable k a -> b -> b) -> b -> IPRTable k a -> b
foldt IPRTable k a -> b -> b
func (IPRTable k a -> b -> b
func IPRTable k a
rt b
v) IPRTable k a
l) IPRTable k a
r
foldlWithKey :: (b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b
foldlWithKey :: (b -> AddrRange k -> a -> b) -> b -> IPRTable k a -> b
foldlWithKey b -> AddrRange k -> a -> b
f b
zr = b -> IPRTable k a -> b
go b
zr
where
go :: b -> IPRTable k a -> b
go b
z IPRTable k a
Nil = b
z
go b
z (Node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (b -> IPRTable k a -> b
go b
z IPRTable k a
l) IPRTable k a
r
go b
z (Node AddrRange k
n k
_ (Just a
v) IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (b -> AddrRange k -> a -> b
f (b -> IPRTable k a -> b
go b
z IPRTable k a
l) AddrRange k
n a
v) IPRTable k a
r
{-# INLINE foldlWithKey #-}
foldrWithKey :: (AddrRange k -> a -> b -> b) -> b -> IPRTable k a -> b
foldrWithKey :: (AddrRange k -> a -> b -> b) -> b -> IPRTable k a -> b
foldrWithKey AddrRange k -> a -> b -> b
f b
zr = b -> IPRTable k a -> b
go b
zr
where
go :: b -> IPRTable k a -> b
go b
z IPRTable k a
Nil = b
z
go b
z (Node AddrRange k
_ k
_ Maybe a
Nothing IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (b -> IPRTable k a -> b
go b
z IPRTable k a
r) IPRTable k a
l
go b
z (Node AddrRange k
n k
_ (Just a
v) IPRTable k a
l IPRTable k a
r) = b -> IPRTable k a -> b
go (AddrRange k -> a -> b -> b
f AddrRange k
n a
v (b -> IPRTable k a -> b
go b
z IPRTable k a
r)) IPRTable k a
l
{-# INLINE foldrWithKey #-}