-- |
-- Module: M.IO.Internal.Datagram
-- Description: Packet parsing and building internals
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Internal module for handling low-level packet parsing and building,
-- including uninterpreted packets and stream transformations.
module M.IO.Internal.Datagram
  ( -- * Types
    Uninterpreted (..),
    EOF (..),

    -- * Streams
    makepacketstreami,
    makepacketstreamo,
    makedecrypting,
    makeencrypting,
  )
where

import Codec.Compression.Zlib
import Control.Concurrent.STM
import Control.DeepSeq
import Control.Exception hiding (throw)
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder qualified as BB
import Data.ByteString.Lazy qualified as BL
import Data.Data
import Data.Hashable
import Data.Word
import FlatParse.Stateful
import GHC.Generics
import Language.Haskell.TH.Syntax (Lift)
import M.IO.Internal.Read
import M.IO.Internal.Zlib
import M.Pack hiding (Parser)
import System.IO.Streams hiding (compress)
import Text.Printf
import Prelude hiding (read)

-- | uninterpreted packet
data Uninterpreted = Uninterpreted
  { Uninterpreted -> Word8
pkcode :: !Word8,
    Uninterpreted -> ByteString
pkdata :: !ByteString
  }
  deriving (Uninterpreted -> Uninterpreted -> Bool
(Uninterpreted -> Uninterpreted -> Bool)
-> (Uninterpreted -> Uninterpreted -> Bool) -> Eq Uninterpreted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Uninterpreted -> Uninterpreted -> Bool
== :: Uninterpreted -> Uninterpreted -> Bool
$c/= :: Uninterpreted -> Uninterpreted -> Bool
/= :: Uninterpreted -> Uninterpreted -> Bool
Eq, Eq Uninterpreted
Eq Uninterpreted =>
(Uninterpreted -> Uninterpreted -> Ordering)
-> (Uninterpreted -> Uninterpreted -> Bool)
-> (Uninterpreted -> Uninterpreted -> Bool)
-> (Uninterpreted -> Uninterpreted -> Bool)
-> (Uninterpreted -> Uninterpreted -> Bool)
-> (Uninterpreted -> Uninterpreted -> Uninterpreted)
-> (Uninterpreted -> Uninterpreted -> Uninterpreted)
-> Ord Uninterpreted
Uninterpreted -> Uninterpreted -> Bool
Uninterpreted -> Uninterpreted -> Ordering
Uninterpreted -> Uninterpreted -> Uninterpreted
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 :: Uninterpreted -> Uninterpreted -> Ordering
compare :: Uninterpreted -> Uninterpreted -> Ordering
$c< :: Uninterpreted -> Uninterpreted -> Bool
< :: Uninterpreted -> Uninterpreted -> Bool
$c<= :: Uninterpreted -> Uninterpreted -> Bool
<= :: Uninterpreted -> Uninterpreted -> Bool
$c> :: Uninterpreted -> Uninterpreted -> Bool
> :: Uninterpreted -> Uninterpreted -> Bool
$c>= :: Uninterpreted -> Uninterpreted -> Bool
>= :: Uninterpreted -> Uninterpreted -> Bool
$cmax :: Uninterpreted -> Uninterpreted -> Uninterpreted
max :: Uninterpreted -> Uninterpreted -> Uninterpreted
$cmin :: Uninterpreted -> Uninterpreted -> Uninterpreted
min :: Uninterpreted -> Uninterpreted -> Uninterpreted
Ord, Eq Uninterpreted
Eq Uninterpreted =>
(Int -> Uninterpreted -> Int)
-> (Uninterpreted -> Int) -> Hashable Uninterpreted
Int -> Uninterpreted -> Int
Uninterpreted -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Uninterpreted -> Int
hashWithSalt :: Int -> Uninterpreted -> Int
$chash :: Uninterpreted -> Int
hash :: Uninterpreted -> Int
Hashable, Typeable, (forall x. Uninterpreted -> Rep Uninterpreted x)
-> (forall x. Rep Uninterpreted x -> Uninterpreted)
-> Generic Uninterpreted
forall x. Rep Uninterpreted x -> Uninterpreted
forall x. Uninterpreted -> Rep Uninterpreted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Uninterpreted -> Rep Uninterpreted x
from :: forall x. Uninterpreted -> Rep Uninterpreted x
$cto :: forall x. Rep Uninterpreted x -> Uninterpreted
to :: forall x. Rep Uninterpreted x -> Uninterpreted
Generic, Typeable Uninterpreted
Typeable Uninterpreted =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Uninterpreted -> c Uninterpreted)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Uninterpreted)
-> (Uninterpreted -> Constr)
-> (Uninterpreted -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Uninterpreted))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Uninterpreted))
-> ((forall b. Data b => b -> b) -> Uninterpreted -> Uninterpreted)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r)
-> (forall u. (forall d. Data d => d -> u) -> Uninterpreted -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Uninterpreted -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted)
-> Data Uninterpreted
Uninterpreted -> Constr
Uninterpreted -> DataType
(forall b. Data b => b -> b) -> Uninterpreted -> Uninterpreted
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Uninterpreted -> u
forall u. (forall d. Data d => d -> u) -> Uninterpreted -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Uninterpreted
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Uninterpreted -> c Uninterpreted
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Uninterpreted)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Uninterpreted)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Uninterpreted -> c Uninterpreted
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Uninterpreted -> c Uninterpreted
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Uninterpreted
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Uninterpreted
$ctoConstr :: Uninterpreted -> Constr
toConstr :: Uninterpreted -> Constr
$cdataTypeOf :: Uninterpreted -> DataType
dataTypeOf :: Uninterpreted -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Uninterpreted)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Uninterpreted)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Uninterpreted)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Uninterpreted)
$cgmapT :: (forall b. Data b => b -> b) -> Uninterpreted -> Uninterpreted
gmapT :: (forall b. Data b => b -> b) -> Uninterpreted -> Uninterpreted
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Uninterpreted -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Uninterpreted -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Uninterpreted -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Uninterpreted -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Uninterpreted -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Uninterpreted -> m Uninterpreted
Data, (forall (m :: * -> *). Quote m => Uninterpreted -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Uninterpreted -> Code m Uninterpreted)
-> Lift Uninterpreted
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Uninterpreted -> m Exp
forall (m :: * -> *).
Quote m =>
Uninterpreted -> Code m Uninterpreted
$clift :: forall (m :: * -> *). Quote m => Uninterpreted -> m Exp
lift :: forall (m :: * -> *). Quote m => Uninterpreted -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Uninterpreted -> Code m Uninterpreted
liftTyped :: forall (m :: * -> *).
Quote m =>
Uninterpreted -> Code m Uninterpreted
Lift, Uninterpreted -> ()
(Uninterpreted -> ()) -> NFData Uninterpreted
forall a. (a -> ()) -> NFData a
$crnf :: Uninterpreted -> ()
rnf :: Uninterpreted -> ()
NFData)

