-- |
-- Module      : Net.DNSBase.Encode.Internal.State
-- Description : Encoder state monad and wire-format primitives
-- Copyright   : (c) IIJ Innovation Institute Inc., 2009
--               (c) Viktor Dukhovni, 2020-2026
-- License     : BSD-3-Clause
-- Maintainer  : ietf-dane@dukhovni.org
-- Stability   : unstable
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}

module Net.DNSBase.Encode.Internal.State
    ( EncodeErr(..)
    , ErrorContext
    , SPut, SPutM, localSPut
    , buildCompressed
    , encodeCompressed
    , buildVerbatim
    , encodeVerbatim
    , putDomain
    , putWireForm
    , put8
    , put16
    , put32
    , put64
    , putIPv4
    , putIPv6
    , putByteString
    , putByteStringLen8
    , putByteStringLen16
    , putShortByteString
    , putShortByteStringLen8
    , putShortByteStringLen16
    , putUtf8Text
    , putUtf8TextLen8
    , putUtf8TextLen16
    , putSizedBuilder
    , putReplicate
    -- Encoder state mutation
    , passLen
    , failWith
    , setContext
    ) where

import qualified Control.Monad.Trans.RWS.CPS
        as R ( RWST, evalRWST, ask, get, gets, local
             , pass, put, tell )
import qualified Control.Monad.STE as STE
import qualified Control.Monad.STE.Internal as STE
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Extra as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Short as SB
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Unsafe as T
import GHC.ST as G (ST(..))

import qualified Net.DNSBase.Internal.NameComp as NC
import Net.DNSBase.Internal.Domain
import Net.DNSBase.Encode.Internal.Metric
import Net.DNSBase.Internal.Error
import Net.DNSBase.Internal.Util

----------------------------------------------------------------

stToSTE :: G.ST s a -> STE.STE e s a
stToSTE :: forall s a e. ST s a -> STE e s a
stToSTE = ST s a -> STE e s a
forall a b. Coercible a b => a -> b
coerce

----------------------------------------------------------------

-- | Encoder state, the NCTree (DNS name compression tree) is mutable in the ST
-- monad.
data EncState s = EncState
    { forall s. EncState s -> Int
encOffset :: Int
    , forall s. EncState s -> Bool
encDoNC   :: Bool
    , forall s. EncState s -> NCTree s
encNCTree :: NC.NCTree s
    }

-- | Initial encoder state.
encInit :: Bool -- ^ If "True", DNS name compression is enabled
        -> STE.STE e s (EncState s)
encInit :: forall e s. Bool -> STE e s (EncState s)
encInit Bool
donamecomp = Int -> Bool -> NCTree s -> EncState s
forall s. Int -> Bool -> NCTree s -> EncState s
EncState Int
0 Bool
donamecomp (NCTree s -> EncState s)
-> STE e s (NCTree s) -> STE e s (EncState s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ST s (NCTree s) -> STE e s (NCTree s)
forall s a e. ST s a -> STE e s a
stToSTE (Int -> ST s (NCTree s)
forall s. Int -> ST s (NCTree s)
NC.empty Int
0)

----------------------------------------------------------------

type ErrorContext r = (Typeable r, Show r, Eq r)

buildSPut :: ErrorContext r
        => (forall s. SPut s r)
        -> Bool
        -> Either (EncodeErr (Maybe r)) (Int, Builder)
buildSPut :: forall r.
ErrorContext r =>
(forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) (Int, Builder)
buildSPut forall s. SPut s r
m Bool
donc = (Either (EncodeErr (Maybe r)) (Int, Builder)
 -> Either (EncodeErr (Maybe r)) (Int, Builder))
-> (forall s. STE (EncodeErr (Maybe r)) s (Int, Builder))
-> Either (EncodeErr (Maybe r)) (Int, Builder)
forall e a b. (Either e a -> b) -> (forall s. STE e s a) -> b
STE.handleSTE Either (EncodeErr (Maybe r)) (Int, Builder)
-> Either (EncodeErr (Maybe r)) (Int, Builder)
forall a. a -> a
id do
    st <- Bool -> STE (EncodeErr (Maybe r)) s (EncState s)
forall e s. Bool -> STE e s (EncState s)
encInit Bool
donc
    evalSPutM (m >> gets encOffset) Nothing st

-- | Execute the composed 'Builder' endomorphisms to encode a packet of the
-- cumulative length.
runSPut :: ErrorContext r
        => (forall s. SPut s r)
        -> Bool
        -> Either (EncodeErr (Maybe r)) ByteString
runSPut :: forall r.
ErrorContext r =>
(forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) ByteString
runSPut forall s. SPut s r
m Bool
donc = do
    (len, builder) <- (forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) (Int, Builder)
forall r.
ErrorContext r =>
(forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) (Int, Builder)
buildSPut SPut s r
forall s. SPut s r
m Bool
donc
    pure $ LB.toStrict
         $ B.toLazyByteStringWith (strat len) mempty builder
  where
    strat :: Int -> AllocationStrategy
strat Int
len = Int -> Int -> AllocationStrategy
B.untrimmedStrategy Int
len Int
len

-- | Perform a stateful encoding with DNS name compression.  The initial error
-- context is "Nothing".  Specific values can be provided during the
-- computation by using 'localSPut'.
buildCompressed :: ErrorContext r
                => (forall s. SPut s r)
                -> Either (EncodeErr (Maybe r)) Builder
buildCompressed :: forall r.
ErrorContext r =>
(forall s. SPut s r) -> Either (EncodeErr (Maybe r)) Builder
buildCompressed forall s. SPut s r
m = (Int, Builder) -> Builder
forall a b. (a, b) -> b
snd ((Int, Builder) -> Builder)
-> Either (EncodeErr (Maybe r)) (Int, Builder)
-> Either (EncodeErr (Maybe r)) Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) (Int, Builder)
forall r.
ErrorContext r =>
(forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) (Int, Builder)
buildSPut SPut s r
forall s. SPut s r
m Bool
True

