-- |
-- Module: M.IO.Internal.EffectTypes
-- Description: Core networking effects for Minecraft protocol
-- License: BSD-3-Clause
--
-- This module defines the core effects used for networking in the Minecraft protocol
-- implementation. It provides bidirectional packet communication with compression and
-- encryption support.
module M.IO.Internal.EffectTypes
  ( -- * Core effect
    Talking (..),

    -- * Types
    Direction (..),
    Immediately (..),
    Op (..),
    ParserState (..),

    -- * Effect operations
    Talking',
    hear,
    hearU,
    hearA,
    say,

    -- * Configuration
    setcompression,
    setencryption,
    enter,
  )
where

import Control.DeepSeq
import Data.ByteString (ByteString)
import Data.Data
import Data.Hashable
import Data.Word
import Effectful
import Effectful.NonDet
import Effectful.State.Dynamic
import Effectful.TH
import GHC.Generics
import Language.Haskell.TH.Syntax (Lift)
import M.IO.Internal.Datagram
import M.Pack

-- | relative packet direction. Used to identify packet flow without
-- hardcoding client/server roles
data Direction = Inbound | Outbound
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Direction
readsPrec :: Int -> ReadS Direction
$creadList :: ReadS [Direction]
readList :: ReadS [Direction]
$creadPrec :: ReadPrec Direction
readPrec :: ReadPrec Direction
$creadListPrec :: ReadPrec [Direction]
readListPrec :: ReadPrec [Direction]
Read, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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 :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Direction -> Direction
succ :: Direction -> Direction
$cpred :: Direction -> Direction
pred :: Direction -> Direction
$ctoEnum :: Int -> Direction
toEnum :: Int -> Direction
$cfromEnum :: Direction -> Int
fromEnum :: Direction -> Int
$cenumFrom :: Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
Enum, Direction
Direction -> Direction -> Bounded Direction
forall a. a -> a -> Bounded a
$cminBound :: Direction
minBound :: Direction
$cmaxBound :: Direction
maxBound :: Direction
Bounded, Typeable Direction
Typeable Direction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Direction -> c Direction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Direction)
-> (Direction -> Constr)
-> (Direction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Direction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction))
-> ((forall b. Data b => b -> b) -> Direction -> Direction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Direction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Direction -> r)
-> (forall u. (forall d. Data d => d -> u) -> Direction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Direction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Direction -> m Direction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Direction -> m Direction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Direction -> m Direction)
-> Data Direction
Direction -> Constr
Direction -> DataType
(forall b. Data b => b -> b) -> Direction -> Direction
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) -> Direction -> u
forall u. (forall d. Data d => d -> u) -> Direction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
$ctoConstr :: Direction -> Constr
toConstr :: Direction -> Constr
$cdataTypeOf :: Direction -> DataType
dataTypeOf :: Direction -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
$cgmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
gmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
Data, Typeable, (forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Direction -> Rep Direction x
from :: forall x. Direction -> Rep Direction x
$cto :: forall x. Rep Direction x -> Direction
to :: forall x. Rep Direction x -> Direction
Generic, (forall (m :: * -> *). Quote m => Direction -> m Exp)
-> (forall (m :: * -> *). Quote m => Direction -> Code m Direction)
-> Lift Direction
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Direction -> m Exp
forall (m :: * -> *). Quote m => Direction -> Code m Direction
$clift :: forall (m :: * -> *). Quote m => Direction -> m Exp
lift :: forall (m :: * -> *). Quote m => Direction -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Direction -> Code m Direction
liftTyped :: forall (m :: * -> *). Quote m => Direction -> Code m Direction
Lift)
  deriving (Eq Direction
Eq Direction =>
(Int -> Direction -> Int)
-> (Direction -> Int) -> Hashable Direction
Int -> Direction -> Int
Direction -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Direction -> Int
hashWithSalt :: Int -> Direction -> Int
$chash :: Direction -> Int
hash :: Direction -> Int
Hashable, Direction -> ()
(Direction -> ()) -> NFData Direction
forall a. (a -> ()) -> NFData a
$crnf :: Direction -> ()
rnf :: Direction -> ()
NFData)