instance Show Uninterpreted where
  show :: Uninterpreted -> String
show (Uninterpreted Word8
c ByteString
d) = String -> Word8 -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Uninterpreted %d <%d bytes>" Word8
c (ByteString -> Int
B.length ByteString
d)

-- | end of input
data EOF = EOF deriving (Int -> EOF -> ShowS
[EOF] -> ShowS
EOF -> String
(Int -> EOF -> ShowS)
-> (EOF -> String) -> ([EOF] -> ShowS) -> Show EOF
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EOF -> ShowS
showsPrec :: Int -> EOF -> ShowS
$cshow :: EOF -> String
show :: EOF -> String
$cshowList :: [EOF] -> ShowS
showList :: [EOF] -> ShowS
Show, ReadPrec [EOF]
ReadPrec EOF
Int -> ReadS EOF
ReadS [EOF]
(Int -> ReadS EOF)
-> ReadS [EOF] -> ReadPrec EOF -> ReadPrec [EOF] -> Read EOF
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EOF
readsPrec :: Int -> ReadS EOF
$creadList :: ReadS [EOF]
readList :: ReadS [EOF]
$creadPrec :: ReadPrec EOF
readPrec :: ReadPrec EOF
$creadListPrec :: ReadPrec [EOF]
readListPrec :: ReadPrec [EOF]
Read, (forall x. EOF -> Rep EOF x)
-> (forall x. Rep EOF x -> EOF) -> Generic EOF
forall x. Rep EOF x -> EOF
forall x. EOF -> Rep EOF x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EOF -> Rep EOF x
from :: forall x. EOF -> Rep EOF x
$cto :: forall x. Rep EOF x -> EOF
to :: forall x. Rep EOF x -> EOF
Generic, Typeable EOF
Typeable EOF =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EOF -> c EOF)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EOF)
-> (EOF -> Constr)
-> (EOF -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EOF))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EOF))
-> ((forall b. Data b => b -> b) -> EOF -> EOF)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r)
-> (forall u. (forall d. Data d => d -> u) -> EOF -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> EOF -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EOF -> m EOF)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EOF -> m EOF)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EOF -> m EOF)
-> Data EOF
EOF -> Constr
EOF -> DataType
(forall b. Data b => b -> b) -> EOF -> EOF
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EOF -> u
forall u. (forall d. Data d => d -> u) -> EOF -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOF
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOF -> c EOF
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EOF)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EOF)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOF -> c EOF
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOF -> c EOF
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOF
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOF
$ctoConstr :: EOF -> Constr
toConstr :: EOF -> Constr
$cdataTypeOf :: EOF -> DataType
dataTypeOf :: EOF -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EOF)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EOF)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EOF)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EOF)
$cgmapT :: (forall b. Data b => b -> b) -> EOF -> EOF
gmapT :: (forall b. Data b => b -> b) -> EOF -> EOF
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EOF -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EOF -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EOF -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EOF -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EOF -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EOF -> m EOF
Data, Typeable, (forall (m :: * -> *). Quote m => EOF -> m Exp)
-> (forall (m :: * -> *). Quote m => EOF -> Code m EOF) -> Lift EOF
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => EOF -> m Exp
forall (m :: * -> *). Quote m => EOF -> Code m EOF
$clift :: forall (m :: * -> *). Quote m => EOF -> m Exp
lift :: forall (m :: * -> *). Quote m => EOF -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => EOF -> Code m EOF
liftTyped :: forall (m :: * -> *). Quote m => EOF -> Code m EOF
Lift, Show EOF
Typeable EOF
(Typeable EOF, Show EOF) =>
(EOF -> SomeException)
-> (SomeException -> Maybe EOF) -> (EOF -> String) -> Exception EOF
SomeException -> Maybe EOF
EOF -> String
EOF -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: EOF -> SomeException
toException :: EOF -> SomeException
$cfromException :: SomeException -> Maybe EOF
fromException :: SomeException -> Maybe EOF
$cdisplayException :: EOF -> String
displayException :: EOF -> String
Exception)

