{-# LANGUAGE NegativeLiterals #-}
module Net.DNSBase.NsecTypes
(
NsecTypes
, nsecTypesFromList
, nsecTypesToList
, getNsecTypes
, putNsecTypes
, hasRRtype
, NxtTypes(..)
, NxtRRtype
, toNxtTypes
, nxtTypesFromNE
, nxtTypesToNE
, getNxtTypes
, hasNxtRRtype
, module Net.DNSBase.NonEmpty
) where
import qualified Data.Primitive.ByteArray as A
import qualified Data.ByteString.Short as SB
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import GHC.IsList(IsList(..))
import Net.DNSBase.Internal.Util
import Net.DNSBase.Decode.State
import Net.DNSBase.Encode.State
import Net.DNSBase.NonEmpty
import Net.DNSBase.Present
import Net.DNSBase.RData
import Net.DNSBase.RRTYPE
import Net.DNSBase.Text
newtype NsecTypes = NsecTypes (IM.IntMap ShortByteString) deriving NsecTypes -> NsecTypes -> Bool
(NsecTypes -> NsecTypes -> Bool)
-> (NsecTypes -> NsecTypes -> Bool) -> Eq NsecTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NsecTypes -> NsecTypes -> Bool
== :: NsecTypes -> NsecTypes -> Bool
$c/= :: NsecTypes -> NsecTypes -> Bool
/= :: NsecTypes -> NsecTypes -> Bool
Eq
instance Ord NsecTypes where
NsecTypes
a compare :: NsecTypes -> NsecTypes -> Ordering
`compare` NsecTypes
b = NsecTypes -> IntMap DnsText
asDnsTextMap NsecTypes
a IntMap DnsText -> IntMap DnsText -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` NsecTypes -> IntMap DnsText
asDnsTextMap NsecTypes
b
where
asDnsTextMap :: NsecTypes -> IM.IntMap DnsText
asDnsTextMap :: NsecTypes -> IntMap DnsText
asDnsTextMap = NsecTypes -> IntMap DnsText
forall a b. Coercible a b => a -> b
coerce
instance IsList NsecTypes where
type Item NsecTypes = RRTYPE
toList :: NsecTypes -> [Item NsecTypes]
toList = NsecTypes -> [Item NsecTypes]
NsecTypes -> [RRTYPE]
nsecTypesToList
fromList :: [Item NsecTypes] -> NsecTypes
fromList = [Item NsecTypes] -> NsecTypes
[RRTYPE] -> NsecTypes
nsecTypesFromList
instance Show NsecTypes where
showsPrec :: Int -> NsecTypes -> ShowS
showsPrec Int
p (NsecTypes -> [Item NsecTypes]
forall l. IsList l => l -> [Item l]
toList -> [Item NsecTypes]
tys) = Int -> ShowS -> ShowS
showsP Int
p (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList @NsecTypes "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RRTYPE] -> ShowS
forall a. Show a => a -> ShowS
shows' [Item NsecTypes]
[RRTYPE]
tys
instance Presentable NsecTypes where
present :: NsecTypes -> Builder -> Builder
present NsecTypes
ts Builder
k = case NsecTypes -> [Item NsecTypes]
forall l. IsList l => l -> [Item l]
toList NsecTypes
ts of
Item NsecTypes
t : [Item NsecTypes]
rest -> RRTYPE -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Item NsecTypes
RRTYPE
t (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (RRTYPE -> Builder -> Builder) -> Builder -> [RRTYPE] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RRTYPE -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp Builder
k [Item NsecTypes]
[RRTYPE]
rest
[] -> Builder
k
instance Semigroup NsecTypes where
NsecTypes
a <> :: NsecTypes -> NsecTypes -> NsecTypes
<> NsecTypes
b = IntMap ShortByteString -> NsecTypes
forall a b. Coercible a b => a -> b
coerce (IntMap ShortByteString -> NsecTypes)
-> IntMap ShortByteString -> NsecTypes
forall a b. (a -> b) -> a -> b
$ (ShortByteString -> ShortByteString -> ShortByteString)
-> IntMap ShortByteString
-> IntMap ShortByteString
-> IntMap ShortByteString
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith ShortByteString -> ShortByteString -> ShortByteString
mergeBitmaps (NsecTypes -> IntMap ShortByteString
forall a b. Coercible a b => a -> b
coerce NsecTypes
a) (NsecTypes -> IntMap ShortByteString
forall a b. Coercible a b => a -> b
coerce NsecTypes
b)
mergeBitmaps :: ShortByteString -> ShortByteString -> ShortByteString
mergeBitmaps :: ShortByteString -> ShortByteString -> ShortByteString
mergeBitmaps ShortByteString
win1 ShortByteString
win2
| ShortByteString -> Int
SB.length ShortByteString
win1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ShortByteString -> Int
SB.length ShortByteString
win2 = ShortByteString -> ShortByteString -> ShortByteString
merge ShortByteString
win1 ShortByteString
win2
| Bool
otherwise = ShortByteString -> ShortByteString -> ShortByteString
merge ShortByteString
win2 ShortByteString
win1
where
merge :: ShortByteString -> ShortByteString -> ShortByteString
merge ShortByteString
sb1 sb2 :: ShortByteString
sb2@(ShortByteString -> Int
SB.length -> Int
len2) = ByteArray -> ShortByteString
baToShortByteString (ByteArray -> ShortByteString) -> ByteArray -> ShortByteString
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
A.runByteArray do
muta <- ShortByteString -> ST s (MutableByteArray s)
forall s. ShortByteString -> ST s (MutableByteArray s)
sbsToMutableByteArray ShortByteString
sb1
let a = ShortByteString -> ByteArray
sbsToByteArray ShortByteString
sb2
sequence_ [ modifyArray muta i (.|. A.indexByteArray a i)
| i <- [0..len2 - 1] ]
pure muta
toBitmaps :: NsecTypes -> [(Int, ShortByteString)]
toBitmaps :: NsecTypes -> [(Int, ShortByteString)]
toBitmaps = IntMap ShortByteString -> [(Int, ShortByteString)]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap ShortByteString -> [(Int, ShortByteString)])
-> (NsecTypes -> IntMap ShortByteString)
-> NsecTypes
-> [(Int, ShortByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NsecTypes -> IntMap ShortByteString
forall a b. Coercible a b => a -> b
coerce
hasRRtype :: RRTYPE -> NsecTypes -> Bool
hasRRtype :: RRTYPE -> NsecTypes -> Bool
hasRRtype (RRTYPE -> (Int, Int, Int)
splitRRtype -> (Int
window, Int
block, Int
bitpos)) (NsecTypes -> IntMap ShortByteString
forall a b. Coercible a b => a -> b
coerce -> IntMap ShortByteString
im)
| Just ShortByteString
sb <- Int -> IntMap ShortByteString -> Maybe ShortByteString
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
window IntMap ShortByteString
im
, Just Word8
byte <- ShortByteString -> Int -> Maybe Word8
SB.indexMaybe ShortByteString
sb Int
block
= Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
bitpos
| Bool
otherwise = Bool
False
nsecTypesToList :: NsecTypes -> [RRTYPE]
nsecTypesToList :: NsecTypes -> [RRTYPE]
nsecTypesToList = ((Int, ShortByteString) -> [RRTYPE] -> [RRTYPE])
-> [RRTYPE] -> [(Int, ShortByteString)] -> [RRTYPE]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Int -> ShortByteString -> [RRTYPE] -> [RRTYPE])
-> (Int, ShortByteString) -> [RRTYPE] -> [RRTYPE]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ShortByteString -> [RRTYPE] -> [RRTYPE]
windowTypes) [] ([(Int, ShortByteString)] -> [RRTYPE])
-> (NsecTypes -> [(Int, ShortByteString)]) -> NsecTypes -> [RRTYPE]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NsecTypes -> [(Int, ShortByteString)]
toBitmaps
where
windowTypes :: Int -> ShortByteString -> [RRTYPE] -> [RRTYPE]
windowTypes :: Int -> ShortByteString -> [RRTYPE] -> [RRTYPE]
windowTypes (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Word16
window) = Word16 -> [Word8] -> [RRTYPE] -> [RRTYPE]
go Word16
0 ([Word8] -> [RRTYPE] -> [RRTYPE])
-> (ShortByteString -> [Word8])
-> ShortByteString
-> [RRTYPE]
-> [RRTYPE]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word8]
SB.unpack
where
go :: Word16 -> [Word8] -> [RRTYPE] -> [RRTYPE]
go :: Word16 -> [Word8] -> [RRTYPE] -> [RRTYPE]
go !Word16
block (Word8
w : [Word8]
ws) [RRTYPE]
r
| Int
z <- Word8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word8
w
, Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
, Word16
ty <- Word16
window Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
block Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z
= Word16 -> RRTYPE
RRTYPE Word16
ty RRTYPE -> [RRTYPE] -> [RRTYPE]
forall a. a -> [a] -> [a]
: Word16 -> [Word8] -> [RRTYPE] -> [RRTYPE]
go Word16
block (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` (Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
z) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
ws) [RRTYPE]
r
| Bool
otherwise = Word16 -> [Word8] -> [RRTYPE] -> [RRTYPE]
go (Word16
block Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
8) [Word8]
ws [RRTYPE]
r
go Word16
_ [Word8]
_ [RRTYPE]
r = [RRTYPE]
r
nsecTypesFromList :: [RRTYPE] -> NsecTypes
nsecTypesFromList :: [RRTYPE] -> NsecTypes
nsecTypesFromList ([Int] -> IntSet
IS.fromList ([Int] -> IntSet) -> ([RRTYPE] -> [Int]) -> [RRTYPE] -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RRTYPE -> Int) -> [RRTYPE] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map RRTYPE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> IntSet
tys) =
IntMap ShortByteString -> NsecTypes
NsecTypes (IntMap ShortByteString -> NsecTypes)
-> IntMap ShortByteString -> NsecTypes
forall a b. (a -> b) -> a -> b
$ [(Int, ShortByteString)] -> IntMap ShortByteString
forall a. [(Int, a)] -> IntMap a
IM.fromAscList ([(Int, ShortByteString)] -> IntMap ShortByteString)
-> [(Int, ShortByteString)] -> IntMap ShortByteString
forall a b. (a -> b) -> a -> b
$ Maybe Int -> IntSet -> [(Int, ShortByteString)]
go Maybe Int
forall a. Maybe a
Nothing IntSet
tys
where
go :: Maybe Int -> IntSet -> [(Int, ShortByteString)]
go Maybe Int
bit0 (IntSet -> Bool
IS.null -> Bool
True)
| Just Int
off <- Maybe Int
bit0 = (Int
off, Word8 -> ShortByteString
SB.singleton Word8
0x80) (Int, ShortByteString)
-> [(Int, ShortByteString)] -> [(Int, ShortByteString)]
forall a. a -> [a] -> [a]
: []
| Bool
otherwise = []
go Maybe Int
bit0 s :: IntSet
s@((Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff00) (Int -> Int) -> (IntSet -> Int) -> IntSet -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Int
IS.findMin -> Int
winbot)
| Maybe Int
bit0 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
winbot
, ShortByteString
sb <- Int -> [Int] -> ShortByteString
newSB Int
top (Int
winbot Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: IntSet -> [Int]
IS.toList IntSet
this)
, (Int, ShortByteString)
slice <- (Int
winbot, ShortByteString
sb)
= (Int, ShortByteString)
slice (Int, ShortByteString)
-> [(Int, ShortByteString)] -> [(Int, ShortByteString)]
forall a. a -> [a] -> [a]
: Maybe Int -> IntSet -> [(Int, ShortByteString)]
go Maybe Int
next0 IntSet
rest
| ShortByteString
sb <- Int -> [Int] -> ShortByteString
newSB Int
top (IntSet -> [Int]
IS.toList IntSet
this)
, [(Int, ShortByteString)]
out <- (Int
winbot, ShortByteString
sb) (Int, ShortByteString)
-> [(Int, ShortByteString)] -> [(Int, ShortByteString)]
forall a. a -> [a] -> [a]
: Maybe Int -> IntSet -> [(Int, ShortByteString)]
go Maybe Int
next0 IntSet
rest
= ([(Int, ShortByteString)] -> [(Int, ShortByteString)])
-> (Int -> [(Int, ShortByteString)] -> [(Int, ShortByteString)])
-> Maybe Int
-> [(Int, ShortByteString)]
-> [(Int, ShortByteString)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Int, ShortByteString)] -> [(Int, ShortByteString)]
forall a. a -> a
id Int -> [(Int, ShortByteString)] -> [(Int, ShortByteString)]
forall {a}. a -> [(a, ShortByteString)] -> [(a, ShortByteString)]
loner Maybe Int
bit0 [(Int, ShortByteString)]
out
where
loner :: a -> [(a, ShortByteString)] -> [(a, ShortByteString)]
loner a
zero = (:) (a
zero, Word8 -> ShortByteString
SB.singleton Word8
0x80)
winnxt :: Int
winnxt = Int
winbot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
256
(IntSet
this, Bool
full, IntSet
rest) = Int -> IntSet -> (IntSet, Bool, IntSet)
IS.splitMember Int
winnxt IntSet
s
top :: Int
top = (IntSet -> Int
IS.findMax IntSet
this Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x001f
next0 :: Maybe Int
next0 = Maybe Int -> Maybe Int -> Bool -> Maybe Int
forall a. a -> a -> Bool -> a
bool Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
winnxt) Bool
full
newSB :: Int -> [Int] -> ShortByteString
newSB Int
top = ByteArray -> ShortByteString
baToShortByteString (ByteArray -> ShortByteString)
-> ([Int] -> ByteArray) -> [Int] -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ByteArray
mkArray
where
mkArray :: [Int] -> ByteArray
mkArray :: [Int] -> ByteArray
mkArray [Int]
ts = (forall s. ST s (MutableByteArray s)) -> ByteArray
A.runByteArray do
a <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
A.newByteArray (Int -> ST s (MutableByteArray (PrimState (ST s))))
-> Int -> ST s (MutableByteArray (PrimState (ST s)))
forall a b. (a -> b) -> a -> b
$ Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
A.fillByteArray a 0 (top + 1) 0
sequence_
[ modifyArray a byte (`setBit` bitpos)
| t <- ts
, let byte = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
t Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f
, let bitpos = Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7) ]
pure a
getNsecTypes :: Int -> SGet NsecTypes
getNsecTypes :: Int -> SGet NsecTypes
getNsecTypes !Int
len = do
pos0 <- SGet Int
getPosition
loop (pos0 + len) -1 pos0 $ IM.empty
where
loop :: Int -> Int -> Int -> IM.IntMap ShortByteString -> SGet NsecTypes
loop :: Int -> Int -> Int -> IntMap ShortByteString -> SGet NsecTypes
loop !Int
end = Int -> Int -> IntMap ShortByteString -> SGet NsecTypes
go
where
go :: Int -> Int -> IM.IntMap ShortByteString -> SGet NsecTypes
go :: Int -> Int -> IntMap ShortByteString -> SGet NsecTypes
go Int
_ !Int
pos0 !IntMap ShortByteString
m | Int
pos0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end = NsecTypes -> SGet NsecTypes
forall a. a -> SGet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NsecTypes -> SGet NsecTypes) -> NsecTypes -> SGet NsecTypes
forall a b. (a -> b) -> a -> b
$ IntMap ShortByteString -> NsecTypes
forall a b. Coercible a b => a -> b
coerce IntMap ShortByteString
m
go !Int
off0 !Int
_ !IntMap ShortByteString
m = do
off1 <- SGet Int
getOffset
when (off1 <= off0) do
failSGet "Non-monotone NSEC window offsets"
blks <- getBlocks
pos1 <- getPosition
go off1 pos1 $ IM.insert off1 blks m
getOffset :: SGet Int
getOffset = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) (Int -> Int) -> SGet Int -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Int
getInt8
getBlocks :: SGet ShortByteString
getBlocks = do
nblk <- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> SGet Int -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Int
getInt8
when (nblk > 32) do
failSGet "Bad NSEC bitmap block count"
!blks <- getShortNByteString nblk
case SB.indexMaybe blks (nblk - 1) of
Maybe Word8
Nothing -> String -> SGet ShortByteString
forall a. String -> SGet a
failSGet String
"Empty NSEC bitmap window"
Just Word8
0 -> String -> SGet ShortByteString
forall a. String -> SGet a
failSGet String
"Empty NSEC bitmap tail block"
Maybe Word8
_ -> ShortByteString -> SGet ShortByteString
forall a. a -> SGet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortByteString
blks
putNsecTypes :: NsecTypes -> SPut s RData
putNsecTypes :: forall s. NsecTypes -> SPut s RData
putNsecTypes = ((Int, ShortByteString) -> SPutM s RData ())
-> [(Int, ShortByteString)] -> SPutM s RData ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int -> ShortByteString -> SPutM s RData ())
-> (Int, ShortByteString) -> SPutM s RData ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ShortByteString -> SPutM s RData ()
forall {r} {a} {s}.
(Typeable r, Show r, Integral a, Bits a, Eq r) =>
a -> ShortByteString -> SPutM s r ()
putBitmap) ([(Int, ShortByteString)] -> SPutM s RData ())
-> (NsecTypes -> [(Int, ShortByteString)])
-> NsecTypes
-> SPutM s RData ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NsecTypes -> [(Int, ShortByteString)]
toBitmaps
where
putBitmap :: a -> ShortByteString -> SPutM s r ()
putBitmap a
offset ShortByteString
sb = do
Word8 -> SPutM s r ()
forall r s. ErrorContext r => Word8 -> SPut s r
put8 (Word8 -> SPutM s r ()) -> Word8 -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word8) -> a -> Word8
forall a b. (a -> b) -> a -> b
$ a
offset a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
8
ShortByteString -> SPutM s r ()
forall r s. ErrorContext r => ShortByteString -> SPut s r
putShortByteStringLen8 ShortByteString
sb
splitRRtype :: RRTYPE -> (Int, Int, Int)
splitRRtype :: RRTYPE -> (Int, Int, Int)
splitRRtype (RRTYPE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
ty) = (Int
window, Int
block, Int
bitpos)
where
!window :: Int
window = Int
ty Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff00
!winrel :: Int
winrel = Int
ty Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x00ff
!block :: Int
block = Int
winrel Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
!bitpos :: Int
bitpos = Int -> Int
forall a. Bits a => a -> a
complement Int
winrel Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x07
newtype NxtRRtype = RT7 Word16 deriving (NxtRRtype -> NxtRRtype -> Bool
(NxtRRtype -> NxtRRtype -> Bool)
-> (NxtRRtype -> NxtRRtype -> Bool) -> Eq NxtRRtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NxtRRtype -> NxtRRtype -> Bool
== :: NxtRRtype -> NxtRRtype -> Bool
$c/= :: NxtRRtype -> NxtRRtype -> Bool
/= :: NxtRRtype -> NxtRRtype -> Bool
Eq, Eq NxtRRtype
Eq NxtRRtype =>
(NxtRRtype -> NxtRRtype -> Ordering)
-> (NxtRRtype -> NxtRRtype -> Bool)
-> (NxtRRtype -> NxtRRtype -> Bool)
-> (NxtRRtype -> NxtRRtype -> Bool)
-> (NxtRRtype -> NxtRRtype -> Bool)
-> (NxtRRtype -> NxtRRtype -> NxtRRtype)
-> (NxtRRtype -> NxtRRtype -> NxtRRtype)
-> Ord NxtRRtype
NxtRRtype -> NxtRRtype -> Bool
NxtRRtype -> NxtRRtype -> Ordering
NxtRRtype -> NxtRRtype -> NxtRRtype
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NxtRRtype -> NxtRRtype -> Ordering
compare :: NxtRRtype -> NxtRRtype -> Ordering
$c< :: NxtRRtype -> NxtRRtype -> Bool
< :: NxtRRtype -> NxtRRtype -> Bool
$c<= :: NxtRRtype -> NxtRRtype -> Bool
<= :: NxtRRtype -> NxtRRtype -> Bool
$c> :: NxtRRtype -> NxtRRtype -> Bool
> :: NxtRRtype -> NxtRRtype -> Bool
$c>= :: NxtRRtype -> NxtRRtype -> Bool
>= :: NxtRRtype -> NxtRRtype -> Bool
$cmax :: NxtRRtype -> NxtRRtype -> NxtRRtype
max :: NxtRRtype -> NxtRRtype -> NxtRRtype
$cmin :: NxtRRtype -> NxtRRtype -> NxtRRtype
min :: NxtRRtype -> NxtRRtype -> NxtRRtype
Ord)
instance Bounded NxtRRtype where
minBound :: NxtRRtype
minBound = Word16 -> NxtRRtype
RT7 Word16
0
maxBound :: NxtRRtype
maxBound = Word16 -> NxtRRtype
RT7 Word16
127
instance Enum NxtRRtype where
fromEnum :: NxtRRtype -> Int
fromEnum (RT7 Word16
t) = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
t
toEnum :: Int -> NxtRRtype
toEnum Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
128 = Word16 -> NxtRRtype
RT7 (Word16 -> NxtRRtype) -> Word16 -> NxtRRtype
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
| Bool
otherwise = String -> NxtRRtype
forall a. String -> a
errorWithoutStackTrace String
"NxtRRtype.toEnum: bad argument"
pred :: NxtRRtype -> NxtRRtype
pred (RT7 Word16
t) | Word16
t Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
0 = Word16 -> NxtRRtype
RT7 (Word16
t Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
1)
| Bool
otherwise = String -> NxtRRtype
forall a. String -> a
errorWithoutStackTrace String
"NxtRRtype.pred: bad argument"
succ :: NxtRRtype -> NxtRRtype
succ (RT7 Word16
t) | Word16
t Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
127 = Word16 -> NxtRRtype
RT7 (Word16
t Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1)
| Bool
otherwise = String -> NxtRRtype
forall a. String -> a
errorWithoutStackTrace String
"NxtRRtype.succ: bad argument"
instance Show NxtRRtype where
showsPrec :: Int -> NxtRRtype -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec @RRTYPE Int
p (RRTYPE -> ShowS) -> (NxtRRtype -> RRTYPE) -> NxtRRtype -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NxtRRtype -> RRTYPE
forall a b. Coercible a b => a -> b
coerce
instance Presentable NxtRRtype where
present :: NxtRRtype -> Builder -> Builder
present = forall a. Presentable a => a -> Builder -> Builder
present @RRTYPE (RRTYPE -> Builder -> Builder)
-> (NxtRRtype -> RRTYPE) -> NxtRRtype -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NxtRRtype -> RRTYPE
forall a b. Coercible a b => a -> b
coerce
newtype NxtTypes = NxtTypes ShortByteString deriving NxtTypes -> NxtTypes -> Bool
(NxtTypes -> NxtTypes -> Bool)
-> (NxtTypes -> NxtTypes -> Bool) -> Eq NxtTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NxtTypes -> NxtTypes -> Bool
== :: NxtTypes -> NxtTypes -> Bool
$c/= :: NxtTypes -> NxtTypes -> Bool
/= :: NxtTypes -> NxtTypes -> Bool
Eq
instance Ord NxtTypes where
(NxtTypes ShortByteString
a) compare :: NxtTypes -> NxtTypes -> Ordering
`compare` (NxtTypes ShortByteString
b) = ShortByteString
a ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ShortByteString
b
instance IsNonEmptyList NxtTypes where
type Item1 NxtTypes = NxtRRtype
toNonEmptyList :: NxtTypes -> NonEmpty (Item1 NxtTypes)
toNonEmptyList = NxtTypes -> NonEmpty (Item1 NxtTypes)
NxtTypes -> NonEmpty NxtRRtype
nxtTypesToNE
fromNonEmptyList :: NonEmpty (Item1 NxtTypes) -> NxtTypes
fromNonEmptyList = NonEmpty (Item1 NxtTypes) -> NxtTypes
NonEmpty NxtRRtype -> NxtTypes
nxtTypesFromNE
instance Presentable NxtTypes where
present :: NxtTypes -> Builder -> Builder
present (NxtTypes -> NonEmpty (Item1 NxtTypes)
forall a. IsNonEmptyList a => a -> NonEmpty (Item1 a)
toNonEmptyList -> (Item1 NxtTypes
ty :| [Item1 NxtTypes]
tys)) =
NxtRRtype -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Item1 NxtTypes
NxtRRtype
ty
(Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> [NxtRRtype] -> Builder)
-> [NxtRRtype] -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((NxtRRtype -> Builder -> Builder)
-> Builder -> [NxtRRtype] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NxtRRtype -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp) [Item1 NxtTypes]
[NxtRRtype]
tys
instance Show NxtTypes where
showsPrec :: Int -> NxtTypes -> ShowS
showsPrec Int
p (NxtTypes -> NonEmpty (Item1 NxtTypes)
forall a. IsNonEmptyList a => a -> NonEmpty (Item1 a)
toNonEmptyList -> NonEmpty (Item1 NxtTypes)
tys) = Int -> ShowS -> ShowS
showsP Int
p (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromNonEmptyList @NxtTypes " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NxtRRtype -> ShowS
forall a. Show a => a -> ShowS
shows' NonEmpty (Item1 NxtTypes)
NonEmpty NxtRRtype
tys
instance Semigroup NxtTypes where
NxtTypes
a <> :: NxtTypes -> NxtTypes -> NxtTypes
<> NxtTypes
b = ShortByteString -> NxtTypes
forall a b. Coercible a b => a -> b
coerce (ShortByteString -> NxtTypes) -> ShortByteString -> NxtTypes
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ShortByteString -> ShortByteString
mergeBitmaps (NxtTypes -> ShortByteString
forall a b. Coercible a b => a -> b
coerce NxtTypes
a) (NxtTypes -> ShortByteString
forall a b. Coercible a b => a -> b
coerce NxtTypes
b)
toNxtTypes :: NonEmpty RRTYPE -> NxtTypes
toNxtTypes :: NonEmpty RRTYPE -> NxtTypes
toNxtTypes = NonEmpty (Item1 NxtTypes) -> NxtTypes
NonEmpty NxtRRtype -> NxtTypes
forall a. IsNonEmptyList a => NonEmpty (Item1 a) -> a
fromNonEmptyList (NonEmpty NxtRRtype -> NxtTypes)
-> (NonEmpty RRTYPE -> NonEmpty NxtRRtype)
-> NonEmpty RRTYPE
-> NxtTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RRTYPE -> NxtRRtype) -> NonEmpty RRTYPE -> NonEmpty NxtRRtype
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> NxtRRtype
forall a. Enum a => Int -> a
toEnum (Int -> NxtRRtype) -> (RRTYPE -> Int) -> RRTYPE -> NxtRRtype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RRTYPE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
nxtTypesToNE :: NxtTypes -> NonEmpty NxtRRtype
nxtTypesToNE :: NxtTypes -> NonEmpty NxtRRtype
nxtTypesToNE = [Item (NonEmpty NxtRRtype)] -> NonEmpty NxtRRtype
[NxtRRtype] -> NonEmpty NxtRRtype
forall l. IsList l => [Item l] -> l
fromList ([NxtRRtype] -> NonEmpty NxtRRtype)
-> (NxtTypes -> [NxtRRtype]) -> NxtTypes -> NonEmpty NxtRRtype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> [Word8] -> [NxtRRtype]
go Word16
0 ([Word8] -> [NxtRRtype])
-> (NxtTypes -> [Word8]) -> NxtTypes -> [NxtRRtype]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word8]
SB.unpack (ShortByteString -> [Word8])
-> (NxtTypes -> ShortByteString) -> NxtTypes -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NxtTypes -> ShortByteString
forall a b. Coercible a b => a -> b
coerce
where
go :: Word16 -> [Word8] -> [NxtRRtype]
go :: Word16 -> [Word8] -> [NxtRRtype]
go !Word16
block (Word8
w : [Word8]
ws)
| Int
z <- Word8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word8
w
, Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
, Word16
ty <- Word16
block Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z
= Word16 -> NxtRRtype
RT7 Word16
ty NxtRRtype -> [NxtRRtype] -> [NxtRRtype]
forall a. a -> [a] -> [a]
: Word16 -> [Word8] -> [NxtRRtype]
go Word16
block (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` (Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
z) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
ws)
| Bool
otherwise = Word16 -> [Word8] -> [NxtRRtype]
go (Word16
block Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
8) [Word8]
ws
go Word16
_ [Word8]
_ = []
forceNxt :: NonEmpty NxtRRtype -> [Int]
forceNxt :: NonEmpty NxtRRtype -> [Int]
forceNxt (NxtRRtype
ty :| [NxtRRtype]
tys) =
RRTYPE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral RRTYPE
NXT Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: NxtRRtype -> Int
forall a. Enum a => a -> Int
fromEnum NxtRRtype
ty Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (NxtRRtype -> Int) -> [NxtRRtype] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map NxtRRtype -> Int
forall a. Enum a => a -> Int
fromEnum [NxtRRtype]
tys
nxtTypesFromNE :: NonEmpty NxtRRtype -> NxtTypes
nxtTypesFromNE :: NonEmpty NxtRRtype -> NxtTypes
nxtTypesFromNE ([Int] -> IntSet
IS.fromList ([Int] -> IntSet)
-> (NonEmpty NxtRRtype -> [Int]) -> NonEmpty NxtRRtype -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NxtRRtype -> [Int]
forceNxt -> IntSet
s) =
ShortByteString -> NxtTypes
NxtTypes (ShortByteString -> NxtTypes) -> ShortByteString -> NxtTypes
forall a b. (a -> b) -> a -> b
$ [Int] -> ShortByteString
newSB (IntSet -> [Int]
IS.toList IntSet
s)
where
top :: Int
top = (IntSet -> Int
IS.findMax IntSet
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x001f
newSB :: [Int] -> ShortByteString
newSB = ByteArray -> ShortByteString
baToShortByteString (ByteArray -> ShortByteString)
-> ([Int] -> ByteArray) -> [Int] -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ByteArray
mkArray
where
mkArray :: [Int] -> ByteArray
mkArray :: [Int] -> ByteArray
mkArray [Int]
ts = (forall s. ST s (MutableByteArray s)) -> ByteArray
A.runByteArray do
a <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
A.newByteArray (Int -> ST s (MutableByteArray (PrimState (ST s))))
-> Int -> ST s (MutableByteArray (PrimState (ST s)))
forall a b. (a -> b) -> a -> b
$ Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
A.fillByteArray a 0 (top + 1) 0
sequence_
[ modifyArray a byte (`setBit` bitpos)
| t <- ts
, let byte = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
t Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f
, let bitpos = Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7) ]
pure a
hasNxtRRtype :: RRTYPE -> NxtTypes -> Bool
hasNxtRRtype :: RRTYPE -> NxtTypes -> Bool
hasNxtRRtype (RRTYPE -> (Int, Int, Int)
splitRRtype -> (Int
window, Int
block, Int
bitpos)) (NxtTypes -> ShortByteString
forall a b. Coercible a b => a -> b
coerce -> ShortByteString
sb)
| Int
window Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
, Just Word8
byte <- ShortByteString -> Int -> Maybe Word8
SB.indexMaybe ShortByteString
sb Int
block
= Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
byte Int
bitpos
| Bool
otherwise = Bool
False
getNxtTypes :: Int -> SGet NxtTypes
getNxtTypes :: Int -> SGet NxtTypes
getNxtTypes !Int
len = do
Bool -> SGet () -> SGet ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
16) do
String -> SGet ()
forall a. String -> SGet a
failSGet String
"Bad NXT bitmap size"
!blks <- Int -> SGet ShortByteString
getShortNByteString Int
len
case SB.indexMaybe blks (len - 1) of
Maybe Word8
Nothing -> String -> SGet NxtTypes
forall a. String -> SGet a
failSGet String
"Empty NXT bitmap"
Just Word8
0 -> String -> SGet NxtTypes
forall a. String -> SGet a
failSGet String
"Empty NSEC bitmap last byte"
Maybe Word8
_ -> NxtTypes -> SGet NxtTypes
forall a. a -> SGet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NxtTypes -> SGet NxtTypes) -> NxtTypes -> SGet NxtTypes
forall a b. (a -> b) -> a -> b
$ ShortByteString -> NxtTypes
forall a b. Coercible a b => a -> b
coerce ShortByteString
blks