-- | urgency level for receiving packets
data Immediately = Immediately | Eventually
  deriving (Immediately -> Immediately -> Bool
(Immediately -> Immediately -> Bool)
-> (Immediately -> Immediately -> Bool) -> Eq Immediately
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Immediately -> Immediately -> Bool
== :: Immediately -> Immediately -> Bool
$c/= :: Immediately -> Immediately -> Bool
/= :: Immediately -> Immediately -> Bool
Eq, Int -> Immediately -> ShowS
[Immediately] -> ShowS
Immediately -> String
(Int -> Immediately -> ShowS)
-> (Immediately -> String)
-> ([Immediately] -> ShowS)
-> Show Immediately
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Immediately -> ShowS
showsPrec :: Int -> Immediately -> ShowS
$cshow :: Immediately -> String
show :: Immediately -> String
$cshowList :: [Immediately] -> ShowS
showList :: [Immediately] -> ShowS
Show, ReadPrec [Immediately]
ReadPrec Immediately
Int -> ReadS Immediately
ReadS [Immediately]
(Int -> ReadS Immediately)
-> ReadS [Immediately]
-> ReadPrec Immediately
-> ReadPrec [Immediately]
-> Read Immediately
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Immediately
readsPrec :: Int -> ReadS Immediately
$creadList :: ReadS [Immediately]
readList :: ReadS [Immediately]
$creadPrec :: ReadPrec Immediately
readPrec :: ReadPrec Immediately
$creadListPrec :: ReadPrec [Immediately]
readListPrec :: ReadPrec [Immediately]
Read, Eq Immediately
Eq Immediately =>
(Immediately -> Immediately -> Ordering)
-> (Immediately -> Immediately -> Bool)
-> (Immediately -> Immediately -> Bool)
-> (Immediately -> Immediately -> Bool)
-> (Immediately -> Immediately -> Bool)
-> (Immediately -> Immediately -> Immediately)
-> (Immediately -> Immediately -> Immediately)
-> Ord Immediately
Immediately -> Immediately -> Bool
Immediately -> Immediately -> Ordering
Immediately -> Immediately -> Immediately
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 :: Immediately -> Immediately -> Ordering
compare :: Immediately -> Immediately -> Ordering
$c< :: Immediately -> Immediately -> Bool
< :: Immediately -> Immediately -> Bool
$c<= :: Immediately -> Immediately -> Bool
<= :: Immediately -> Immediately -> Bool
$c> :: Immediately -> Immediately -> Bool
> :: Immediately -> Immediately -> Bool
$c>= :: Immediately -> Immediately -> Bool
>= :: Immediately -> Immediately -> Bool
$cmax :: Immediately -> Immediately -> Immediately
max :: Immediately -> Immediately -> Immediately
$cmin :: Immediately -> Immediately -> Immediately
min :: Immediately -> Immediately -> Immediately
Ord, Int -> Immediately
Immediately -> Int
Immediately -> [Immediately]
Immediately -> Immediately
Immediately -> Immediately -> [Immediately]
Immediately -> Immediately -> Immediately -> [Immediately]
(Immediately -> Immediately)
-> (Immediately -> Immediately)
-> (Int -> Immediately)
-> (Immediately -> Int)
-> (Immediately -> [Immediately])
-> (Immediately -> Immediately -> [Immediately])
-> (Immediately -> Immediately -> [Immediately])
-> (Immediately -> Immediately -> Immediately -> [Immediately])
-> Enum Immediately
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Immediately -> Immediately
succ :: Immediately -> Immediately
$cpred :: Immediately -> Immediately
pred :: Immediately -> Immediately
$ctoEnum :: Int -> Immediately
toEnum :: Int -> Immediately
$cfromEnum :: Immediately -> Int
fromEnum :: Immediately -> Int
$cenumFrom :: Immediately -> [Immediately]
enumFrom :: Immediately -> [Immediately]
$cenumFromThen :: Immediately -> Immediately -> [Immediately]
enumFromThen :: Immediately -> Immediately -> [Immediately]
$cenumFromTo :: Immediately -> Immediately -> [Immediately]
enumFromTo :: Immediately -> Immediately -> [Immediately]
$cenumFromThenTo :: Immediately -> Immediately -> Immediately -> [Immediately]
enumFromThenTo :: Immediately -> Immediately -> Immediately -> [Immediately]
Enum, Immediately
Immediately -> Immediately -> Bounded Immediately
forall a. a -> a -> Bounded a
$cminBound :: Immediately
minBound :: Immediately
$cmaxBound :: Immediately
maxBound :: Immediately
Bounded, Typeable Immediately
Typeable Immediately =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Immediately -> c Immediately)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Immediately)
-> (Immediately -> Constr)
-> (Immediately -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Immediately))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Immediately))
-> ((forall b. Data b => b -> b) -> Immediately -> Immediately)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Immediately -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Immediately -> r)
-> (forall u. (forall d. Data d => d -> u) -> Immediately -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Immediately -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Immediately -> m Immediately)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Immediately -> m Immediately)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Immediately -> m Immediately)
-> Data Immediately
Immediately -> Constr
Immediately -> DataType
(forall b. Data b => b -> b) -> Immediately -> Immediately
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) -> Immediately -> u
forall u. (forall d. Data d => d -> u) -> Immediately -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Immediately -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Immediately -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Immediately
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Immediately -> c Immediately
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Immediately)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Immediately)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Immediately -> c Immediately
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Immediately -> c Immediately
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Immediately
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Immediately
$ctoConstr :: Immediately -> Constr
toConstr :: Immediately -> Constr
$cdataTypeOf :: Immediately -> DataType
dataTypeOf :: Immediately -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Immediately)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Immediately)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Immediately)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Immediately)
$cgmapT :: (forall b. Data b => b -> b) -> Immediately -> Immediately
gmapT :: (forall b. Data b => b -> b) -> Immediately -> Immediately
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Immediately -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Immediately -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Immediately -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Immediately -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Immediately -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Immediately -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Immediately -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Immediately -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Immediately -> m Immediately
Data, Typeable, (forall x. Immediately -> Rep Immediately x)
-> (forall x. Rep Immediately x -> Immediately)
-> Generic Immediately
forall x. Rep Immediately x -> Immediately
forall x. Immediately -> Rep Immediately x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Immediately -> Rep Immediately x
from :: forall x. Immediately -> Rep Immediately x
$cto :: forall x. Rep Immediately x -> Immediately
to :: forall x. Rep Immediately x -> Immediately
Generic, (forall (m :: * -> *). Quote m => Immediately -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Immediately -> Code m Immediately)
-> Lift Immediately
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Immediately -> m Exp
forall (m :: * -> *). Quote m => Immediately -> Code m Immediately
$clift :: forall (m :: * -> *). Quote m => Immediately -> m Exp
lift :: forall (m :: * -> *). Quote m => Immediately -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Immediately -> Code m Immediately
liftTyped :: forall (m :: * -> *). Quote m => Immediately -> Code m Immediately
Lift)
  deriving (Eq Immediately
Eq Immediately =>
(Int -> Immediately -> Int)
-> (Immediately -> Int) -> Hashable Immediately
Int -> Immediately -> Int
Immediately -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Immediately -> Int
hashWithSalt :: Int -> Immediately -> Int
$chash :: Immediately -> Int
hash :: Immediately -> Int
Hashable, Immediately -> ()
(Immediately -> ()) -> NFData Immediately
forall a. (a -> ()) -> NFData a
$crnf :: Immediately -> ()
rnf :: Immediately -> ()
NFData)