-- | make a stream of uninterpreted packets
makepacketstreami ::
  -- | compression threshold reference (negative = off,
  -- non-negative = on with threshold)
  TVar Int ->
  -- | input stream
  InputStream ByteString ->
  -- | stream of uninterpreted packets
  IO (InputStream Uninterpreted)
makepacketstreami :: TVar Int
-> InputStream ByteString -> IO (InputStream Uninterpreted)
makepacketstreami TVar Int
c InputStream ByteString
s =
  IO (Maybe Uninterpreted) -> IO (InputStream Uninterpreted)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream do
    Int
threshold <- TVar Int -> IO Int
forall a. TVar a -> IO a
readTVarIO TVar Int
c
    Uninterpreted -> Maybe Uninterpreted
forall a. a -> Maybe a
Just (Uninterpreted -> Maybe Uninterpreted)
-> IO Uninterpreted -> IO (Maybe Uninterpreted)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InputStream ByteString -> IO Uninterpreted
takepacket Int
threshold InputStream ByteString
s
  where
    takepacket :: Int -> InputStream ByteString -> IO Uninterpreted
takepacket Int
threshold InputStream ByteString
b = do
      Int
t <- forall e a.
Exception e =>
InputStream ByteString -> ParserIO () e a -> IO a
parseio0 @ParseError InputStream ByteString
b ParserIO () ParseError Int
forall {st :: ZeroBitType} {r}. ParserT st r ParseError Int
checkedlength
      ByteString
