{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Network.DNS.StateBinary (
PState(..)
, initialState
, SPut
, runSPut
, put8
, put16
, put32
, putInt8
, putInt16
, putInt32
, putByteString
, putReplicate
, SGet
, failSGet
, fitSGet
, runSGet
, runSGetAt
, runSGetWithLeftovers
, runSGetWithLeftoversAt
, get8
, get16
, get32
, getInt8
, getInt16
, getInt32
, getNByteString
, sGetMany
, getPosition
, getInput
, getAtTime
, wsPop
, wsPush
, wsPosition
, addPositionW
, push
, pop
, getNBytes
, getNoctets
, skipNBytes
, parseLabel
, unparseLabel
) where
import qualified Control.Exception as E
import Control.Monad.State.Strict (State, StateT)
import qualified Control.Monad.State.Strict as ST
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Types as T
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.Map (Map)
import qualified Data.Map as M
import Data.Semigroup as Sem
import Network.DNS.Imports
import Network.DNS.Types.Internal
type SPut = State WState Builder
data WState = WState {
WState -> Map Domain Int
wsDomain :: Map Domain Int
, WState -> Int
wsPosition :: Int
}
initialWState :: WState
initialWState :: WState
initialWState = Map Domain Int -> Int -> WState
WState Map Domain Int
forall k a. Map k a
M.empty 0
instance Sem.Semigroup SPut where
p1 :: SPut
p1 <> :: SPut -> SPut -> SPut
<> p2 :: SPut
p2 = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(Sem.<>) (Builder -> Builder -> Builder)
-> SPut -> StateT WState Identity (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SPut
p1 StateT WState Identity (Builder -> Builder) -> SPut -> SPut
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SPut
p2
instance Monoid SPut where
mempty :: SPut
mempty = Builder -> SPut
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
mappend = (Sem.<>)
#endif
put8 :: Word8 -> SPut
put8 :: Word8 -> SPut
put8 = Int -> (Word8 -> Builder) -> Word8 -> SPut
forall a. Int -> (a -> Builder) -> a -> SPut
fixedSized 1 Word8 -> Builder
BB.word8
put16 :: Word16 -> SPut
put16 :: Word16 -> SPut
put16 = Int -> (Word16 -> Builder) -> Word16 -> SPut
forall a. Int -> (a -> Builder) -> a -> SPut
fixedSized 2 Word16 -> Builder
BB.word16BE
put32 :: Word32 -> SPut
put32 :: Word32 -> SPut
put32 = Int -> (Word32 -> Builder) -> Word32 -> SPut
forall a. Int -> (a -> Builder) -> a -> SPut
fixedSized 4 Word32 -> Builder
BB.word32BE
putInt8 :: Int -> SPut
putInt8 :: Int -> SPut
putInt8 = Int -> (Int -> Builder) -> Int -> SPut
forall a. Int -> (a -> Builder) -> a -> SPut
fixedSized 1 (Int8 -> Builder
BB.int8 (Int8 -> Builder) -> (Int -> Int8) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
putInt16 :: Int -> SPut
putInt16 :: Int -> SPut
putInt16 = Int -> (Int -> Builder) -> Int -> SPut
forall a. Int -> (a -> Builder) -> a -> SPut
fixedSized 2 (Int16 -> Builder
BB.int16BE (Int16 -> Builder) -> (Int -> Int16) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
putInt32 :: Int -> SPut
putInt32 :: Int -> SPut
putInt32 = Int -> (Int -> Builder) -> Int -> SPut
forall a. Int -> (a -> Builder) -> a -> SPut
fixedSized 4 (Int32 -> Builder
BB.int32BE (Int32 -> Builder) -> (Int -> Int32) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
putByteString :: ByteString -> SPut
putByteString :: Domain -> SPut
putByteString = (Domain -> Int) -> (Domain -> Builder) -> Domain -> SPut
forall a. (a -> Int) -> (a -> Builder) -> a -> SPut
writeSized Domain -> Int
BS.length Domain -> Builder
BB.byteString
putReplicate :: Int -> Word8 -> SPut
putReplicate :: Int -> Word8 -> SPut
putReplicate n :: Int
n w :: Word8
w =
Int -> (ByteString -> Builder) -> ByteString -> SPut
forall a. Int -> (a -> Builder) -> a -> SPut
fixedSized Int
n ByteString -> Builder
BB.lazyByteString (ByteString -> SPut) -> ByteString -> SPut
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8 -> ByteString
LB.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Word8
w
addPositionW :: Int -> State WState ()
addPositionW :: Int -> State WState ()
addPositionW n :: Int
n = do
(WState m :: Map Domain Int
m cur :: Int
cur) <- StateT WState Identity WState
forall s (m :: * -> *). MonadState s m => m s
ST.get
WState -> State WState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put (WState -> State WState ()) -> WState -> State WState ()
forall a b. (a -> b) -> a -> b
$ Map Domain Int -> Int -> WState
WState Map Domain Int
m (Int
curInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)
fixedSized :: Int -> (a -> Builder) -> a -> SPut
fixedSized :: Int -> (a -> Builder) -> a -> SPut
fixedSized n :: Int
n f :: a -> Builder
f a :: a
a = do Int -> State WState ()
addPositionW Int
n
Builder -> SPut
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Builder
f a
a)
writeSized :: (a -> Int) -> (a -> Builder) -> a -> SPut
writeSized :: (a -> Int) -> (a -> Builder) -> a -> SPut
writeSized n :: a -> Int
n f :: a -> Builder
f a :: a
a = do Int -> State WState ()
addPositionW (a -> Int
n a
a)
Builder -> SPut
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Builder
f a
a)
wsPop :: Domain -> State WState (Maybe Int)
wsPop :: Domain -> State WState (Maybe Int)
wsPop dom :: Domain
dom = do
Map Domain Int
doms <- (WState -> Map Domain Int)
-> StateT WState Identity (Map Domain Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets WState -> Map Domain Int
wsDomain
Maybe Int -> State WState (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> State WState (Maybe Int))
-> Maybe Int -> State WState (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Domain -> Map Domain Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Domain
dom Map Domain Int
doms
wsPush :: Domain -> Int -> State WState ()
wsPush :: Domain -> Int -> State WState ()
wsPush dom :: Domain
dom pos :: Int
pos = do
(WState m :: Map Domain Int
m cur :: Int
cur) <- StateT WState Identity WState
forall s (m :: * -> *). MonadState s m => m s
ST.get
WState -> State WState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put (WState -> State WState ()) -> WState -> State WState ()
forall a b. (a -> b) -> a -> b
$ Map Domain Int -> Int -> WState
WState (Domain -> Int -> Map Domain Int -> Map Domain Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Domain
dom Int
pos Map Domain Int
m) Int
cur
type SGet = StateT PState (T.Parser ByteString)
data PState = PState {
PState -> IntMap Domain
psDomain :: IntMap Domain
, PState -> Int
psPosition :: Int
, PState -> Domain
psInput :: ByteString
, PState -> Int64
psAtTime :: Int64
}
getPosition :: SGet Int
getPosition :: SGet Int
getPosition = (PState -> Int) -> SGet Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets PState -> Int
psPosition
getInput :: SGet ByteString
getInput :: SGet Domain
getInput = (PState -> Domain) -> SGet Domain
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets PState -> Domain
psInput
getAtTime :: SGet Int64
getAtTime :: SGet Int64
getAtTime = (PState -> Int64) -> SGet Int64
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets PState -> Int64
psAtTime
addPosition :: Int -> SGet ()
addPosition :: Int -> SGet ()
addPosition n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> SGet ()
forall a. String -> SGet a
failSGet "internal error: negative position increment"
| Bool
otherwise = do
PState dom :: IntMap Domain
dom pos :: Int
pos inp :: Domain
inp t :: Int64
t <- StateT PState (Parser Domain) PState
forall s (m :: * -> *). MonadState s m => m s
ST.get
let !pos' :: Int
pos' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
Bool -> SGet () -> SGet ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pos' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Domain -> Int
BS.length Domain
inp) (SGet () -> SGet ()) -> SGet () -> SGet ()
forall a b. (a -> b) -> a -> b
$
String -> SGet ()
forall a. String -> SGet a
failSGet "malformed or truncated input"
PState -> SGet ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put (PState -> SGet ()) -> PState -> SGet ()
forall a b. (a -> b) -> a -> b
$ IntMap Domain -> Int -> Domain -> Int64 -> PState
PState IntMap Domain
dom Int
pos' Domain
inp Int64
t
push :: Int -> Domain -> SGet ()
push :: Int -> Domain -> SGet ()
push n :: Int
n d :: Domain
d = do
PState dom :: IntMap Domain
dom pos :: Int
pos inp :: Domain
inp t :: Int64
t <- StateT PState (Parser Domain) PState
forall s (m :: * -> *). MonadState s m => m s
ST.get
PState -> SGet ()
forall s (m :: * -> *). MonadState s m => s -> m ()
ST.put (PState -> SGet ()) -> PState -> SGet ()
forall a b. (a -> b) -> a -> b
$ IntMap Domain -> Int -> Domain -> Int64 -> PState
PState (Int -> Domain -> IntMap Domain -> IntMap Domain
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
n Domain
d IntMap Domain
dom) Int
pos Domain
inp Int64
t
pop :: Int -> SGet (Maybe Domain)
pop :: Int -> SGet (Maybe Domain)
pop n :: Int
n = (PState -> Maybe Domain) -> SGet (Maybe Domain)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
ST.gets (Int -> IntMap Domain -> Maybe Domain
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n (IntMap Domain -> Maybe Domain)
-> (PState -> IntMap Domain) -> PState -> Maybe Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> IntMap Domain
psDomain)
get8 :: SGet Word8
get8 :: SGet Word8
get8 = Parser Domain Word8 -> SGet Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
ST.lift Parser Domain Word8
A.anyWord8 SGet Word8 -> SGet () -> SGet Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> SGet ()
addPosition 1
get16 :: SGet Word16
get16 :: SGet Word16
get16 = Parser Domain Word16 -> SGet Word16
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
ST.lift Parser Domain Word16
getWord16be SGet Word16 -> SGet () -> SGet Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> SGet ()
addPosition 2
where
word8' :: Parser Domain Word16
word8' = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> Parser Domain Word8 -> Parser Domain Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Domain Word8
A.anyWord8
getWord16be :: Parser Domain Word16
getWord16be = do
Word16
a <- Parser Domain Word16
word8'
Word16
b <- Parser Domain Word16
word8'
Word16 -> Parser Domain Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Parser Domain Word16) -> Word16 -> Parser Domain Word16
forall a b. (a -> b) -> a -> b
$ Word16
a Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* 0x100 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
b
get32 :: SGet Word32
get32 :: SGet Word32
get32 = Parser Domain Word32 -> SGet Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
ST.lift Parser Domain Word32
getWord32be SGet Word32 -> SGet () -> SGet Word32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> SGet ()
addPosition 4
where
word8' :: Parser Domain Word32
word8' = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Parser Domain Word8 -> Parser Domain Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Domain Word8
A.anyWord8
getWord32be :: Parser Domain Word32
getWord32be = do
Word32
a <- Parser Domain Word32
word8'
Word32
b <- Parser Domain Word32
word8'
Word32
c <- Parser Domain Word32
word8'
Word32
d <- Parser Domain Word32
word8'
Word32 -> Parser Domain Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Parser Domain Word32) -> Word32 -> Parser Domain Word32
forall a b. (a -> b) -> a -> b
$ Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 0x1000000 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 0x10000 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
c Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* 0x100 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d
getInt8 :: SGet Int
getInt8 :: SGet Int
getInt8 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> SGet Word8 -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word8
get8
getInt16 :: SGet Int
getInt16 :: SGet Int
getInt16 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> SGet Word16 -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word16
get16
getInt32 :: SGet Int
getInt32 :: SGet Int
getInt32 = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> SGet Word32 -> SGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word32
get32
overrun :: SGet a
overrun :: SGet a
overrun = String -> SGet a
forall a. String -> SGet a
failSGet "malformed or truncated input"
getNBytes :: Int -> SGet [Int]
getNBytes :: Int -> SGet [Int]
getNBytes n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = SGet [Int]
forall a. SGet a
overrun
| Bool
otherwise = Domain -> [Int]
toInts (Domain -> [Int]) -> SGet Domain -> SGet [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SGet Domain
getNByteString Int
n
where
toInts :: Domain -> [Int]
toInts = (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [Int]) -> (Domain -> [Word8]) -> Domain -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> [Word8]
BS.unpack
getNoctets :: Int -> SGet [Word8]
getNoctets :: Int -> SGet [Word8]
getNoctets n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = SGet [Word8]
forall a. SGet a
overrun
| Bool
otherwise = Domain -> [Word8]
BS.unpack (Domain -> [Word8]) -> SGet Domain -> SGet [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SGet Domain
getNByteString Int
n
skipNBytes :: Int -> SGet ()
skipNBytes :: Int -> SGet ()
skipNBytes n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = SGet ()
forall a. SGet a
overrun
| Bool
otherwise = Parser Domain Domain -> SGet Domain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
ST.lift (Int -> Parser Domain Domain
A.take Int
n) SGet Domain -> SGet () -> SGet ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> SGet ()
addPosition Int
n
getNByteString :: Int -> SGet ByteString
getNByteString :: Int -> SGet Domain
getNByteString n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = SGet Domain
forall a. SGet a
overrun
| Bool
otherwise = Parser Domain Domain -> SGet Domain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
ST.lift (Int -> Parser Domain Domain
A.take Int
n) SGet Domain -> SGet () -> SGet Domain
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> SGet ()
addPosition Int
n
fitSGet :: Int -> SGet a -> SGet a
fitSGet :: Int -> SGet a -> SGet a
fitSGet len :: Int
len parser :: SGet a
parser | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = SGet a
forall a. SGet a
overrun
| Bool
otherwise = do
Int
pos0 <- SGet Int
getPosition
a
ret <- SGet a
parser
Int
pos' <- SGet Int
getPosition
if Int
pos' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pos0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
then a -> SGet a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> SGet a) -> a -> SGet a
forall a b. (a -> b) -> a -> b
$! a
ret
else if Int
pos' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pos0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
then String -> SGet a
forall a. String -> SGet a
failSGet "element size exceeds declared size"
else String -> SGet a
forall a. String -> SGet a
failSGet "element shorter than declared size"
sGetMany :: String
-> Int
-> SGet a
-> SGet [a]
sGetMany :: String -> Int -> SGet a -> SGet [a]
sGetMany elemname :: String
elemname len :: Int
len parser :: SGet a
parser | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = SGet [a]
forall a. SGet a
overrun
| Bool
otherwise = Int -> [a] -> SGet [a]
go Int
len []
where
go :: Int -> [a] -> SGet [a]
go n :: Int
n xs :: [a]
xs
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> SGet [a]
forall a. String -> SGet a
failSGet (String -> SGet [a]) -> String -> SGet [a]
forall a b. (a -> b) -> a -> b
$ String
elemname String -> String -> String
forall a. [a] -> [a] -> [a]
++ " longer than declared size"
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = [a] -> SGet [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> SGet [a]) -> [a] -> SGet [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs
| Bool
otherwise = do
Int
pos0 <- SGet Int
getPosition
a
x <- SGet a
parser
Int
pos1 <- SGet Int
getPosition
if Int
pos1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pos0
then String -> SGet [a]
forall a. String -> SGet a
failSGet (String -> SGet [a]) -> String -> SGet [a]
forall a b. (a -> b) -> a -> b
$ "internal error: in-place success for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
elemname
else Int -> [a] -> SGet [a]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pos0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos1) (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
dnsTimeMid :: Int64
dnsTimeMid :: Int64
dnsTimeMid = 3426660848
initialState :: Int64 -> ByteString -> PState
initialState :: Int64 -> Domain -> PState
initialState t :: Int64
t inp :: Domain
inp = IntMap Domain -> Int -> Domain -> Int64 -> PState
PState IntMap Domain
forall a. IntMap a
IM.empty 0 Domain
inp Int64
t
failSGet :: String -> SGet a
failSGet :: String -> SGet a
failSGet msg :: String
msg = Parser Domain a -> SGet a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
ST.lift (String -> Parser Domain a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "" Parser Domain a -> String -> Parser Domain a
forall i a. Parser i a -> String -> Parser i a
A.<?> String
msg)
runSGetAt :: Int64 -> SGet a -> ByteString -> Either DNSError (a, PState)
runSGetAt :: Int64 -> SGet a -> Domain -> Either DNSError (a, PState)
runSGetAt t :: Int64
t parser :: SGet a
parser inp :: Domain
inp =
Result (a, PState) -> Either DNSError (a, PState)
forall r. Result r -> Either DNSError r
toResult (Result (a, PState) -> Either DNSError (a, PState))
-> Result (a, PState) -> Either DNSError (a, PState)
forall a b. (a -> b) -> a -> b
$ Parser (a, PState) -> Domain -> Result (a, PState)
forall a. Parser a -> Domain -> Result a
A.parse (SGet a -> PState -> Parser (a, PState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
ST.runStateT SGet a
parser (PState -> Parser (a, PState)) -> PState -> Parser (a, PState)
forall a b. (a -> b) -> a -> b
$ Int64 -> Domain -> PState
initialState Int64
t Domain
inp) Domain
inp
where
toResult :: A.Result r -> Either DNSError r
toResult :: Result r -> Either DNSError r
toResult (A.Done _ r :: r
r) = r -> Either DNSError r
forall a b. b -> Either a b
Right r
r
toResult (A.Fail _ ctx :: [String]
ctx msg :: String
msg) = DNSError -> Either DNSError r
forall a b. a -> Either a b
Left (DNSError -> Either DNSError r) -> DNSError -> Either DNSError r
forall a b. (a -> b) -> a -> b
$ String -> DNSError
DecodeError (String -> DNSError) -> String -> DNSError
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
ctx [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
msg]
toResult (A.Partial _) = DNSError -> Either DNSError r
forall a b. a -> Either a b
Left (DNSError -> Either DNSError r) -> DNSError -> Either DNSError r
forall a b. (a -> b) -> a -> b
$ String -> DNSError
DecodeError "incomplete input"
runSGet :: SGet a -> ByteString -> Either DNSError (a, PState)
runSGet :: SGet a -> Domain -> Either DNSError (a, PState)
runSGet = Int64 -> SGet a -> Domain -> Either DNSError (a, PState)
forall a. Int64 -> SGet a -> Domain -> Either DNSError (a, PState)
runSGetAt Int64
dnsTimeMid
runSGetWithLeftoversAt :: Int64
-> SGet a
-> ByteString
-> Either DNSError ((a, PState), ByteString)
runSGetWithLeftoversAt :: Int64 -> SGet a -> Domain -> Either DNSError ((a, PState), Domain)
runSGetWithLeftoversAt t :: Int64
t parser :: SGet a
parser inp :: Domain
inp =
Result (a, PState) -> Either DNSError ((a, PState), Domain)
forall r. Result r -> Either DNSError (r, Domain)
toResult (Result (a, PState) -> Either DNSError ((a, PState), Domain))
-> Result (a, PState) -> Either DNSError ((a, PState), Domain)
forall a b. (a -> b) -> a -> b
$ Parser (a, PState) -> Domain -> Result (a, PState)
forall a. Parser a -> Domain -> Result a
A.parse (SGet a -> PState -> Parser (a, PState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
ST.runStateT SGet a
parser (PState -> Parser (a, PState)) -> PState -> Parser (a, PState)
forall a b. (a -> b) -> a -> b
$ Int64 -> Domain -> PState
initialState Int64
t Domain
inp) Domain
inp
where
toResult :: A.Result r -> Either DNSError (r, ByteString)
toResult :: Result r -> Either DNSError (r, Domain)
toResult (A.Done i :: Domain
i r :: r
r) = (r, Domain) -> Either DNSError (r, Domain)
forall a b. b -> Either a b
Right (r
r, Domain
i)
toResult (A.Partial f :: Domain -> Result r
f) = Result r -> Either DNSError (r, Domain)
forall r. Result r -> Either DNSError (r, Domain)
toResult (Result r -> Either DNSError (r, Domain))
-> Result r -> Either DNSError (r, Domain)
forall a b. (a -> b) -> a -> b
$ Domain -> Result r
f Domain
BS.empty
toResult (A.Fail _ ctx :: [String]
ctx e :: String
e) = DNSError -> Either DNSError (r, Domain)
forall a b. a -> Either a b
Left (DNSError -> Either DNSError (r, Domain))
-> DNSError -> Either DNSError (r, Domain)
forall a b. (a -> b) -> a -> b
$ String -> DNSError
DecodeError (String -> DNSError) -> String -> DNSError
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
ctx [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
e]
runSGetWithLeftovers :: SGet a -> ByteString -> Either DNSError ((a, PState), ByteString)
runSGetWithLeftovers :: SGet a -> Domain -> Either DNSError ((a, PState), Domain)
runSGetWithLeftovers = Int64 -> SGet a -> Domain -> Either DNSError ((a, PState), Domain)
forall a.
Int64 -> SGet a -> Domain -> Either DNSError ((a, PState), Domain)
runSGetWithLeftoversAt Int64
dnsTimeMid
runSPut :: SPut -> ByteString
runSPut :: SPut -> Domain
runSPut = ByteString -> Domain
LBS.toStrict (ByteString -> Domain) -> (SPut -> ByteString) -> SPut -> Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> (SPut -> Builder) -> SPut -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SPut -> WState -> Builder) -> WState -> SPut -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip SPut -> WState -> Builder
forall s a. State s a -> s -> a
ST.evalState WState
initialWState
parseLabel :: Word8 -> ByteString -> (ByteString, ByteString)
parseLabel :: Word8 -> Domain -> (Domain, Domain)
parseLabel sep :: Word8
sep dom :: Domain
dom =
if (Word8 -> Bool) -> Domain -> Bool
BS.any (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bslash) Domain
dom
then IResult Domain Domain -> (Domain, Domain)
toResult (IResult Domain Domain -> (Domain, Domain))
-> IResult Domain Domain -> (Domain, Domain)
forall a b. (a -> b) -> a -> b
$ Parser Domain Domain -> Domain -> IResult Domain Domain
forall a. Parser a -> Domain -> Result a
A.parse (Word8 -> Domain -> Parser Domain Domain
labelParser Word8
sep Domain
forall a. Monoid a => a
mempty) Domain
dom
else (Domain, Domain) -> (Domain, Domain)
check ((Domain, Domain) -> (Domain, Domain))
-> (Domain, Domain) -> (Domain, Domain)
forall a b. (a -> b) -> a -> b
$ Domain -> Domain
safeTail (Domain -> Domain) -> (Domain, Domain) -> (Domain, Domain)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Domain -> (Domain, Domain)
BS.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sep) Domain
dom
where
toResult :: IResult Domain Domain -> (Domain, Domain)
toResult (A.Partial c :: Domain -> IResult Domain Domain
c) = IResult Domain Domain -> (Domain, Domain)
toResult (Domain -> IResult Domain Domain
c Domain
forall a. Monoid a => a
mempty)
toResult (A.Done tl :: Domain
tl hd :: Domain
hd) = (Domain, Domain) -> (Domain, Domain)
check (Domain
hd, Domain
tl)
toResult _ = (Domain, Domain)
forall a. a
bottom
safeTail :: Domain -> Domain
safeTail bs :: Domain
bs | Domain -> Bool
BS.null Domain
bs = Domain
forall a. Monoid a => a
mempty
| Bool
otherwise = Domain -> Domain
BS.tail Domain
bs
check :: (Domain, Domain) -> (Domain, Domain)
check r :: (Domain, Domain)
r@(hd :: Domain
hd, tl :: Domain
tl) | Bool -> Bool
not (Domain -> Bool
BS.null Domain
hd) Bool -> Bool -> Bool
|| Domain -> Bool
BS.null Domain
tl = (Domain, Domain)
r
| Bool
otherwise = (Domain, Domain)
forall a. a
bottom
bottom :: a
bottom = DNSError -> a
forall a e. Exception e => e -> a
E.throw (DNSError -> a) -> DNSError -> a
forall a b. (a -> b) -> a -> b
$ String -> DNSError
DecodeError (String -> DNSError) -> String -> DNSError
forall a b. (a -> b) -> a -> b
$ "invalid domain: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Domain -> String
S8.unpack Domain
dom
labelParser :: Word8 -> ByteString -> A.Parser ByteString
labelParser :: Word8 -> Domain -> Parser Domain Domain
labelParser sep :: Word8
sep acc :: Domain
acc = do
Domain
acc' <- Domain -> Domain -> Domain
forall a. Monoid a => a -> a -> a
mappend Domain
acc (Domain -> Domain) -> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Domain
forall a. Monoid a => a
mempty Parser Domain Domain
simple
Word8 -> Domain -> Parser Domain Domain
labelEnd Word8
sep Domain
acc' Parser Domain Domain
-> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Domain Word8
escaped Parser Domain Word8
-> (Word8 -> Parser Domain Domain) -> Parser Domain Domain
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Domain -> Parser Domain Domain
labelParser Word8
sep (Domain -> Parser Domain Domain)
-> (Word8 -> Domain) -> Word8 -> Parser Domain Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Word8 -> Domain
BS.snoc Domain
acc')
where
simple :: Parser Domain Domain
simple = (Domain, ()) -> Domain
forall a b. (a, b) -> a
fst ((Domain, ()) -> Domain)
-> Parser Domain (Domain, ()) -> Parser Domain Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser Domain (Domain, ())
forall a. Parser a -> Parser (Domain, a)
A.match Parser ()
skipUnescaped
where
skipUnescaped :: Parser ()
skipUnescaped = Parser Domain Word8 -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 (Parser Domain Word8 -> Parser ())
-> Parser Domain Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser Domain Word8
A.satisfy Word8 -> Bool
notSepOrBslash
notSepOrBslash :: Word8 -> Bool
notSepOrBslash w :: Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
sep Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
bslash
escaped :: Parser Domain Word8
escaped = do
(Word8 -> Bool) -> Parser ()
A.skip (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bslash)
(Word -> Parser Domain Word8)
-> (Word8 -> Parser Domain Word8)
-> Either Word Word8
-> Parser Domain Word8
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Word -> Parser Domain Word8
decodeDec Word8 -> Parser Domain Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Word Word8 -> Parser Domain Word8)
-> Parser Domain (Either Word Word8) -> Parser Domain Word8
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Domain Word
-> Parser Domain Word8 -> Parser Domain (Either Word Word8)
forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
A.eitherP Parser Domain Word
digit Parser Domain Word8
A.anyWord8
where
digit :: Parser Domain Word
digit = Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word) -> Parser Domain Word8 -> Parser Domain Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Word8) -> (Word8 -> Bool) -> Parser Domain Word8
forall a. (Word8 -> a) -> (a -> Bool) -> Parser a
A.satisfyWith (\n :: Word8
n -> Word8
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
zero) (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<=9)
decodeDec :: Word -> Parser Domain Word8
decodeDec d :: Word
d =
Word -> Parser Domain Word8
safeWord8 (Word -> Parser Domain Word8)
-> Parser Domain Word -> Parser Domain Word8
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word -> Word -> Word -> Word
trigraph Word
d (Word -> Word -> Word)
-> Parser Domain Word -> Parser Domain (Word -> Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Domain Word
digit Parser Domain (Word -> Word)
-> Parser Domain Word -> Parser Domain Word
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Domain Word
digit
where
trigraph :: Word -> Word -> Word -> Word
trigraph :: Word -> Word -> Word -> Word
trigraph x :: Word
x y :: Word
y z :: Word
z = 100 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
+ 10 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
y Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
z
safeWord8 :: Word -> A.Parser Word8
safeWord8 :: Word -> Parser Domain Word8
safeWord8 n :: Word
n | Word
n Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> 255 = Parser Domain Word8
forall (m :: * -> *) a. MonadPlus m => m a
mzero
| Bool
otherwise = Word8 -> Parser Domain Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Parser Domain Word8) -> Word8 -> Parser Domain Word8
forall a b. (a -> b) -> a -> b
$ Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n
labelEnd :: Word8 -> ByteString -> A.Parser ByteString
labelEnd :: Word8 -> Domain -> Parser Domain Domain
labelEnd sep :: Word8
sep acc :: Domain
acc =
(Word8 -> Bool) -> Parser Domain Word8
A.satisfy (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sep) Parser Domain Word8 -> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Domain -> Parser Domain Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure Domain
acc Parser Domain Domain
-> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser ()
forall t. Chunk t => Parser t ()
A.endOfInput Parser () -> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Domain -> Parser Domain Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure Domain
acc
unparseLabel :: Word8 -> ByteString -> ByteString
unparseLabel :: Word8 -> Domain -> Domain
unparseLabel sep :: Word8
sep label :: Domain
label =
if (Word8 -> Bool) -> Domain -> Bool
BS.all (Word8 -> Word8 -> Bool
isPlain Word8
sep) Domain
label
then Domain
label
else IResult Domain Domain -> Domain
forall i p. Monoid i => IResult i p -> p
toResult (IResult Domain Domain -> Domain)
-> IResult Domain Domain -> Domain
forall a b. (a -> b) -> a -> b
$ Parser Domain Domain -> Domain -> IResult Domain Domain
forall a. Parser a -> Domain -> Result a
A.parse (Word8 -> Domain -> Parser Domain Domain
labelUnparser Word8
sep Domain
forall a. Monoid a => a
mempty) Domain
label
where
toResult :: IResult i p -> p
toResult (A.Partial c :: i -> IResult i p
c) = IResult i p -> p
toResult (i -> IResult i p
c i
forall a. Monoid a => a
mempty)
toResult (A.Done _ r :: p
r) = p
r
toResult _ = DNSError -> p
forall a e. Exception e => e -> a
E.throw DNSError
UnknownDNSError
labelUnparser :: Word8 -> ByteString -> A.Parser ByteString
labelUnparser :: Word8 -> Domain -> Parser Domain Domain
labelUnparser sep :: Word8
sep acc :: Domain
acc = do
Domain
acc' <- Domain -> Domain -> Domain
forall a. Monoid a => a -> a -> a
mappend Domain
acc (Domain -> Domain) -> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Domain
forall a. Monoid a => a
mempty Parser Domain Domain
asis
Parser ()
forall t. Chunk t => Parser t ()
A.endOfInput Parser () -> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Domain -> Parser Domain Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure Domain
acc' Parser Domain Domain
-> Parser Domain Domain -> Parser Domain Domain
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Domain Domain
esc Parser Domain Domain
-> (Domain -> Parser Domain Domain) -> Parser Domain Domain
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Domain -> Parser Domain Domain
labelUnparser Word8
sep (Domain -> Parser Domain Domain)
-> (Domain -> Domain) -> Domain -> Parser Domain Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Domain -> Domain
forall a. Monoid a => a -> a -> a
mappend Domain
acc')
where
esc :: Parser Domain Domain
esc = do
Word8
w <- Parser Domain Word8
A.anyWord8
if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 32 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 127
then let (q100 :: Word8
q100, r100 :: Word8
r100) = Word8
w Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`divMod` 100
(q10 :: Word8
q10, r10 :: Word8
r10) = Word8
r100 Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`divMod` 10
in Domain -> Parser Domain Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain -> Parser Domain Domain) -> Domain -> Parser Domain Domain
forall a b. (a -> b) -> a -> b
$ [Word8] -> Domain
BS.pack [ Word8
bslash, Word8
zero Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
q100, Word8
zero Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
q10, Word8
zero Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
r10 ]
else Domain -> Parser Domain Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain -> Parser Domain Domain) -> Domain -> Parser Domain Domain
forall a b. (a -> b) -> a -> b
$ [Word8] -> Domain
BS.pack [ Word8
bslash, Word8
w ]
asis :: Parser Domain Domain
asis = ((Domain, ()) -> Domain)
-> Parser Domain (Domain, ()) -> Parser Domain Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Domain, ()) -> Domain
forall a b. (a, b) -> a
fst (Parser Domain (Domain, ()) -> Parser Domain Domain)
-> Parser Domain (Domain, ()) -> Parser Domain Domain
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Domain (Domain, ())
forall a. Parser a -> Parser (Domain, a)
A.match (Parser () -> Parser Domain (Domain, ()))
-> Parser () -> Parser Domain (Domain, ())
forall a b. (a -> b) -> a -> b
$ Parser Domain Word8 -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany1 (Parser Domain Word8 -> Parser ())
-> Parser Domain Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser Domain Word8
A.satisfy ((Word8 -> Bool) -> Parser Domain Word8)
-> (Word8 -> Bool) -> Parser Domain Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Bool
isPlain Word8
sep
escSpecials :: ByteString
escSpecials :: Domain
escSpecials = "\"$();@\\"
isSpecial :: Word8 -> Word8 -> Bool
isSpecial :: Word8 -> Word8 -> Bool
isSpecial sep :: Word8
sep w :: Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sep Bool -> Bool -> Bool
|| Word8 -> Domain -> Maybe Int
BS.elemIndex Word8
w Domain
escSpecials Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
forall a. Maybe a
Nothing
isPlain :: Word8 -> Word8 -> Bool
isPlain :: Word8 -> Word8 -> Bool
isPlain sep :: Word8
sep w :: Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= 127 = Bool
False
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
bslash = Bool
True
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
zero Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
semi = Bool
True
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
atsign Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
bslash = Bool
True
| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 32 = Bool
False
| Word8 -> Word8 -> Bool
isSpecial Word8
sep Word8
w = Bool
False
| Bool
otherwise = Bool
True
zero, semi, atsign, bslash :: Word8
zero :: Word8
zero = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum '0'
semi :: Word8
semi = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum ';'
atsign :: Word8
atsign = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum '@'
bslash :: Word8
bslash = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum '\\'