-- | Perform a stateful encoding with DNS name compression.  The initial error
-- context is "Nothing".  Specific values can be provided during the
-- computation by using 'localSPut'.
encodeCompressed :: ErrorContext r
                 => (forall s. SPut s r)
                 -> Either (EncodeErr (Maybe r)) ByteString
encodeCompressed :: forall r.
ErrorContext r =>
(forall s. SPut s r) -> Either (EncodeErr (Maybe r)) ByteString
encodeCompressed forall s. SPut s r
m = (forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) ByteString
forall r.
ErrorContext r =>
(forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) ByteString
runSPut SPut s r
forall s. SPut s r
m Bool
True

-- | Perform a stateful encoding without DNS name compression.  The initial
-- error context is "Nothing".  Specific values can be provided during the
-- computation by using 'localSPut'.
buildVerbatim :: ErrorContext r
              => (forall s. SPut s r)
              -> Either (EncodeErr (Maybe r)) Builder
buildVerbatim :: forall r.
ErrorContext r =>
(forall s. SPut s r) -> Either (EncodeErr (Maybe r)) Builder
buildVerbatim forall s. SPut s r
m = (Int, Builder) -> Builder
forall a b. (a, b) -> b
snd ((Int, Builder) -> Builder)
-> Either (EncodeErr (Maybe r)) (Int, Builder)
-> Either (EncodeErr (Maybe r)) Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) (Int, Builder)
forall r.
ErrorContext r =>
(forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) (Int, Builder)
buildSPut SPut s r
forall s. SPut s r
m Bool
False

-- | Perform a stateful encoding without DNS name compression.  The initial
-- error context is "Nothing".  Specific values can be provided during the
-- computation by using 'localSPut'.
encodeVerbatim :: ErrorContext r
               => (forall s. SPut s r)
               -> Either (EncodeErr (Maybe r)) ByteString
encodeVerbatim :: forall r.
ErrorContext r =>
(forall s. SPut s r) -> Either (EncodeErr (Maybe r)) ByteString
encodeVerbatim forall s. SPut s r
m = (forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) ByteString
forall r.
ErrorContext r =>
(forall s. SPut s r)
-> Bool -> Either (EncodeErr (Maybe r)) ByteString
runSPut SPut s r
forall s. SPut s r
m Bool
False

-- | Encode a domain with possible name compression if the entire name fits in
-- the first 16K of the output.
putDomain :: ErrorContext r => Domain -> SPut s r
putDomain :: forall r s. ErrorContext r => Domain -> SPut s r
putDomain Domain
domain = do
    EncState{..} <- SPutM s r (EncState s)
forall s r. SPutM s r (EncState s)
get
    let !wlen = ByteString -> Int
B.length (Domain -> ByteString
wireBytes Domain
domain) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    if | wlen > 0 && encDoNC
       , !end <- encOffset + wlen
       , !ls <- revLabels domain
        -> do (!slen, !off) <- liftSPut . stToSTE $ NC.lookup ls encNCTree
              when (end <= MaxPtr) $
                  liftSPut . stToSTE $ NC.insert ls end encNCTree
              putCompressed domain wlen slen off
       | otherwise -> putWireForm domain
  where
    putCompressed :: Domain -> Int -> Int -> Int -> SPutM s r ()
putCompressed !Domain
dom !Int
dlen !Int
slen !Int
off
        | Int
slen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Domain -> SPutM s r ()
forall r s. ErrorContext r => Domain -> SPut s r
putWireForm Domain
dom
        | Bool
otherwise = do
              Bool -> SPutM s r () -> SPutM s r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
slen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dlen) do
                  ByteString -> SPutM s r ()
forall r s. ErrorContext r => ByteString -> SPut s r
putByteString (ByteString -> SPutM s r ()) -> ByteString -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take (Int
dlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
slen) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Domain -> ByteString
wireBytes Domain
domain
              Word16 -> SPutM s r ()
forall r s. ErrorContext r => Word16 -> SPut s r
put16 (Word16 -> SPutM s r ()) -> Word16 -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (Int
MaxPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
MaxPtr) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off