u <- Int -> InputStream ByteString -> IO ByteString
readExactly Int
t InputStream ByteString
b
      let p :: ParserT IOMode () ParseError Uninterpreted
p
            | Int
threshold Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = ParserT IOMode () ParseError Uninterpreted
parsepostcomp
            | Bool
otherwise = ParserT IOMode () ParseError Uninterpreted
forall {st :: ZeroBitType} {r} {e}. ParserT st r e Uninterpreted
parseprecomp
      ParserT IOMode () ParseError Uninterpreted
-> () -> Int -> ByteString -> IO (Result ParseError Uninterpreted)
forall r e a.
ParserIO r e a -> r -> Int -> ByteString -> IO (Result e a)
runParserIO ParserT IOMode () ParseError Uninterpreted
p () Int
0 ByteString
u IO (Result ParseError Uninterpreted)
-> (Result ParseError Uninterpreted -> IO Uninterpreted)
-> IO Uninterpreted
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        OK Uninterpreted
a Int
_ ByteString
_ -> Uninterpreted -> IO Uninterpreted
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Uninterpreted
a
        Result ParseError Uninterpreted
Fail -> String -> IO Uninterpreted
forall a. HasCallStack => String -> a
error String
"takepacket: parse failed"
        Err ParseError
e -> ParseError -> IO Uninterpreted
forall e a. Exception e => e -> IO a
throwIO ParseError
e
      where
        checkedlength :: ParserT st r ParseError Int
checkedlength = do
          Int
l <- forall a (st :: ZeroBitType) r. Integral a => Parser st r a
unpackleb32 @Int
          if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x400000
            then String -> ParserT st r ParseError Int
forall {st :: ZeroBitType} {r} {a}.
String -> ParserT st r ParseError a
throw (String -> ParserT st r ParseError Int)
-> String -> ParserT st r ParseError Int
forall a b. (a -> b) -> a -> b
$ String
"takepacket: invalid length: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes"
            else Int -> ParserT st r ParseError Int
forall a. a -> ParserT st r ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
l
    throw :: String -> ParserT st r ParseError a
throw = ParseError -> ParserT st r ParseError a
forall e (st :: ZeroBitType) r a. e -> ParserT st r e a
err (ParseError -> ParserT st r ParseError a)
-> (String -> ParseError) -> String -> ParserT st r ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ParseError
    parseprecomp :: ParserT st r e Uninterpreted
parseprecomp = (Word8 -> ByteString -> Uninterpreted)
-> ParserT st r e Word8
-> ParserT st r e ByteString
-> ParserT st r e Uninterpreted
forall a b c.
(a -> b -> c)
-> ParserT st r e a -> ParserT st r e b -> ParserT st r e c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word8 -> ByteString -> Uninterpreted
Uninterpreted ParserT st r e Word8
forall (st :: ZeroBitType) r e. ParserT st r e Word8
anyWord8 ParserT st r e ByteString
forall (st :: ZeroBitType) r e. ParserT st r e ByteString
takeRest
    parsepostcomp :: ParserT IOMode () ParseError Uninterpreted