-- | operations on a packet
data Op r where
  -- | parse any packet
  Parse :: Uninterpreted %1 -> Op SomeUnpack
  -- | find code of a packet based on its 'TypeRep'
  Code :: Direction %1 -> TypeRep %1 -> Op (Maybe Word8)
  deriving (Typeable)

instance Show (Op r) where
  show :: Op r -> String
show = \case
    Parse Uninterpreted
u -> String
"Parse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Uninterpreted -> String
forall a. Show a => a -> String
show Uninterpreted
u
    Code Direction
d TypeRep
t -> String
"Code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Direction -> String
forall a. Show a => a -> String
show Direction
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
t

instance Eq (Op r) where
  Parse Uninterpreted
u == :: Op r -> Op r -> Bool
== Parse Uninterpreted
u' = Uninterpreted
u Uninterpreted -> Uninterpreted -> Bool
forall a. Eq a => a -> a -> Bool
== Uninterpreted
u'
  Code Direction
d TypeRep
t == Code Direction
d' TypeRep
t' = Direction
d Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
d' Bool -> Bool -> Bool
&& TypeRep
t TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep
t'

instance Ord (Op r) where
  compare :: Op r -> Op r -> Ordering
compare (Parse Uninterpreted
u) (Parse Uninterpreted
u') = Uninterpreted -> Uninterpreted -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Uninterpreted
u Uninterpreted
u'
  compare (Code Direction
d TypeRep
t) (Code Direction
d' TypeRep
t') = (Direction, TypeRep) -> (Direction, TypeRep) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Direction
d, TypeRep
t) (Direction
d', TypeRep
t')

instance Hashable (Op r) where
  hashWithSalt :: Int -> Op r -> Int
hashWithSalt Int
s (Parse Uninterpreted
u) = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) Int -> Uninterpreted -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Uninterpreted
u
  hashWithSalt Int
s (Code Direction
d TypeRep
t) =
    Int
s
      Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int)
      Int -> Direction -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Direction