-- | Encode a domain name verbatim, without name compression.
putWireForm :: ErrorContext r => Domain -> SPut s r
putWireForm :: forall r s. ErrorContext r => Domain -> SPut s r
putWireForm = (Domain -> Int) -> (Domain -> Builder) -> Domain -> SPut s r
forall r a s.
ErrorContext r =>
(a -> Int) -> (a -> Builder) -> a -> SPut s r
encVar (ShortByteString -> Int
SB.length (ShortByteString -> Int)
-> (Domain -> ShortByteString) -> Domain -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> ShortByteString
shortBytes) (ShortByteString -> Builder
B.shortByteString (ShortByteString -> Builder)
-> (Domain -> ShortByteString) -> Domain -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> ShortByteString
shortBytes)
{-# INLINE putWireForm #-}

----------------------------------------------------------------

pattern MaxPos :: Int
pattern $mMaxPos :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bMaxPos :: Int
MaxPos = 0xffff

pattern MaxPtr :: Int
pattern $mMaxPtr :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bMaxPtr :: Int
MaxPtr = 0x3fff

{-# INLINE addPos #-}
addPos :: ErrorContext r => Int -> SPut s r
addPos :: forall r s. ErrorContext r => Int -> SPut s r
addPos Int
n = do
    !s@EncState{ encOffset = pos } <- SPutM s r (EncState s)
forall s r. SPutM s r (EncState s)
get
    let !pos' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
    when (n > MaxPos || pos' > MaxPos) do
        ask >>= liftSPut . STE.throwSTE . EncodeTooLong
    put $! s { encOffset = pos' }

{-# INLINE encFix #-}
encFix :: ErrorContext r => Int -> (a -> Builder) -> a -> SPut s r
encFix :: forall r a s.
ErrorContext r =>
Int -> (a -> Builder) -> a -> SPut s r
encFix Int
size a -> Builder
enc a
a = Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos Int
size SPut s r -> SPut s r -> SPut s r
forall a b. SPutM s r a -> SPutM s r b -> SPutM s r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell (a -> Builder
enc a
a)

{-# INLINE encVar #-}
encVar :: ErrorContext r => (a -> Int) -> (a -> Builder) -> a -> SPut s r
encVar :: forall r a s.
ErrorContext r =>
(a -> Int) -> (a -> Builder) -> a -> SPut s r
encVar a -> Int
getSize a -> Builder
enc a
a = Int -> (a -> Builder) -> a -> SPut s r
forall r a s.
ErrorContext r =>
Int -> (a -> Builder) -> a -> SPut s r
encFix (a -> Int
getSize a
a) a -> Builder
enc a
a

----------------------------------------------------------------

-- | Write a single octet.
put8 :: ErrorContext r => Word8 -> SPut s r
put8 :: forall r s. ErrorContext r => Word8 -> SPut s r
put8 = Int -> (Word8 -> Builder) -> Word8 -> SPut s r
forall r a s.
ErrorContext r =>
Int -> (a -> Builder) -> a -> SPut s r
encFix Int
1 Word8 -> Builder
B.word8
{-# INLINE put8 #-}

-- | Write a big-endian 16-bit word.
put16 :: ErrorContext r => Word16 -> SPut s r
put16 :: forall r s. ErrorContext r => Word16 -> SPut s r
put16 = Int -> (Word16 -> Builder) -> Word16 -> SPut s r
forall r a s.
ErrorContext r =>
Int -> (a -> Builder) -> a -> SPut s r
encFix Int
2 Word16 -> Builder
B.word16BE
{-# INLINE put16 #-}

-- | Write a big-endian 32-bit word.
put32 :: ErrorContext r => Word32 -> SPut s r
put32 :: forall r s. ErrorContext r => Word32 -> SPut s r
put32 = Int -> (Word32 -> Builder) -> Word32 -> SPut s r
forall r a s.
ErrorContext r =>
Int -> (a -> Builder) -> a -> SPut s r
encFix Int
4 Word32 -> Builder
B.word32BE
{-# INLINE put32 #-}

-- | Write a big-endian 64-bit word.
put64 :: ErrorContext r => Word64 -> SPut s r
put64 :: forall r s. ErrorContext r => Word64 -> SPut s r
put64 = Int -> (Word64 -> Builder) -> Word64 -> SPut s r
forall r a s.
ErrorContext r =>
Int -> (a -> Builder) -> a -> SPut s r
encFix Int
8 Word64 -> Builder
B.word64BE
{-# INLINE put64 #-}

-- | Write the four octets of an IPv4 address in network order.
putIPv4 :: ErrorContext r => IPv4 -> SPut s r
putIPv4 :: forall r s. ErrorContext r => IPv4 -> SPut s r
putIPv4 = Word32 -> SPut s r
forall r s. ErrorContext r => Word32 -> SPut s r
put32 (Word32 -> SPut s r) -> (IPv4 -> Word32) -> IPv4 -> SPut s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Word32
fromIPv4w
{-# INLINE putIPv4 #-}

-- | Write the sixteen octets of an IPv6 address in network order.
putIPv6 :: ErrorContext r => IPv6 -> SPut s r
putIPv6 :: forall r s. ErrorContext r => IPv6 -> SPut s r
putIPv6 IPv6
ip6 =
    SizedBuilder -> SPut s r
forall r s. ErrorContext r => SizedBuilder -> SPut s r
putSizedBuilder (SizedBuilder -> SPut s r) -> SizedBuilder -> SPut s r
forall a b. (a -> b) -> a -> b
$! Word32 -> SizedBuilder
mbWord32 Word32
w0
                    SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> Word32 -> SizedBuilder
mbWord32 Word32
w1
                    SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> Word32 -> SizedBuilder
mbWord32 Word32
w2
                    SizedBuilder -> SizedBuilder -> SizedBuilder
forall a. Semigroup a => a -> a -> a
<> Word32 -> SizedBuilder
mbWord32 Word32
w3
  where
    (Word32
w0, Word32
w1, Word32
w2, Word32
w3) = IPv6 -> (Word32, Word32, Word32, Word32)
fromIPv6w IPv6
ip6
{-# INLINE putIPv6 #-}

-- | Write the bytes of a 'ByteString' verbatim, with no length prefix.
putByteString :: ErrorContext r => ByteString -> SPut s r
putByteString :: forall r s. ErrorContext r => ByteString -> SPut s r
putByteString ByteString
b =
    Bool -> SPutM s r () -> SPutM s r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
b) (SPutM s r () -> SPutM s r ()) -> SPutM s r () -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int)
-> (ByteString -> Builder) -> ByteString -> SPutM s r ()
forall r a s.
ErrorContext r =>
(a -> Int) -> (a -> Builder) -> a -> SPut s r
encVar ByteString -> Int
B.length ByteString -> Builder
B.byteString ByteString
b

-- | Write the bytes of a 'ShortByteString' verbatim, with no length prefix.
putShortByteString :: ErrorContext r => ShortByteString -> SPut s r
putShortByteString :: forall r s. ErrorContext r => ShortByteString -> SPut s r
putShortByteString ShortByteString
b =
    Bool -> SPutM s r () -> SPutM s r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ShortByteString -> Bool
SB.null ShortByteString
b) (SPutM s r () -> SPutM s r ()) -> SPutM s r () -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ (ShortByteString -> Int)
-> (ShortByteString -> Builder) -> ShortByteString -> SPutM s r ()
forall r a s.
ErrorContext r =>
(a -> Int) -> (a -> Builder) -> a -> SPut s r
encVar ShortByteString -> Int
SB.length ShortByteString -> Builder
B.shortByteString ShortByteString
b

-- | Write a DNS /character-string/: an 8-bit length prefix followed
-- by the bytes.  Fails with 'EncodeTooLong' if the input exceeds 255 bytes.
putByteStringLen8 :: ErrorContext r => ByteString -> SPut s r
putByteStringLen8 :: forall r s. ErrorContext r => ByteString -> SPut s r
putByteStringLen8 bs :: ByteString
bs@(ByteString -> Int
B.length -> Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff = do
    Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell (Builder -> SPut s r) -> Builder -> SPut s r
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
B.word8 (Int -> Word8
iw8 Int
len) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs
putByteStringLen8 ByteString
_ =
    (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
EncodeTooLong

-- | 'ShortByteString' counterpart of 'putByteStringLen8'.
putShortByteStringLen8 :: ErrorContext r => ShortByteString -> SPut s r
putShortByteStringLen8 :: forall r s. ErrorContext r => ShortByteString -> SPut s r
putShortByteStringLen8 bs :: ShortByteString
bs@(ShortByteString -> Int
SB.length -> Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff = do
    Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos (Int -> SPut s r) -> Int -> SPut s r
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell (Builder -> SPut s r) -> Builder -> SPut s r
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
B.word8 (Int -> Word8
iw8 Int
len) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
B.shortByteString ShortByteString
bs
putShortByteStringLen8 ShortByteString
_ = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
EncodeTooLong

-- | Write a 16-bit-length-prefixed 'ByteString'.  Fails with
-- 'EncodeTooLong' if the input exceeds 65535 bytes.
putByteStringLen16 :: ErrorContext r => ByteString -> SPut s r
putByteStringLen16 :: forall r s. ErrorContext r => ByteString -> SPut s r
putByteStringLen16 bs :: ByteString
bs@(ByteString -> Int
B.length -> Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = do
    Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos (Int -> SPut s r) -> Int -> SPut s r
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell (Builder -> SPut s r) -> Builder -> SPut s r
forall a b. (a -> b) -> a -> b
$ Word16 -> Builder
B.word16BE (Int -> Word16
iw16 Int
len) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
bs
putByteStringLen16 ByteString
_ = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
EncodeTooLong

-- | 'ShortByteString' counterpart of 'putByteStringLen16'.
putShortByteStringLen16 :: ErrorContext r => ShortByteString -> SPut s r
putShortByteStringLen16 :: forall r s. ErrorContext r => ShortByteString -> SPut s r
putShortByteStringLen16 bs :: ShortByteString
bs@(ShortByteString -> Int
SB.length -> Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = do
    Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos (Int -> SPut s r) -> Int -> SPut s r
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell (Builder -> SPut s r) -> Builder -> SPut s r
forall a b. (a -> b) -> a -> b
$ Word16 -> Builder
B.word16BE (Int -> Word16
iw16 Int
len) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Builder
B.shortByteString ShortByteString
bs
putShortByteStringLen16 ShortByteString
_ = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
EncodeTooLong

-- | Write the UTF-8 encoding of a 'Text' verbatim, with no
-- length prefix.
putUtf8Text :: ErrorContext r => Text -> SPut s r
putUtf8Text :: forall r s. ErrorContext r => Text -> SPut s r
putUtf8Text Text
t =
    Bool -> SPutM s r () -> SPutM s r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
t) (SPutM s r () -> SPutM s r ()) -> SPutM s r () -> SPutM s r ()
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> (Text -> Builder) -> Text -> SPutM s r ()
forall r a s.
ErrorContext r =>
(a -> Int) -> (a -> Builder) -> a -> SPut s r
encVar Text -> Int
T.lengthWord8 Text -> Builder
T.encodeUtf8Builder Text
t

-- | Write a UTF-8-encoded 'Text' with an 8-bit length prefix
-- (length in /bytes/, not codepoints).  Fails with 'EncodeTooLong'
-- if the UTF-8 encoding exceeds 255 bytes.
putUtf8TextLen8 :: ErrorContext r => Text -> SPut s r
putUtf8TextLen8 :: forall r s. ErrorContext r => Text -> SPut s r
putUtf8TextLen8 t :: Text
t@(Text -> Int
T.lengthWord8-> Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff = do
    Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos (Int -> SPut s r) -> Int -> SPut s r
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell (Builder -> SPut s r) -> Builder -> SPut s r
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
B.word8 (Int -> Word8
iw8 Int
len) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.encodeUtf8Builder Text
t
putUtf8TextLen8 Text
_ = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
EncodeTooLong

-- | Write a UTF-8-encoded 'Text' with a 16-bit length prefix
-- (length in /bytes/).  Fails with 'EncodeTooLong' if the UTF-8
-- encoding exceeds 65535 bytes.
putUtf8TextLen16 :: ErrorContext r => Text -> SPut s r
putUtf8TextLen16 :: forall r s. ErrorContext r => Text -> SPut s r
putUtf8TextLen16 t :: Text
t@(Text -> Int
T.lengthWord8-> Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = do
    Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos (Int -> SPut s r) -> Int -> SPut s r
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell (Builder -> SPut s r) -> Builder -> SPut s r
forall a b. (a -> b) -> a -> b
$ Word16 -> Builder
B.word16BE (Int -> Word16
iw16 Int
len) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.encodeUtf8Builder Text
t
putUtf8TextLen16 Text
_ = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
EncodeTooLong

iw8 :: Int -> Word8
iw8 :: Int -> Word8
iw8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE iw8 #-}

iw16 :: Int -> Word16
iw16 :: Int -> Word16
iw16 = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE iw16 #-}

-- | Write @n@ copies of the byte @w@ (used for fixed-width
-- zero-padded fields).
putReplicate :: ErrorContext r => Word8 -> Word8 -> SPut s r
putReplicate :: forall r s. ErrorContext r => Word8 -> Word8 -> SPut s r
putReplicate Word8
n Word8
w =
    Int -> (LazyByteString -> Builder) -> LazyByteString -> SPut s r
forall r a s.
ErrorContext r =>
Int -> (a -> Builder) -> a -> SPut s r
encFix (Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
n) LazyByteString -> Builder
B.lazyByteString (LazyByteString -> SPut s r) -> LazyByteString -> SPut s r
forall a b. (a -> b) -> a -> b
$
        Int64 -> Word8 -> LazyByteString
LB.replicate (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Word8
w

-- | Write a length-tracked 'SizedBuilder' verbatim, advancing the
-- encoder offset by the builder's recorded length.  Fails with
-- 'EncodeTooLong' when the builder itself carries the overflow
-- sentinel.
putSizedBuilder :: ErrorContext r => SizedBuilder -> SPut s r
putSizedBuilder :: forall r s. ErrorContext r => SizedBuilder -> SPut s r
putSizedBuilder (SizedBuilder Int
len Builder
b) = Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos Int
len SPut s r -> SPut s r -> SPut s r
forall a b. SPutM s r a -> SPutM s r b -> SPutM s r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder -> SPut s r
forall s r. Builder -> SPutM s r ()
tell Builder
b
putSizedBuilder SizedBuilder
_                    = (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith a -> EncodeErr a
forall r. (Typeable r, Show r, Eq r) => r -> EncodeErr r
forall a. ErrorContext a => a -> EncodeErr a
EncodeTooLong
{-# INLINE putSizedBuilder #-}

------------------------------------------

-- | Wrap a writer with an outer 16-bit length prefix that is
-- computed automatically from the writer's output.  Used for
-- @RDLENGTH@ and the various length-prefixed sub-fields of RR
-- data (SVCB option values, EDNS option values, and so on).
passLen :: ErrorContext r => SPutM s r a -> SPutM s r a
passLen :: forall r s a. ErrorContext r => SPutM s r a -> SPutM s r a
passLen SPutM s r a
m = SPutM s r (a, Builder -> Builder) -> SPutM s r a
forall s r a. SPutM s r (a, Builder -> Builder) -> SPutM s r a
pass (SPutM s r (a, Builder -> Builder) -> SPutM s r a)
-> SPutM s r (a, Builder -> Builder) -> SPutM s r a
forall a b. (a -> b) -> a -> b
$ do
        pos <- Int -> SPut s r
forall r s. ErrorContext r => Int -> SPut s r
addPos Int
2 SPut s r -> SPutM s r Int -> SPutM s r Int
forall a b. SPutM s r a -> SPutM s r b -> SPutM s r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (EncState s -> Int) -> SPutM s r Int
forall s r a. (EncState s -> a) -> SPutM s r a
gets EncState s -> Int
forall s. EncState s -> Int
encOffset
        x <- m
        len <- subtract pos <$> gets encOffset
        return (x, prependLen len)

prependLen :: Int -> B.Builder -> B.Builder
prependLen :: Int -> Builder -> Builder
prependLen = Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend (Builder -> Builder -> Builder)
-> (Int -> Builder) -> Int -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
B.word16BE (Word16 -> Builder) -> (Int -> Word16) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Abort the encoder with the given error, attaching the current
-- 'ErrorContext' from the reader environment.  Used by individual
-- writers when an out-of-range or otherwise invalid value cannot
-- be serialised.
failWith :: ErrorContext r => (forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith :: forall r s.
ErrorContext r =>
(forall a. ErrorContext a => a -> EncodeErr a) -> SPut s r
failWith forall a. ErrorContext a => a -> EncodeErr a
f = SPutM s r (Maybe r)
forall s r. SPutM s r (Maybe r)
ask SPutM s r (Maybe r) -> (Maybe r -> SPutM s r ()) -> SPutM s r ()
forall a b. SPutM s r a -> (a -> SPutM s r b) -> SPutM s r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BaseM s r () -> SPutM s r ()
forall s r a. BaseM s r a -> SPutM s r a
liftSPut (BaseM s r () -> SPutM s r ())
-> (Maybe r -> BaseM s r ()) -> Maybe r -> SPutM s r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeErr (Maybe r) -> BaseM s r ()
forall e s a. e -> STE e s a
STE.throwSTE (EncodeErr (Maybe r) -> BaseM s r ())
-> (Maybe r -> EncodeErr (Maybe r)) -> Maybe r -> BaseM s r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe r -> EncodeErr (Maybe r)
forall a. ErrorContext a => a -> EncodeErr a
f

-- | Run a sub-encoder with the given context value installed, so
-- that any 'failWith' inside reports its error against that
-- context.  Used to label sections of the encode (RR header, RR
-- data, EDNS option, ...) so that error messages identify which
-- field went wrong.
setContext :: ErrorContext r => r -> SPutM s r a -> SPutM s r a
setContext :: forall r s a. ErrorContext r => r -> SPutM s r a -> SPutM s r a
setContext r
r = (Maybe r -> Maybe r) -> SPutM s r a -> SPutM s r a
forall s r a. (Maybe r -> Maybe r) -> SPutM s r a -> SPutM s r a
localSPut (Maybe r -> Maybe r -> Maybe r
forall a b. a -> b -> a
const (Maybe r -> Maybe r -> Maybe r) -> Maybe r -> Maybe r -> Maybe r
forall a b. (a -> b) -> a -> b
$ r -> Maybe r
forall a. a -> Maybe a
Just r
r)
{-# INLINE setContext #-}

----------------------------------------------------------------

type BaseM s r = STE.STE (EncodeErr (Maybe r)) s
type RWST s r = R.RWST (Maybe r) Builder (EncState s) (BaseM s r)

-- | Encode an output packet in the ST monad, with @r@ as an
-- optional error context (typically the RData being encoded, when
-- applicable).
type SPut s r = SPutM s r ()

-- | The underlying SPut monad
newtype SPutM s r a = SPutM { forall s r a. SPutM s r a -> RWST s r a
_unSPutM :: RWST s r a }

instance Functor (SPutM s r) where
    fmap :: forall a b. (a -> b) -> SPutM s r a -> SPutM s r b
    fmap :: forall a b. (a -> b) -> SPutM s r a -> SPutM s r b
fmap = ((a -> b) -> RWST s r a -> RWST s r b)
-> (a -> b) -> SPutM s r a -> SPutM s r b
forall a b. Coercible a b => a -> b
coerce ((a -> b) -> RWST s r a -> RWST s r b
forall a b.
(a -> b)
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) a
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap :: (a -> b) -> RWST s r a -> RWST s r b)
    {-# INLINE fmap #-}

    (<$) :: forall a b. a -> SPutM s r b -> SPutM s r a
    <$ :: forall a b. a -> SPutM s r b -> SPutM s r a
(<$) = (a -> RWST s r b -> RWST s r a) -> a -> SPutM s r b -> SPutM s r a
forall a b. Coercible a b => a -> b
coerce (a -> RWST s r b -> RWST s r a
forall a b.
a
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) :: a -> RWST s r b -> RWST s r a)
    {-# INLINE (<$) #-}

instance Applicative (SPutM s r) where
    pure :: forall a. a -> SPutM s r a
    pure :: forall a. a -> SPutM s r a
pure = (a -> RWST s r a) -> a -> SPutM s r a
forall a b. Coercible a b => a -> b
coerce (a -> RWST s r a
forall a. a -> RWST (Maybe r) Builder (EncState s) (BaseM s r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure :: a -> RWST s r a)
    {-# INLINE pure #-}

    liftA2 :: forall a b c. (a -> b -> c) -> SPutM s r a -> SPutM s r b -> SPutM s r c
    liftA2 :: forall a b c.
(a -> b -> c) -> SPutM s r a -> SPutM s r b -> SPutM s r c
liftA2 = ((a -> b -> c) -> RWST s r a -> RWST s r b -> RWST s r c)
-> (a -> b -> c) -> SPutM s r a -> SPutM s r b -> SPutM s r c
forall a b. Coercible a b => a -> b
coerce ((a -> b -> c) -> RWST s r a -> RWST s r b -> RWST s r c
forall a b c.
(a -> b -> c)
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) a
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 :: (a -> b -> c) -> RWST s r a -> RWST s r b -> RWST s r c)
    {-# INLINE liftA2 #-}

    (<*>) :: forall a b. SPutM s r (a -> b) -> SPutM s r a -> SPutM s r b
    <*> :: forall a b. SPutM s r (a -> b) -> SPutM s r a -> SPutM s r b
(<*>) = (RWST s r (a -> b) -> RWST s r a -> RWST s r b)
-> SPutM s r (a -> b) -> SPutM s r a -> SPutM s r b
forall a b. Coercible a b => a -> b
coerce (RWST s r (a -> b) -> RWST s r a -> RWST s r b
forall a b.
RWST (Maybe r) Builder (EncState s) (BaseM s r) (a -> b)
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) a
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) :: RWST s r (a -> b) -> RWST s r a -> RWST s r b)
    {-# INLINE (<*>) #-}

    (*>) :: forall a b. SPutM s r a -> SPutM s r b -> SPutM s r b
    *> :: forall a b. SPutM s r a -> SPutM s r b -> SPutM s r b
(*>) = (RWST s r a -> RWST s r b -> RWST s r b)
-> SPutM s r a -> SPutM s r b -> SPutM s r b
forall a b. Coercible a b => a -> b
coerce (RWST s r a -> RWST s r b -> RWST s r b
forall a b.
RWST (Maybe r) Builder (EncState s) (BaseM s r) a
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) :: RWST s r a -> RWST s r b -> RWST s r b)
    {-# INLINE (*>) #-}

    (<*) :: forall a b. SPutM s r a -> SPutM s r b -> SPutM s r a
    <* :: forall a b. SPutM s r a -> SPutM s r b -> SPutM s r a
(<*) = (RWST s r a -> RWST s r b -> RWST s r a)
-> SPutM s r a -> SPutM s r b -> SPutM s r a
forall a b. Coercible a b => a -> b
coerce (RWST s r a -> RWST s r b -> RWST s r a
forall a b.
RWST (Maybe r) Builder (EncState s) (BaseM s r) a
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) :: RWST s r a -> RWST s r b -> RWST s r a)
    {-# INLINE (<*) #-}

instance Monad (SPutM s r) where
    (>>=) :: forall a b. SPutM s r a -> (a -> SPutM s r b) -> SPutM s r b
    >>= :: forall a b. SPutM s r a -> (a -> SPutM s r b) -> SPutM s r b
(>>=) = (RWST s r a -> (a -> RWST s r b) -> RWST s r b)
-> SPutM s r a -> (a -> SPutM s r b) -> SPutM s r b
forall a b. Coercible a b => a -> b
coerce (RWST s r a -> (a -> RWST s r b) -> RWST s r b
forall a b.
RWST (Maybe r) Builder (EncState s) (BaseM s r) a
-> (a -> RWST (Maybe r) Builder (EncState s) (BaseM s r) b)
-> RWST (Maybe r) Builder (EncState s) (BaseM s r) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) :: RWST s r a -> (a -> RWST s r b) -> RWST s r b)
    {-# INLINE (>>=) #-}

evalSPutM :: forall s r a. (forall t. SPutM t r a) -> (Maybe r) -> (EncState s) -> BaseM s r (a, Builder)
evalSPutM :: forall s r a.
(forall t. SPutM t r a)
-> Maybe r -> EncState s -> BaseM s r (a, Builder)
evalSPutM forall t. SPutM t r a
m = (Maybe r -> EncState s -> BaseM s r (a, Builder))
-> Maybe r -> EncState s -> BaseM s r (a, Builder)
forall a b. Coercible a b => a -> b
coerce (RWST (Maybe r) Builder (EncState s) (STE (EncodeErr (Maybe r)) s) a
-> Maybe r -> EncState s -> BaseM s r (a, Builder)
forall (m :: * -> *) w r s a.
(Monad m, Monoid w) =>
RWST r w s m a -> r -> s -> m (a, w)
R.evalRWST (SPutM t r a -> RWST t r a
forall a b. Coercible a b => a -> b
coerce SPutM t r a
forall t. SPutM t r a
m :: (forall t. RWST t r a)) :: Maybe r -> EncState s -> BaseM s r (a, Builder))
{-# INLINE evalSPutM #-}

liftSPut :: forall s r a. BaseM s r a -> SPutM s r a
liftSPut :: forall s r a. BaseM s r a -> SPutM s r a
liftSPut = (BaseM s r a -> RWST s r a) -> BaseM s r a -> SPutM s r a
forall a b. Coercible a b => a -> b
coerce (BaseM s r a -> RWST s r a
forall (m :: * -> *) a.
Monad m =>
m a -> RWST (Maybe r) Builder (EncState s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift :: BaseM s r a -> RWST s r a)

ask :: forall s r. SPutM s r (Maybe r)
ask :: forall s r. SPutM s r (Maybe r)
ask = RWST s r (Maybe r) -> SPutM s r (Maybe r)
forall a b. Coercible a b => a -> b
coerce (RWST s r (Maybe r)
forall (m :: * -> *) r w s. Monad m => RWST r w s m r
R.ask :: RWST s r (Maybe r))
{-# INLINE ask #-}

get :: forall s r. SPutM s r (EncState s)
get :: forall s r. SPutM s r (EncState s)
get = RWST s r (EncState s) -> SPutM s r (EncState s)
forall a b. Coercible a b => a -> b
coerce (RWST s r (EncState s)
forall (m :: * -> *) r w s. Monad m => RWST r w s m s
R.get :: RWST s r (EncState s))
{-# INLINE get #-}

gets :: forall s r a. (EncState s -> a) -> SPutM s r a
gets :: forall s r a. (EncState s -> a) -> SPutM s r a
gets = ((EncState s -> a) -> RWST s r a)
-> (EncState s -> a) -> SPutM s r a
forall a b. Coercible a b => a -> b
coerce ((EncState s -> a) -> RWST s r a
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
R.gets :: (EncState s -> a) -> RWST s r a)
{-# INLINE gets #-}

-- | Run the encoder with a modified context
localSPut :: forall s r a. (Maybe r -> Maybe r) -> SPutM s r a -> SPutM s r a
localSPut :: forall s r a. (Maybe r -> Maybe r) -> SPutM s r a -> SPutM s r a
localSPut = ((Maybe r -> Maybe r) -> RWST s r a -> RWST s r a)
-> (Maybe r -> Maybe r) -> SPutM s r a -> SPutM s r a
forall a b. Coercible a b => a -> b
coerce ((Maybe r -> Maybe r) -> RWST s r a -> RWST s r a
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
R.local :: (Maybe r -> Maybe r) -> RWST s r a -> RWST s r a)
{-# INLINE localSPut #-}

pass :: forall s r a. SPutM s r (a, Builder -> Builder) -> SPutM s r a
pass :: forall s r a. SPutM s r (a, Builder -> Builder) -> SPutM s r a
pass = (RWST s r (a, Builder -> Builder) -> RWST s r a)
-> SPutM s r (a, Builder -> Builder) -> SPutM s r a
forall a b. Coercible a b => a -> b
coerce (RWST s r (a, Builder -> Builder) -> RWST s r a
forall w w' (m :: * -> *) r s a.
(Monoid w, Monoid w', Monad m) =>
RWST r w s m (a, w -> w') -> RWST r w' s m a
R.pass :: RWST s r (a, Builder -> Builder) -> RWST s r a)
{-# INLINE pass #-}

put :: forall s r. EncState s -> SPutM s r ()
put :: forall s r. EncState s -> SPutM s r ()
put = (EncState s -> RWST s r ()) -> EncState s -> SPutM s r ()
forall a b. Coercible a b => a -> b
coerce (EncState s -> RWST s r ()
forall (m :: * -> *) s r w. Monad m => s -> RWST r w s m ()
R.put :: EncState s -> RWST s r ())
{-# INLINE put #-}

tell :: forall s r. Builder -> SPutM s r ()
tell :: forall s r. Builder -> SPutM s r ()
tell = (Builder -> RWST s r ()) -> Builder -> SPutM s r ()
forall a b. Coercible a b => a -> b
coerce (Builder -> RWST s r ()
forall w (m :: * -> *) r s.
(Monoid w, Monad m) =>
w -> RWST r w s m ()
R.tell :: Builder -> RWST s r ())
{-# INLINE tell #-}