{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE CPP           #-}
{-# LANGUAGE MagicHash     #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Network.DNS.Pattern.Internal
-- Description : Internal DNS types and definitions
--
-- This module is not part of public API and may change even between patch versions.

module Network.DNS.Internal
  ( DomainLabel(..)
  , Domain(..)
  , DList(..)
  , toDList
  , fromDList
  , singleton
  , sbsMap
  , sbsSingleton
  )

where

import           Data.Function (on)
import           GHC.Word
#if !MIN_VERSION_bytestring(0,11,3)
import           Control.Monad.ST (runST)
import           Data.ByteString.Short.Internal (ShortByteString(SBS))
import           GHC.Exts (Int#, MutableByteArray#, indexWord8Array#,
                           newByteArray#, unsafeFreezeByteArray#,
                           writeWord8Array#, (+#))
import           GHC.Int (Int(..))
import           GHC.ST (ST(..))
#endif

import qualified Data.ByteString.Short as BS

-- | Domain label with case-insensitive 'Eq' and 'Ord' as per [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343#section-3).
data DomainLabel = DomainLabel { DomainLabel -> ShortByteString
getDomainLabel_ :: !BS.ShortByteString
                               , DomainLabel -> ShortByteString
getDomainLabelCF_ :: !BS.ShortByteString }

-- | A domain parsed into labels. Each label is a 'BS.ShortByteString' rather than 'T.Text' or 'String' because a label can contain arbitrary bytes.
-- However, the 'Ord' and 'Eq' instances do limited case-folding according to [RFC4343](https://datatracker.ietf.org/doc/html/rfc4343#section-3).
newtype Domain = Domain [DomainLabel] deriving (Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: Domain -> Domain -> Bool
Eq, Eq Domain
Eq Domain
-> (Domain -> Domain -> Ordering)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool)
-> (Domain -> Domain -> Domain)
-> (Domain -> Domain -> Domain)
-> Ord Domain
Domain -> Domain -> Bool
Domain -> Domain -> Ordering
Domain -> Domain -> Domain
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
min :: Domain -> Domain -> Domain
$cmin :: Domain -> Domain -> Domain
max :: Domain -> Domain -> Domain
$cmax :: Domain -> Domain -> Domain
>= :: Domain -> Domain -> Bool
$c>= :: Domain -> Domain -> Bool
> :: Domain -> Domain -> Bool
$c> :: Domain -> Domain -> Bool
<= :: Domain -> Domain -> Bool
$c<= :: Domain -> Domain -> Bool
< :: Domain -> Domain -> Bool
$c< :: Domain -> Domain -> Bool
compare :: Domain -> Domain -> Ordering
$ccompare :: Domain -> Domain -> Ordering
Ord)

instance Ord DomainLabel where
  <= :: DomainLabel -> DomainLabel -> Bool
(<=) = ShortByteString -> ShortByteString -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_
  compare :: DomainLabel -> DomainLabel -> Ordering
compare = ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ShortByteString -> ShortByteString -> Ordering)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_

instance Eq DomainLabel where
  == :: DomainLabel -> DomainLabel -> Bool
(==) = ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ShortByteString -> ShortByteString -> Bool)
-> (DomainLabel -> ShortByteString)
-> DomainLabel
-> DomainLabel
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DomainLabel -> ShortByteString
getDomainLabelCF_

-- | Difference list à la Huhges
newtype DList a = DList ([a] -> [a])

-- | Turn a list into 'DList'
{-# INLINE toDList #-}
toDList :: [a] -> DList a
toDList :: forall a. [a] -> DList a
toDList = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> ([a] -> [a] -> [a]) -> [a] -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

-- | Turn 'DList' back into a list.
{-# INLINE fromDList #-}
fromDList :: DList a -> [a]
fromDList :: forall a. DList a -> [a]
fromDList (DList [a] -> [a]
dl) = [a] -> [a]
dl []

-- | Create a 'DList' containing just the specified element
{-# INLINE singleton #-}
singleton :: a -> DList a
singleton :: forall a. a -> DList a
singleton = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> (a -> [a] -> [a]) -> a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)

instance Semigroup (DList a) where
  {-# INLINE (<>) #-}
  DList [a] -> [a]
l <> :: DList a -> DList a -> DList a
<> DList [a] -> [a]
r = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList ([a] -> [a]
l ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
r)

instance Monoid (DList a) where
  {-# INLINE mempty #-}
  mempty :: DList a
mempty = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList [a] -> [a]
forall a. a -> a
id

{-# INLINE sbsSingleton #-}
sbsSingleton :: Word8 -> BS.ShortByteString
#if MIN_VERSION_bytestring(0,11,3)
sbsSingleton = BS.singleton
#else
sbsSingleton :: Word8 -> ShortByteString
sbsSingleton (W8# Word#
w) = (forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ STRep s ShortByteString -> ST s ShortByteString
forall s a. STRep s a -> ST s a
ST (STRep s ShortByteString -> ST s ShortByteString)
-> STRep s ShortByteString -> ST s ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
  case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
1# State# s
s1 of
    (# State# s
s2, MutableByteArray# s
mba #) -> case MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
0# Word#
w State# s
s2 of
          State# s
s3 -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s3 of
             (# State# s
s4, ByteArray#
ma #) -> (# State# s
s4, ByteArray# -> ShortByteString
SBS ByteArray#
ma #)

#endif

sbsMap :: (Word8 -> Word8) -> BS.ShortByteString -> BS.ShortByteString
#if MIN_VERSION_bytestring(0,11,3)
sbsMap = BS.map
#else
sbsMap :: (Word8 -> Word8) -> ShortByteString -> ShortByteString
sbsMap Word8 -> Word8
m sbs :: ShortByteString
sbs@(SBS ByteArray#
ba) = (forall s. ST s ShortByteString) -> ShortByteString
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ShortByteString) -> ShortByteString)
-> (forall s. ST s ShortByteString) -> ShortByteString
forall a b. (a -> b) -> a -> b
$ STRep s ShortByteString -> ST s ShortByteString
forall s a. STRep s a -> ST s a
ST (STRep s ShortByteString -> ST s ShortByteString)
-> STRep s ShortByteString -> ST s ShortByteString
forall a b. (a -> b) -> a -> b
$ \State# s
s1 ->
  case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
l# State# s
s1 of
    (# State# s
s2, MutableByteArray# s
mba #) -> case MutableByteArray# s -> Int# -> Int# -> ST s ()
forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go MutableByteArray# s
mba Int#
0# Int#
l# of
      ST STRep s ()
f -> case STRep s ()
f State# s
s2 of
        (# State# s
s3, ()
_ #) -> case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s3 of
           (# State# s
s4, ByteArray#
ma #) -> (# State# s
s4, ByteArray# -> ShortByteString
SBS ByteArray#
ma #)
  where
    !(I# Int#
l#) = ShortByteString -> Int
BS.length ShortByteString
sbs
    go :: MutableByteArray# s -> Int# -> Int# -> ST s ()
    go :: forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go !MutableByteArray# s
mba !Int#
i !Int#
l
      | Int# -> Int
I# Int#
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int# -> Int
I# Int#
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = (STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
          let !(W8# Word#
w') = Word8 -> Word8
m (Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba Int#
i)) in
          (# MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba Int#
i Word#
w' State# s
s, () #)
       ) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableByteArray# s -> Int# -> Int# -> ST s ()
forall s. MutableByteArray# s -> Int# -> Int# -> ST s ()
go MutableByteArray# s
mba (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Int#
l
#endif