d
      Int -> TypeRep -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` TypeRep
t

instance NFData (Op r) where
  rnf :: Op r -> ()
rnf = \case
    Parse Uninterpreted
u -> Uninterpreted -> ()
forall a. NFData a => a -> ()
rnf Uninterpreted
u
    Code Direction
d TypeRep
t -> Direction -> ()
forall a. NFData a => a -> ()
rnf Direction
d () -> () -> ()
forall a b. a -> b -> b
`seq` TypeRep -> ()
forall a. NFData a => a -> ()
rnf TypeRep
t

-- | parser state object (as in object-oriented programming)
newtype ParserState = ParserState
  { -- | send a \"message\" to the parser state and get a response
    ParserState -> forall r. Op r -> r
send2parserstate :: forall r. Op r -> r
  }

-- | the communication effect
data Talking :: Effect where
  -- | listen for a message and assert its type
  --
  -- when immediately is set and message missing, invoke 'Empty'
  Hear :: (Unpack a, Typeable a) => Immediately -> Talking m a
  -- | listen for a raw uninterpreted message
  --
  -- when immediately is set and message missing, invoke 'Empty'
  HearU :: Immediately -> Talking m Uninterpreted
  -- | listen for a message with dynamic unpacking
  --
  -- when immediately is set and message missing, invoke 'Empty'
  HearA :: Immediately -> Talking m SomeUnpack
  -- | send a message
  Say :: (Pack a, Typeable a) => a -> Talking m ()
  -- | set the compression threshold
  --
  -- - non-negative: compress messages larger than this size
  -- - negative: disable compression
  Setcompression :: Int -> Talking m ()
  -- | set the encryption key
  Setencryption :: ByteString -> Talking m ()

makeEffect ''Talking

-- | the communication effect with parser state and non-determinism
type Talking' es = (Talking :> es, State ParserState :> es, NonDet :> es)

-- | enter the parser state
enter :: (State ParserState :> es) => ParserState -> Eff es ()
enter :: forall (es :: [Effect]).
(State ParserState :> es) =>
ParserState -> Eff es ()
enter = ParserState -> Eff es ()
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
s -> Eff es ()
put
{-# INLINE enter #-}