parsepostcomp = ParserT IOMode () ParseError Uninterpreted
forall {st :: ZeroBitType} {r} {e}. ParserT st r e Uninterpreted
parser2 ParserT IOMode () ParseError Uninterpreted
-> ParserT IOMode () ParseError Uninterpreted
-> ParserT IOMode () ParseError Uninterpreted
forall (st :: ZeroBitType) r e a.
ParserT st r e a -> ParserT st r e a -> ParserT st r e a
<|> ParserT IOMode () ParseError Uninterpreted
parser3 ParserT IOMode () ParseError Uninterpreted
-> ParserT IOMode () ParseError Uninterpreted
-> ParserT IOMode () ParseError Uninterpreted
forall (st :: ZeroBitType) r e a.
ParserT st r e a -> ParserT st r e a -> ParserT st r e a
<|> String -> ParserT IOMode () ParseError Uninterpreted
forall {st :: ZeroBitType} {r} {a}.
String -> ParserT st r ParseError a
throw String
"parsepostcomp: no match"
    parser2 :: ParserT st r e Uninterpreted
parser2 = Word8 -> ParserT st r e ()
forall (st :: ZeroBitType) r e. Word8 -> ParserT st r e ()
word8 Word8
0 ParserT st r e ()
-> ParserT st r e Uninterpreted -> ParserT st r e Uninterpreted
forall a b.
ParserT st r e a -> ParserT st r e b -> ParserT st r e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT st r e Uninterpreted
forall {st :: ZeroBitType} {r} {e}. ParserT st r e Uninterpreted
parseprecomp
    parser3 :: ParserT IOMode () ParseError Uninterpreted
parser3 = do
      -- uncompressed length, declared
      Int
l <- forall a (st :: ZeroBitType) r. Integral a => Parser st r a
unpackleb32 @Int ParserIO () ParseError Int
-> (Int -> ParserIO () ParseError Int)
-> ParserIO () ParseError Int
forall a b.
ParserT IOMode () ParseError a
-> (a -> ParserT IOMode () ParseError b)
-> ParserT IOMode () ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ParserIO () ParseError Int
forall {a} {st :: ZeroBitType} {r}.
(Ord a, Num a) =>
a -> ParserT st r ParseError a
checkuncomplen
      ByteString
d <- ParserT IOMode () ParseError ByteString
forall (st :: ZeroBitType) r e. ParserT st r e ByteString
takeRest ParserT IOMode () ParseError ByteString
-> (ByteString -> ParserT IOMode () ParseError ByteString)
-> ParserT IOMode () ParseError ByteString
forall a b.
ParserT IOMode () ParseError a
-> (a -> ParserT IOMode () ParseError b)
-> ParserT IOMode () ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO ByteString -> ParserT IOMode () ParseError ByteString
forall a. IO a -> ParserT IOMode () ParseError a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ParserT IOMode () ParseError ByteString)
-> (ByteString -> IO ByteString)
-> ByteString
-> ParserT IOMode () ParseError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> IO ByteString
safedecomp Int
l
      IO (Result Any Uninterpreted)
-> ParserT IOMode () ParseError (Result Any Uninterpreted)
forall a. IO a -> ParserT IOMode () ParseError a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ParserIO () Any Uninterpreted
-> () -> Int -> ByteString -> IO (Result Any Uninterpreted)
forall r e a.
ParserIO r e a -> r -> Int -> ByteString -> IO (Result e a)
runParserIO ParserIO () Any Uninterpreted
forall {st :: ZeroBitType} {r} {e}. ParserT st r e Uninterpreted
parseprecomp () Int
0 ByteString
d) ParserT IOMode () ParseError (Result Any Uninterpreted)
-> (Result Any Uninterpreted
    -> ParserT IOMode () ParseError Uninterpreted)
-> ParserT IOMode () ParseError Uninterpreted
forall a b.
ParserT IOMode () ParseError a
-> (a -> ParserT IOMode () ParseError b)
-> ParserT IOMode () ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        OK Uninterpreted
a Int
_ ByteString
b | ByteString -> Bool
B.null ByteString
b -> Uninterpreted -> ParserT IOMode () ParseError Uninterpreted
forall a. a -> ParserT IOMode () ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Uninterpreted
a
        OK Uninterpreted
_ Int
_ ByteString
b ->
          String -> ParserT IOMode () ParseError Uninterpreted
forall {st :: ZeroBitType} {r} {a}.
String -> ParserT st r ParseError a
throw (String -> ParserT IOMode () ParseError Uninterpreted)
-> String -> ParserT IOMode () ParseError Uninterpreted
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"parser3: trailing data: %d bytes left" (ByteString -> Int
B.length ByteString
b)
        Result Any Uninterpreted
Fail -> String -> ParserT IOMode () ParseError Uninterpreted
forall {st :: ZeroBitType} {r} {a}.
String -> ParserT st r ParseError a
throw String
"parser3: parseprecomp failed"
        Err Any
_ -> String -> ParserT IOMode () ParseError Uninterpreted
forall a. HasCallStack => String -> a
error String
"parser3: impossible"
      where
        checkuncomplen :: a -> ParserT st r ParseError a
checkuncomplen a
l
          | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = String -> ParserT st r ParseError a
forall {st :: ZeroBitType} {r} {a}.
String -> ParserT st r ParseError a
throw String
"parser3: negative length"
          | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0x800000 = String -> ParserT st r ParseError a
forall {st :: ZeroBitType} {r} {a}.
String -> ParserT st r ParseError a
throw String
"parser3: length too large"
          | Bool
otherwise = a -> ParserT st r ParseError a
forall a. a -> ParserT st r ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
l

-- encoding

-- size-tracked builder
data Building = B !Int !Builder -- size, builder

instance Semigroup Building where
  B Int
a Builder
b <> :: Building -> Building -> Building
<> B Int
c Builder
d = Int -> Builder -> Building
B (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) (Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
d)
  {-# INLINE (<>) #-}

instance Monoid Building where
  mempty :: Building
mempty = Int -> Builder -> Building
B Int
0 Builder
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}

-- | make an output stream of uninterpreted packets
makepacketstreamo ::
  TVar Int ->
  OutputStream ByteString ->
  IO (OutputStream Uninterpreted)
makepacketstreamo :: TVar Int
-> OutputStream ByteString -> IO (OutputStream Uninterpreted)
makepacketstreamo TVar Int
c OutputStream ByteString
s =
  (Maybe Uninterpreted -> IO ()) -> IO (OutputStream Uninterpreted)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream \case
    Maybe Uninterpreted
Nothing -> EOF -> IO ()
forall e a. Exception e => e -> IO a
throwIO EOF
EOF
    Just Uninterpreted
u -> do
      Int
threshold <- TVar Int -> IO Int
forall a. TVar a -> IO a
readTVarIO TVar Int
c
      Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
reify (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Uninterpreted -> Builder
encode Int
threshold Uninterpreted
u) OutputStream ByteString
s
  where
    reify :: Builder -> ByteString
reify = LazyByteString -> ByteString
B.toStrict (LazyByteString -> ByteString)
-> (Builder -> LazyByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
BB.toLazyByteString
    -- notes on "INLINE": inline thought to be good for sharing
    -- esp. the compression part (to avoid compressing the same data twice)
    -- (remains to be checked)
    encode :: Int -> Uninterpreted -> Builder
encode Int
d Uninterpreted
u =
      let B Int
n Builder
b = Int -> Uninterpreted -> Building
encodez Int
d Uninterpreted
u
       in Int -> Builder
forall a. Integral a => a -> Builder
packleb32 Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
    {-# INLINE encode #-}
    encodez :: Int -> Uninterpreted -> Building
encodez Int
threshold u :: Uninterpreted
u@(Uninterpreted Word8
f ByteString
d)
      | Int
threshold Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Uninterpreted -> Building
encodeplain Uninterpreted
u
      | ByteString -> Int
B.length ByteString
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
threshold = Uninterpreted -> Building
encodeu Uninterpreted
u
      | Bool
otherwise =
          Builder -> Building
mkb (Int -> Builder
forall a. Integral a => a -> Builder
packleb32 (ByteString -> Int
B.length ByteString
d))
            Building -> Building -> Building
forall a. Semigroup a => a -> a -> a
<> Builder -> Building
mkb (Word8 -> Builder
BB.word8 Word8
f)
            Building -> Building -> Building
forall a. Semigroup a => a -> a -> a
<> Builder -> Building
mkb (LazyByteString -> Builder
BB.lazyByteString (LazyByteString -> LazyByteString
compress (LazyByteString -> LazyByteString)
-> LazyByteString -> LazyByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> LazyByteString
B.fromStrict ByteString
d))
    {-# INLINE encodez #-}
    encodeu :: Uninterpreted -> Building
encodeu Uninterpreted
u = Builder -> Building
mkb (Word8 -> Builder
BB.word8 Word8
0) Building -> Building -> Building
forall a. Semigroup a => a -> a -> a
<> Uninterpreted -> Building
encodeplain Uninterpreted
u
    {-# INLINE encodeu #-}
    encodeplain :: Uninterpreted -> Building
encodeplain (Uninterpreted Word8
f ByteString
d) = Builder -> Building
mkb (Word8 -> Builder
BB.word8 Word8
f) Building -> Building -> Building
forall a. Semigroup a => a -> a -> a
<> Builder -> Building
mkb (ByteString -> Builder
BB.byteString ByteString
d)
    {-# INLINE encodeplain #-}
    mkb :: Builder -> Building
mkb Builder
b = Int -> Builder -> Building
B (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ LazyByteString -> Int64
BL.length (LazyByteString -> Int64) -> LazyByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Builder -> LazyByteString
BB.toLazyByteString Builder
b) Builder
b
    {-# INLINE mkb #-}

-- | register an octet streaming decryptor to an input stream
makedecrypting ::
  -- | decryptor
  TVar (ByteString -> IO ByteString) ->
  -- | input stream
  InputStream ByteString ->
  -- | new input stream
  IO (InputStream ByteString)
makedecrypting :: TVar (ByteString -> IO ByteString)
-> InputStream ByteString -> IO (InputStream ByteString)
makedecrypting TVar (ByteString -> IO ByteString)
f InputStream ByteString
s = IO (Maybe ByteString) -> IO (InputStream ByteString)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream do
  InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
s IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ByteString
Nothing -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
    Just ByteString
b -> TVar (ByteString -> IO ByteString)
-> IO (ByteString -> IO ByteString)
forall a. TVar a -> IO a
readTVarIO TVar (ByteString -> IO ByteString)
f IO (ByteString -> IO ByteString)
-> ((ByteString -> IO ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just <$>) (IO ByteString -> IO (Maybe ByteString))
-> ((ByteString -> IO ByteString) -> IO ByteString)
-> (ByteString -> IO ByteString)
-> IO (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
b)

-- | register an octet stremaing encryptor to an output stream
makeencrypting ::
  -- | encryptor
  TVar (ByteString -> IO ByteString) ->
  -- | output stream
  OutputStream ByteString ->
  -- | new output stream
  IO (OutputStream ByteString)
makeencrypting :: TVar (ByteString -> IO ByteString)
-> OutputStream ByteString -> IO (OutputStream ByteString)
makeencrypting TVar (ByteString -> IO ByteString)
f OutputStream ByteString
s = (Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream \case
  Maybe ByteString
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Just ByteString
b -> do
    ByteString -> IO ByteString
g <- TVar (ByteString -> IO ByteString)
-> IO (ByteString -> IO ByteString)
forall a. TVar a -> IO a
readTVarIO TVar (ByteString -> IO ByteString)
f
    ByteString -> IO ByteString
g ByteString
b IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
c -> Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
c) OutputStream ByteString
s