dependent-sum based CryptoMessage.

5 files changed, 332 insertions, 169 deletions

diff --git a/src/Data/Tox/Message.hs b/src/Data/Tox/Message.hs
index b77307a2..9f1ce339 100644
--- a/src/Data/Tox/Message.hs
+++ b/src/Data/Tox/Message.hs
@@ -31,7 +31,8 @@ pattern MSI                  = MessageID  69
 pattern FILE_SENDREQUEST     = MessageID  80 -- 1+1+4+8+32+max255 = up to 301
 pattern FILE_CONTROL         = MessageID  81 -- 8 bytes if seek, otherwise 4
 pattern FILE_DATA            = MessageID  82 -- up to 1373
-pattern INVITE_GROUPCHAT     = MessageID  96 -- 0x60
+pattern INVITE_GROUPCHAT     = MessageID  95
+pattern INVITE_GROUPCHAT0    = MessageID  96 -- 0x60
 -- TODO: rename to INVITE_CONFERENCE 96
 pattern ONLINE_PACKET        = MessageID  97 -- 0x61
 pattern DIRECT_GROUPCHAT     = MessageID  98 -- 0x62
diff --git a/src/Data/Tox/Msg.hs b/src/Data/Tox/Msg.hs
new file mode 100644
index 00000000..84fffb12
--- /dev/null
+++ b/src/Data/Tox/Msg.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DefaultSignatures     #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds             #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module Data.Tox.Msg where
+
+import Data.ByteString       as B
+import Data.Dependent.Sum
+import Data.GADT.Compare
+import Data.GADT.Show
+import Data.Functor.Identity
+import Data.Serialize
+import Data.Text             as T
+import Data.Text.Encoding    as T
+import Data.Typeable
+import Data.Word
+import GHC.TypeLits
+
+import Crypto.Tox
+import Data.PacketBuffer (compressSequenceNumbers, decompressSequenceNumbers)
+
+newtype Unknown = Unknown B.ByteString deriving (Eq,Show)
+newtype Padded  = Padded  B.ByteString deriving (Eq,Show)
+
+-- The 'UserStatus' equivalent in Presence is:
+--
+-- data JabberShow = Offline
+--                 | ExtendedAway
+--                 | Away           -- Tox equiv: Away (1)
+--                 | DoNotDisturb   -- Tox equiv: Busy (2)
+--                 | Available      -- Tox equiv: Online (0)
+--                 | Chatty
+--  deriving (Show,Enum,Ord,Eq,Read)
+--
+-- The Enum instance on 'UserStatus' is not arbitrary.  It corresponds
+-- to on-the-wire id numbers.
+data UserStatus = Online | Away | Busy deriving (Show,Read,Eq,Ord,Enum)
+
+instance Serialize UserStatus where
+   get = do
+        x <- get :: Get Word8
+        return (toEnum8 x)
+   put x = put (fromEnum8 x)
+
+
+newtype MissingPackets = MissingPackets [Word32]
+ deriving (Eq,Show)
+
+data Msg (n :: Nat) t where
+    Padding            :: Msg 0 Padded
+    PacketRequest      :: Msg 1 MissingPackets
+    KillPacket         :: Msg 2 ()
+    ALIVE              :: Msg 16 ()
+    SHARE_RELAYS       :: Msg 17 Unknown
+    FRIEND_REQUESTS    :: Msg 18 Unknown
+    ONLINE             :: Msg 24 ()
+    OFFLINE            :: Msg 25 ()
+    NICKNAME           :: Msg 48 Text
+    STATUSMESSAGE      :: Msg 49 Text
+    USERSTATUS         :: Msg 50 UserStatus
+    TYPING             :: Msg 51 Bool
+    MESSAGE            :: Msg 64 Text
+    ACTION             :: Msg 65 Text
+    MSI                :: Msg 69 Unknown
+    FILE_SENDREQUEST   :: Msg 80 Unknown
+    FILE_CONTROL       :: Msg 81 Unknown
+    FILE_DATA          :: Msg 82 Unknown
+    INVITE_GROUPCHAT   :: Msg 95 Unknown
+    INVITE_CONFERENCE  :: Msg 96 Unknown
+    ONLINE_PACKET      :: Msg 97 Unknown
+    DIRECT_CONFERENCE  :: Msg 98 Unknown
+    MESSAGE_CONFERENCE :: Msg 99 Unknown
+    LOSSY_CONFERENCE   :: Msg 199 Unknown
+
+deriving instance Show (Msg n a)
+
+msgbyte :: KnownNat n => Msg n a -> Word8
+msgbyte m = fromIntegral (natVal $ proxy m)
+ where proxy :: Msg n a -> Proxy n
+       proxy _ = Proxy
+
+data Pkt a where Pkt :: (KnownNat n, Packet a, KnownMsg n) => Msg n a -> Pkt a
+
+deriving instance (Show (Pkt a))
+
+type CryptoMessage = DSum Pkt Identity
+
+msgID (Pkt mid :=> Identity _) = M mid
+
+-- TODO
+instance GShow Pkt where gshowsPrec = showsPrec
+instance ShowTag Pkt Identity where
+    showTaggedPrec (Pkt _) = showsPrec
+
+instance GEq Pkt where geq (Pkt _) (Pkt _) = eqT
+instance EqTag Pkt Identity where eqTagged (Pkt _) (Pkt _) = (==)
+
+someMsgVal :: KnownMsg n => Msg n a -> SomeMsg
+someMsgVal m = msgid (proxy m)
+ where proxy :: Msg n a -> Proxy n
+       proxy _ = Proxy
+
+class KnownMsg (n::Nat) where msgid :: proxy n -> SomeMsg
+
+instance KnownMsg 0  where msgid _ = M Padding
+instance KnownMsg 1  where msgid _ = M PacketRequest
+instance KnownMsg 2  where msgid _ = M KillPacket
+instance KnownMsg 16 where msgid _ = M ALIVE
+instance KnownMsg 17 where msgid _ = M SHARE_RELAYS
+instance KnownMsg 18 where msgid _ = M FRIEND_REQUESTS
+instance KnownMsg 24 where msgid _ = M ONLINE
+instance KnownMsg 25 where msgid _ = M OFFLINE
+instance KnownMsg 48 where msgid _ = M NICKNAME
+instance KnownMsg 49 where msgid _ = M STATUSMESSAGE
+instance KnownMsg 50 where msgid _ = M USERSTATUS
+instance KnownMsg 51 where msgid _ = M TYPING
+instance KnownMsg 64 where msgid _ = M MESSAGE
+instance KnownMsg 65 where msgid _ = M ACTION
+instance KnownMsg 69 where msgid _ = M MSI
+instance KnownMsg 80 where msgid _ = M FILE_SENDREQUEST
+instance KnownMsg 81 where msgid _ = M FILE_CONTROL
+instance KnownMsg 82 where msgid _ = M FILE_DATA
+instance KnownMsg 95 where msgid _ = M INVITE_GROUPCHAT
+instance KnownMsg 96 where msgid _ = M INVITE_CONFERENCE
+instance KnownMsg 97 where msgid _ = M ONLINE_PACKET
+instance KnownMsg 98 where msgid _ = M DIRECT_CONFERENCE
+instance KnownMsg 99 where msgid _ = M MESSAGE_CONFERENCE
+
+msgTag :: Word8 -> Maybe SomeMsg
+msgTag 0  = Just $ M Padding
+msgTag 1  = Just $ M PacketRequest
+msgTag 2  = Just $ M KillPacket
+msgTag 16 = Just $ M ALIVE
+msgTag 17 = Just $ M SHARE_RELAYS
+msgTag 18 = Just $ M FRIEND_REQUESTS
+msgTag 24 = Just $ M ONLINE
+msgTag 25 = Just $ M OFFLINE
+msgTag 48 = Just $ M NICKNAME
+msgTag 49 = Just $ M STATUSMESSAGE
+msgTag 50 = Just $ M USERSTATUS
+msgTag 51 = Just $ M TYPING
+msgTag 64 = Just $ M MESSAGE
+msgTag 65 = Just $ M ACTION
+msgTag 69 = Just $ M MSI
+msgTag 80 = Just $ M FILE_SENDREQUEST
+msgTag 81 = Just $ M FILE_CONTROL
+msgTag 82 = Just $ M FILE_DATA
+msgTag 95 = Just $ M INVITE_GROUPCHAT
+msgTag 96 = Just $ M INVITE_CONFERENCE
+msgTag 97 = Just $ M ONLINE_PACKET
+msgTag 98 = Just $ M DIRECT_CONFERENCE
+msgTag 99 = Just $ M MESSAGE_CONFERENCE
+msgTag _  = Nothing
+
+
+class (Typeable t, Eq t, Show t, Sized t) => Packet t where
+    getPacket :: Word32 -> Get t
+    putPacket :: Word32 -> t -> Put
+    default getPacket :: Serialize t => Word32 -> Get t
+    getPacket _ = get
+    default putPacket :: Serialize t => Word32 -> t -> Put
+    putPacket _ t = put t
+
+instance Sized UserStatus where size = ConstSize 1
+instance Packet UserStatus
+
+instance Sized () where size = ConstSize 0
+instance Packet () where
+    getPacket _ = return ()
+    putPacket _ _ = return ()
+
+instance Sized MissingPackets where size = VarSize $ \(MissingPackets ws) -> Prelude.length ws
+instance Packet MissingPackets where
+    getPacket seqno = do
+        bs <- B.unpack <$> (remaining >>= getBytes)
+        return $ MissingPackets (decompressSequenceNumbers seqno bs)
+    putPacket seqno (MissingPackets ws) = do
+        mapM_ putWord8 $ compressSequenceNumbers seqno ws
+
+instance Sized Unknown where size = VarSize $ \(Unknown bs) -> B.length bs
+instance Packet Unknown where
+    getPacket _ = Unknown <$> (remaining >>= getBytes)
+    putPacket _ (Unknown bs) = putByteString bs
+
+instance Sized Padded where size = VarSize $ \(Padded bs) -> B.length bs
+instance Packet Padded where
+    getPacket _ = Padded <$> (remaining >>= getBytes)
+    putPacket _ (Padded bs) = putByteString bs
+
+instance Sized Text where size = VarSize (B.length . T.encodeUtf8)
+instance Packet Text where
+    getPacket _ = T.decodeUtf8 <$> (remaining >>= getBytes)
+    putPacket _ = putByteString . T.encodeUtf8
+
+instance Sized Bool where size = ConstSize 1
+instance Packet Bool where
+    getPacket _ = (/= 0) <$> getWord8
+    putPacket _ False = putWord8 0
+    putPacket _ True  = putWord8 1
+
+data SomeMsg where
+    M :: (KnownMsg n, KnownNat n, Packet t) => Msg n t -> SomeMsg
+
+instance Eq SomeMsg where
+    M m == M n  = msgbyte m == msgbyte n
+
+instance Show SomeMsg where
+    show (M m) = show m
+
+toEnum8 :: (Enum a, Integral word8) => word8 -> a
+toEnum8 = toEnum . fromIntegral
+
+fromEnum8 :: Enum a => a -> Word8
+fromEnum8 = fromIntegral . fromEnum
+
+data LossyOrLossless = Lossless | Lossy deriving (Eq,Ord,Enum,Show,Bounded)
+
+someLossyness (M m) = lossyness m
+
+lossyness :: KnownNat n => Msg n t -> LossyOrLossless
+lossyness m = case msgbyte m of
+    x | x < 3                -> Lossy
+      | {-16 <= x,-} x < 192 -> Lossless
+      | 192 <= x, x < 255    -> Lossy
+      | otherwise            -> Lossless
+
diff --git a/src/Network/Tox/AggregateSession.hs b/src/Network/Tox/AggregateSession.hs
index df16dc4e..8c728660 100644
--- a/src/Network/Tox/AggregateSession.hs
+++ b/src/Network/Tox/AggregateSession.hs
@@ -2,6 +2,7 @@
 -- single online/offline presence.  This allows multiple lossless links to the
 -- same identity at different addresses, or even to the same address.
 {-# LANGUAGE CPP             #-}
+{-# LANGUAGE GADTs           #-}
 {-# LANGUAGE LambdaCase      #-}
 {-# LANGUAGE PatternSynonyms #-}
 module Network.Tox.AggregateSession
@@ -23,6 +24,7 @@ module Network.Tox.AggregateSession
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TMChan
 import Control.Monad
+import Data.Dependent.Sum
 import Data.Function
 import qualified Data.IntMap.Strict  as IntMap
          ;import Data.IntMap.Strict  (IntMap)
@@ -39,13 +41,12 @@ import GHC.Conc                  (labelThread)
 
 import Connection                   (Status (..))
 import Crypto.Tox                   (PublicKey, toPublic)
+import Data.Tox.Msg
 import Data.Wrapper.PSQInt          as PSQ
 import DPut
 import DebugTag
 import Network.QueryResponse
-import Network.Tox.Crypto.Transport (CryptoMessage (..), pattern KillPacket,
-                                     pattern ONLINE, pattern PING,
-                                     pattern PacketRequest)
+import Network.Tox.Crypto.Transport
 import Network.Tox.DHT.Transport    (key2id)
 import Network.Tox.NodeId           (ToxProgress (..))
 import Network.Tox.Session
@@ -122,17 +123,17 @@ keepAlive s q = do
                          , take 8 $ show $ key2id $ sTheirUserKey s
                          , show $ sSessionID s])
 
-    let outPrint e   = dput XNetCrypto  $ shows (sSessionID s,sTheirAddr s) $ " <-- " ++ e
+    let -- outPrint e   = dput XNetCrypto  $ shows (sSessionID s,sTheirAddr s) $ " <-- " ++ e
         unexpected e = dput XUnexpected $ shows (sSessionID s,sTheirAddr s) $ " <-- " ++ e
 
         doAlive = do
             -- outPrint $ "Beacon"
-            sendMessage (sTransport s) () (OneByte PING)
+            sendMessage (sTransport s) () (Pkt ALIVE ==> ())
 
         doRequestMissing = do
             (ns,nmin) <- sMissingInbound s
             -- outPrint $ "PacketRequest " ++ show (nmin,ns)
-            sendMessage (sTransport s) () (RequestResend PacketRequest ns)
+            sendMessage (sTransport s) () (Pkt PacketRequest ==> MissingPackets ns)
                 `catchIOError` \e -> do
                     unexpected $ "PacketRequest " ++ take 200 (show (nmin,length ns,ns))
                     unexpected $ "PacketRequest: " ++ show e
@@ -195,7 +196,7 @@ forkSession c s setStatus = forkIO $ do
 
     atomically $ setStatus $ InProgress AwaitingSessionPacket
     awaitPacket $ \_ (online,()) -> do
-        when (msgID online /= ONLINE) $ do
+        when (msgID online /= M ONLINE) $ do
             inPrint $ "Unexpected initial packet: " ++ show (msgID online)
         atomically $ do setStatus Established
                         sendPacket online
@@ -204,9 +205,9 @@ forkSession c s setStatus = forkIO $ do
         awaitPacket $ \awaitNext (x,()) -> do
             bump
             case msgID x of
-                PING       -> return ()
-                KillPacket -> sClose s
-                _          -> atomically $ sendPacket x
+                M ALIVE      -> return ()
+                M KillPacket -> sClose s
+                _            -> atomically $ sendPacket x
             awaitNext
         atomically $ setStatus Dormant
         killThread beacon
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index b79334d7..d1afaa38 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE GADTs              #-}
 {-# LANGUAGE KindSignatures     #-}
 {-# LANGUAGE LambdaCase         #-}
 {-# LANGUAGE NamedFieldPuns     #-}
@@ -12,7 +14,6 @@ module Network.Tox.Crypto.Transport
     , encodeCrypto
     , unpadCryptoMsg
     , decodeRawCryptoMsg
-    , createRequestPacket
     , parseHandshakes
     , encodeHandshakes
     , CryptoData(..)
@@ -22,7 +23,6 @@ module Network.Tox.Crypto.Transport
     , HandshakeData(..)
     , Handshake(..)
     , PeerInfo(..)
-    , module Data.Tox.Message
     , UserStatus(..)
     , TypingStatus(..)
     , GroupChatId(..)
@@ -43,13 +43,9 @@ module Network.Tox.Crypto.Transport
     , HasMessage(..)
     , HasMessageType(..)
     -- lenses
-    , userStatus, nick, statusMessage, typingStatus, action, groupChatID
     , groupNumber, groupNumberToJoin, peerNumber, messageNumber
     , messageName, messageData, name, title, message, messageType
     -- constructor
-    , msg
-    , leaveMsg
-    , peerQueryMsg
     -- utils
     , sizedN
     , sizedAtLeastN
@@ -57,19 +53,21 @@ module Network.Tox.Crypto.Transport
     , fromEnum8
     , fromEnum16
     , toEnum8
-    , msgSizeParam
     , getCryptoMessage
     , putCryptoMessage
-    , module Data.Tox.Message
     ) where
 
 import Crypto.Tox
-import Data.Tox.Message
+import Data.Tox.Msg
 import Network.Tox.DHT.Transport (Cookie)
 import Network.Tox.NodeId
+import DPut
+import DebugTag
+import Data.PacketBuffer as PB
 
 import Network.Socket
 import Data.ByteArray
+import Data.Dependent.Sum
 
 import Control.Monad
 import Data.ByteString as B
@@ -84,14 +82,10 @@ import Data.Text as T
 import Data.Text.Encoding as T
 import Data.Serialize as S
 import Control.Arrow
-import DPut
-import DebugTag
-import Data.PacketBuffer as PB
+import GHC.TypeNats
 
 showCryptoMsg :: Word32 -> CryptoMessage -> [Char]
-showCryptoMsg seqno (UpToN PacketRequest bytes) = "UpToN PacketRequest --> "
-                                                  ++ show (PB.decompressSequenceNumbers seqno $ B.unpack bytes)
-showCryptoMsg _     msg                         = show msg
+showCryptoMsg _  msg = show msg
 
 parseCrypto :: (ByteString, SockAddr) -> Either (CryptoPacket Encrypted, SockAddr) (ByteString, SockAddr)
 parseCrypto (bbs,saddr) = case B.uncons bbs of
@@ -110,6 +104,7 @@ parseHandshakes bs                            _     = Left $ "parseHandshakes_:
 encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr)
 encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr)
 
+{-
 createRequestPacket :: Word32 -> [Word32] -> CryptoMessage
 createRequestPacket seqno xs = let r = UpToN PacketRequest (B.pack ns)
                                    in dtrace XNetCrypto ("createRequestPacket " ++ show seqno ++ " " ++ show xs ++ " -----> " ++ show r) r
@@ -125,6 +120,7 @@ createRequestPacket seqno xs = let r = UpToN PacketRequest (B.pack ns)
                   in zeros ++ [m]
         ns :: [Word8]
         ns = Prelude.map fromIntegral (reduceToSums ys >>= makeZeroes)
+-}
 
 data Handshake (f :: * -> *) = Handshake
     { -- The cookie is a cookie obtained by
@@ -247,25 +243,6 @@ instance Serialize CryptoData where
         put seqno
         putCryptoMessage ack dta
 
--- The 'UserStatus' equivalent in Presence is:
---
--- data JabberShow = Offline
---                 | ExtendedAway
---                 | Away           -- Tox equiv: Away (1)
---                 | DoNotDisturb   -- Tox equiv: Busy (2)
---                 | Available      -- Tox equiv: Online (0)
---                 | Chatty
---  deriving (Show,Enum,Ord,Eq,Read)
---
--- The Enum instance on 'UserStatus' is not arbitrary.  It corresponds
--- to on-the-wire id numbers.
-data UserStatus = Online | Away | Busy deriving (Show,Read,Eq,Ord,Enum)
-instance Serialize UserStatus where
-   get = do
-        x <- get :: Get Word8
-        return (toEnum8 x)
-   put x = put (fromEnum8 x)
-
 data TypingStatus = NotTyping | Typing deriving (Show,Read,Eq,Ord,Enum)
 instance Serialize TypingStatus where
    get = do
@@ -274,114 +251,41 @@ instance Serialize TypingStatus where
    put x = put (fromEnum8 x :: Word8)
 
 unpadCryptoMsg :: CryptoMessage -> CryptoMessage
-unpadCryptoMsg x@(TwoByte Padding (toEnum8 -> mid))
-    | msgSizeParam mid == Just (True,0) = OneByte mid
-unpadCryptoMsg x@(UpToN mid0 (B.dropWhile (==0) -> B.uncons -> Just (toEnum8 -> mid,bytes)))
-    | mid0 == Padding
-        = case msgSizeParam mid of
-            Just (True,0)  -> OneByte mid
-            Just (True,1)  -> TwoByte mid (B.head bytes)
-            _ -> UpToN mid bytes
-unpadCryptoMsg x = x
+unpadCryptoMsg msg@(Pkt Padding :=> Identity (Padded bs)) =
+    let unpadded = B.dropWhile (== msgbyte Padding) bs
+    in either (const msg) id $ runGet (getCryptoMessage 0) unpadded
+unpadCryptoMsg msg = msg
 
 decodeRawCryptoMsg :: CryptoData -> CryptoMessage
-decodeRawCryptoMsg (CryptoData ack seqno cm) =
-    let cm' = unpadCryptoMsg cm
-    in case msgID cm' of
-        PacketRequest -> RequestResend PacketRequest $ decompressSequenceNumbers ack $ msgByteList cm'
-        _             -> cm'
-
-data CryptoMessage
-        = OneByte  { msgID :: MessageID }
-        | TwoByte  { msgID :: MessageID, msgByte  :: Word8 }
-        | UpToN    { msgID :: MessageID, msgBytes :: ByteString } -- length < N
-          -- | TODO: The msgID field is redundant in this case and can be removed
-          -- after all uses are audited.
-        | RequestResend { msgID :: MessageID, requested :: [Word32] }
-    deriving (Eq,Show)
-
-msgByteList :: CryptoMessage -> [Word8]
-msgByteList (UpToN _ bs)  = B.unpack bs
-msgByteList (TwoByte _ b) = [b]
-msgByteList (OneByte _)   = []
+decodeRawCryptoMsg (CryptoData ack seqno cm) = unpadCryptoMsg cm
 
 instance Sized CryptoMessage where
     size = VarSize $ \case
-        OneByte {}                       -> 1
-        TwoByte {}                       -> 2
-        UpToN { msgBytes = bs }          -> 1 + B.length bs
-        RequestResend { requested = ws } -> 1 + Prelude.length ws
+        Pkt t :=> Identity x -> case sizeFor t of
+            ConstSize sz -> 1 + sz
+            VarSize   f  -> 1 + f x
+
+sizeFor :: Sized x => p x -> Size x
+sizeFor _ = size
+
 
 getCryptoMessage :: Word32 -> Get CryptoMessage
 getCryptoMessage seqno = do
-        i <- get :: Get MessageID
-        n <- remaining
-        pkt <- case msgSizeParam i of
-            Just (True,0) -> return $ OneByte i
-            Just (True,1) -> TwoByte i <$> get
-            _ -> UpToN i <$> getByteString n
-        return $ if msgID pkt == PacketRequest
-                  then RequestResend PacketRequest $ decompressSequenceNumbers seqno $ msgByteList pkt
-                  else pkt
+        t <- getWord8
+        case msgTag t of
+            Just (M msg) -> do x <- getPacket seqno
+                               return $ Pkt msg ==> x
+            Nothing      -> return $ Pkt Padding ==> Padded mempty
 
 putCryptoMessage :: Word32 -> CryptoMessage -> Put
-putCryptoMessage seqno (OneByte i)   = putWord8 (fromIntegral . fromEnum $ i)
-putCryptoMessage seqno (TwoByte i b) = do putWord8 (fromIntegral . fromEnum $ i)
-                                          putWord8 b
-putCryptoMessage seqno (UpToN i x)   = do putWord8 (fromIntegral . fromEnum $ i)
-                                          putByteString x
-putCryptoMessage seqno (RequestResend _ ws) = do
-    putWord8 (fromIntegral . fromEnum $ PacketRequest)
-    mapM_ putWord8 $ compressSequenceNumbers seqno ws
-
-instance Serialize MessageID where
-    get = toEnum . fromIntegral <$> getWord8
-    put x = putWord8 (fromIntegral . fromEnum $ x)
-    
+putCryptoMessage seqno (Pkt t :=> Identity x) = do
+    putWord8 (msgbyte t)
+    putPacket seqno x
+
+
 erCompat :: String -> a
 erCompat lens = error $ "Use of '" ++ lens ++ "'  lens on incompatible CryptoMessage type"
 
-typingStatus :: Functor f => (UserStatus -> f UserStatus)-> (CryptoMessage -> f CryptoMessage)
-typingStatus = lens getter setter
-  where
-    getter :: CryptoMessage -> UserStatus
-    getter (TwoByte TYPING status) = toEnum $ fromIntegral status
-    getter _                       = erCompat "typingStatus"
-    setter :: CryptoMessage -> UserStatus -> CryptoMessage
-    setter (TwoByte TYPING _) status = TwoByte TYPING (fromIntegral . fromEnum $ status)
-    setter _ _                       = erCompat "typingStatus"
-
-userStatus :: Functor f => (UserStatus -> f UserStatus)-> (CryptoMessage -> f CryptoMessage)
-userStatus = lens getter setter
-  where
-    getter (TwoByte USERSTATUS status) = toEnum $ fromIntegral status
-    getter _                           = erCompat "userStatus"
-    setter (TwoByte USERSTATUS _) status = TwoByte USERSTATUS (fromIntegral . fromEnum $ status)
-    setter _ _                           = erCompat "userStatus"
-
-nick :: Functor f => (Text -> f Text)-> (CryptoMessage -> f CryptoMessage)
-nick = lens getter setter
-  where
-    getter (UpToN NICKNAME bstr) = T.decodeUtf8 bstr
-    getter _                     = erCompat "nick"
-    setter (UpToN NICKNAME _) nick = UpToN NICKNAME (T.encodeUtf8 $ nick)
-    setter _ _                     = erCompat "nick"
-
-statusMessage :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage)
-statusMessage = lens getter setter
-  where
-    getter (UpToN STATUSMESSAGE bstr) = T.unpack $ T.decodeUtf8 bstr
-    getter _                          = erCompat "statusMessage"
-    setter (UpToN STATUSMESSAGE _) nick = UpToN STATUSMESSAGE (T.encodeUtf8 . T.pack $ nick)
-    setter _ _                          = erCompat "statusMessage"
-
-action :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage)
-action = lens getter setter
-  where
-    getter (UpToN ACTION bstr) = T.unpack $ T.decodeUtf8 bstr
-    getter _                     = erCompat "action"
-    setter (UpToN ACTION _) action = UpToN ACTION (T.encodeUtf8 . T.pack $ action)
-    setter _ _                     = erCompat "action"
 
 newtype GroupChatId = GrpId ByteString -- 33 bytes
     deriving (Show,Eq)
@@ -398,9 +302,10 @@ sizedAtLeastN :: Int -> ByteString -> ByteString
 sizedAtLeastN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0)
                                         else bs
 
+{-
 instance HasGroupChatID CryptoMessage where
     -- Get
-    getGroupChatID (UpToN INVITE_GROUPCHAT payload)
+    getGroupChatID (Pkt INVITE_CONFERENCE :=> Identity payload)
         = let (xs,ys) = B.splitAt 1 payload'
               payload' = sizedN 38 payload
               in case B.unpack xs of
@@ -408,11 +313,11 @@ instance HasGroupChatID CryptoMessage where
                     [isResponse] | 1 <- isResponse -> GrpId (B.take 33 $ B.drop 4 ys) -- skip two group numbers
                     _ -> GrpId "" -- error "Unexpected value in INVITE_GROUPCHAT message"
 
-    getGroupChatID (UpToN ONLINE_PACKET payload) = GrpId (B.take 33 $ B.drop 2 (sizedN 35 payload))
+    getGroupChatID (Pkt ONLINE_PACKET :=> Identity payload) = GrpId (B.take 33 $ B.drop 2 (sizedN 35 payload))
     getGroupChatID _ = error "getGroupChatID on non-groupchat message."
 
     -- Set
-    setGroupChatID msg@(UpToN INVITE_GROUPCHAT  payload) (GrpId newid)
+    setGroupChatID msg@(Pkt INVITE_CONFERENCE :=> Identity payload) (GrpId newid)
         = let (xs,ys) = B.splitAt 1 payload'
               payload' = sizedN 38 payload
               in case B.unpack xs of
@@ -420,8 +325,9 @@ instance HasGroupChatID CryptoMessage where
                     [isResponse] | 1 <- isResponse -> UpToN INVITE_GROUPCHAT (B.concat [xs, (B.take 4 ys), sizedN 33 newid]) -- keep two group numbers
                     _ -> msg -- unexpected condition, leave unchanged
 
-    setGroupChatID (UpToN ONLINE_PACKET payload) (GrpId newid) = UpToN ONLINE_PACKET (B.concat [B.take 2 payload, sizedN 33 newid])
+    setGroupChatID (Pkt ONLINE_PACKET :=> Identity payload) (GrpId newid) = Pkt ONLINE_PACKET ==> (B.concat [B.take 2 payload, sizedN 33 newid])
     setGroupChatID _ _= error "setGroupChatID on non-groupchat message."
+-}
 
 groupChatID :: (Functor f, HasGroupChatID x) => (GroupChatId -> f GroupChatId) -> (x -> f x)
 groupChatID = lens getGroupChatID setGroupChatID
@@ -434,8 +340,9 @@ class HasGroupNumber x where
     getGroupNumber :: x -> GroupNumber
     setGroupNumber :: x -> GroupNumber -> x
 
+{-
 instance HasGroupNumber CryptoMessage where
-    getGroupNumber (UpToN INVITE_GROUPCHAT (sizedN 39 -> B.uncons -> Just (isResp,xs))) -- note isResp should be 0 or 1
+    getGroupNumber (Pkt INVITE_CONFERENCE :=> Identity (sizedN 39 -> B.uncons -> Just (isResp,xs))) -- note isResp should be 0 or 1
         = let twobytes = B.take 2 xs
               Right n = S.decode twobytes
               in n
@@ -452,6 +359,7 @@ instance HasGroupNumber CryptoMessage where
         | x >= 0x61 && x <= 0x63 = UpToN xE (B.append (S.encode groupnum) xs)
         | x == 0xC7              = UpToN xE (B.append (S.encode groupnum) xs)
     setGroupNumber _ _ = error "setGroupNumber on CryptoMessage without group number field."
+-}
 
 groupNumber :: (Functor f, HasGroupNumber x) => (Word16 -> f Word16) -> (x -> f x)
 groupNumber = lens getGroupNumber setGroupNumber
@@ -460,6 +368,7 @@ class HasGroupNumberToJoin x where
     getGroupNumberToJoin :: x -> GroupNumber
     setGroupNumberToJoin :: x -> GroupNumber -> x
 
+{-
 instance HasGroupNumberToJoin CryptoMessage where
     getGroupNumberToJoin (UpToN INVITE_GROUPCHAT (sizedN 39 -> B.uncons -> Just (1,xs))) -- only response has to-join
         = let twobytes = B.take 2 (B.drop 2 xs) -- skip group number (local)
@@ -472,6 +381,7 @@ instance HasGroupNumberToJoin CryptoMessage where
               twoBytes' = S.encode groupnum
             in UpToN INVITE_GROUPCHAT (B.cons 1 (B.concat [a,twoBytes',c]))
     setGroupNumberToJoin _ _ = error "setGroupNumberToJoin on CryptoMessage without group number (to join) field."
+-}
 
 groupNumberToJoin :: (Functor f, HasGroupNumberToJoin x) => (GroupNumber -> f GroupNumber) -> (x -> f x)
 groupNumberToJoin = lens getGroupNumberToJoin setGroupNumberToJoin
@@ -480,6 +390,7 @@ class HasPeerNumber x where
     getPeerNumber :: x -> PeerNumber
     setPeerNumber :: x -> PeerNumber -> x
 
+{-
 instance HasPeerNumber CryptoMessage where
     getPeerNumber (UpToN (fromEnum -> 0x63) (sizedN 4 -> B.splitAt 2 -> (grpnum,twobytes)))
         = let Right n = S.decode twobytes in n
@@ -492,6 +403,7 @@ instance HasPeerNumber CryptoMessage where
     setPeerNumber (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 4 -> B.splitAt 2 -> (gnum,xs))) peernum 
         = UpToN xE (B.concat [gnum,S.encode peernum, B.drop 2 xs])
     setPeerNumber _ _ = error "setPeerNumber on CryptoMessage without peer number field."
+-}
 
 peerNumber :: (Functor f, HasPeerNumber x) => (Word16 -> f Word16) -> (x -> f x)
 peerNumber = lens getPeerNumber setPeerNumber
@@ -500,6 +412,7 @@ class HasMessageNumber x where
     getMessageNumber :: x -> MessageNumber
     setMessageNumber :: x -> MessageNumber -> x
 
+{-
 instance HasMessageNumber CryptoMessage where
     getMessageNumber (UpToN (fromEnum -> 0x63) (sizedN 8 -> B.splitAt 4 -> (_,fourbytes)))
         = let Right n = S.decode fourbytes in n
@@ -512,6 +425,7 @@ instance HasMessageNumber CryptoMessage where
     setMessageNumber (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 8 -> B.splitAt 4 -> (bs,xs))) messagenum 
         = UpToN xE (B.concat [bs,S.encode messagenum, B.drop 4 xs])
     setMessageNumber _ _ = error "setMessageNumber on CryptoMessage without message number field."
+-}
 
 messageNumber :: (Functor f, HasMessageNumber x) => (Word32 -> f Word32) -> (x -> f x)
 messageNumber = lens getMessageNumber setMessageNumber
@@ -521,6 +435,7 @@ class HasMessageName x where
     getMessageName :: x -> MessageName
     setMessageName :: x -> MessageName -> x
 
+{-
 instance HasMessageName CryptoMessage where
     getMessageName (UpToN (fromEnum -> 0x63) (sizedN 9 -> B.splitAt 8 -> (_,onebyte)))
         = let [n] = B.unpack onebyte
@@ -535,6 +450,7 @@ instance HasMessageName CryptoMessage where
     setMessageName (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename
         = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)])
     setMessageName _ _ = error "setMessageName on CryptoMessage without message name field."
+-}
 
 messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x)
 messageName = lens getMessageName setMessageName
@@ -542,7 +458,7 @@ messageName = lens getMessageName setMessageName
 data KnownLossyness = KnownLossy | KnownLossless
     deriving (Eq,Ord,Show,Enum)
 
-data MessageType = Msg MessageID
+data MessageType = Msg Word8
                  | GrpMsg KnownLossyness MessageName
     deriving (Eq,Show)
 
@@ -555,11 +471,6 @@ class AsWord64 a where
    fromWord64 :: Word64 -> a
 
 
-toEnum8 :: (Enum a, Integral word8) => word8 -> a
-toEnum8 = toEnum . fromIntegral
-fromEnum8 :: Enum a => a -> Word8
-fromEnum8 = fromIntegral . fromEnum
-
 fromEnum16 :: Enum a => a -> Word16
 fromEnum16 = fromIntegral . fromEnum
 
@@ -599,6 +510,7 @@ class HasMessageType x where
     getMessageType :: x -> MessageType
     setMessageType :: x -> MessageType -> x
 
+{-
 instance HasMessageType CryptoMessage where
     getMessageType (OneByte mid) = Msg mid
     getMessageType (TwoByte mid _) = Msg mid
@@ -619,10 +531,13 @@ instance HasMessageType CryptoMessage where
     setMessageType (OneByte mid0)   (Msg mid) = UpToN mid B.empty
     setMessageType (TwoByte mid0 x) (Msg mid) = UpToN mid (B.singleton x)
     setMessageType (UpToN mid0 x)   (Msg mid) = UpToN mid x
+-}
 
+{-
 instance HasMessageType CryptoData where
     getMessageType (CryptoData { bufferData })     = getMessageType bufferData
     setMessageType cd@(CryptoData { bufferData=bd }) typ = cd { bufferData=setMessageType bd typ }
+-}
 
 -- | This lens should always succeed on CryptoMessage
 messageType :: (Functor f, HasMessageType x) => (MessageType -> f MessageType) -> (x -> f x)
@@ -634,6 +549,7 @@ class HasMessageData x where
     getMessageData :: x -> MessageData
     setMessageData :: x -> MessageData -> x
 
+{-
 instance HasMessageData CryptoMessage where
     getMessageData (UpToN (fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata
     getMessageData (UpToN (fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata
@@ -649,6 +565,7 @@ instance HasMessageData CryptoMessage where
     setMessageData (UpToN xE@(fromEnum -> 0x62) (sizedAtLeastN 3 -> B.splitAt 3 -> (bs,xs))) peerinfosOrTitle -- peer/title response packets
         = UpToN xE (B.concat [bs,peerinfosOrTitle])
     setMessageData _ _ = error "setMessageData on CryptoMessage without message data field."
+-}
 
 messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x)
 messageData = lens getMessageData setMessageData
@@ -657,6 +574,7 @@ class HasTitle x where
     getTitle :: x -> Text
     setTitle :: x -> Text -> x
 
+{-
 instance HasTitle CryptoMessage where
     getTitle (UpToN xE bs)
         | DIRECT_GROUPCHAT {-0x62-} <- xE,
@@ -677,6 +595,7 @@ instance HasTitle CryptoMessage where
                   nm = fromIntegral $ fromEnum GroupchatTitleChange
               in UpToN xE (pre <> B.cons nm (encodeUtf8 msgdta))
     setTitle _ _ = error "setTitle on CryptoMessage without title field."
+-}
 
 title :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
 title = lens getTitle setTitle
@@ -690,6 +609,7 @@ splitByteAt n bs = (fixed,w8,bs')
  where
     (fixed,B.uncons -> Just (w8,bs')) = B.splitAt n $ sizedAtLeastN (n+1) bs
 
+{-
 instance HasMessage CryptoMessage where
     getMessage (UpToN xE bs)
         | MESSAGE <- xE        = T.decodeUtf8 bs
@@ -705,7 +625,7 @@ instance HasMessage CryptoMessage where
                 prefix x = pre8 <> B.cons nm x
             in UpToN xE $ prefix $ T.encodeUtf8 message
     setMessage _ _ = error "setMessage on CryptoMessage without message field."
-
+-}
 
 message :: (Functor f, HasMessage x) => (Text -> f Text) -> (x -> f x)
 message = lens getMessage setMessage
@@ -715,6 +635,7 @@ class HasName x where
     setName :: x -> Text -> x
 
 
+{-
 instance HasName CryptoMessage where
     -- Only MESSAGE_GROUPCHAT:NameChange has Name field
     getName (UpToN xE (sizedAtLeastN 4 -> B.splitAt 3 -> (_,B.uncons -> Just (toEnum . fromIntegral -> NameChange,mdata)))) | isIndirectGrpChat xE = decodeUtf8 mdata
@@ -724,6 +645,7 @@ instance HasName CryptoMessage where
     setName (UpToN xE (sizedAtLeastN 4 -> B.splitAt 3 -> (bs,B.uncons -> Just (_,xs)))) name
         | isIndirectGrpChat xE = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum NameChange) (encodeUtf8 name)])
     setName _ _ = error "setName on CryptoMessage without name field."
+-}
 
 name :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
 name = lens getTitle setTitle
@@ -760,6 +682,7 @@ instance Serialize PeerInfo where
         putByteString $ B.take (fromIntegral sz) bs
 
 
+{-
 -- |
 -- default constructor, handy for formations such as:
 --
@@ -770,12 +693,15 @@ msg mid | Just (True,0)  <- msgSizeParam mid = OneByte mid
         | Just (True,1)  <- msgSizeParam mid = TwoByte mid 0
         | Just (False,_) <- msgSizeParam mid = UpToN   mid B.empty
         | otherwise                          = UpToN   mid B.empty
+-}
 
+{-
 leaveMsg, peerQueryMsg :: Serialize a => a -> CryptoMessage
 leaveMsg     groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x01)
 peerQueryMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x08)
+-}
 
-
+{-
 -- | Returns if the given message is of fixed(OneByte/TwoByte) size, as well as
 -- the maximum allowed size for the message Payload (message minus id)
 -- Or Nothing if unknown/unimplemented.
@@ -797,19 +723,20 @@ msgSizeParam DIRECT_GROUPCHAT  {-0x62-} = Nothing -- 1+2+1 thus Just (True,3) le
 msgSizeParam MESSAGE_GROUPCHAT {-0x63-} = Nothing -- variable
 msgSizeParam LOSSY_GROUPCHAT   {-0xC7-} = Nothing -- variable
 msgSizeParam _                          = Nothing
+-}
 
-isIndirectGrpChat :: MessageID -> Bool
-isIndirectGrpChat MESSAGE_GROUPCHAT = True
-isIndirectGrpChat LOSSY_GROUPCHAT   = True
-isIndirectGrpChat _                 = False
+isIndirectGrpChat :: Msg n t -> Bool
+isIndirectGrpChat MESSAGE_CONFERENCE = True
+isIndirectGrpChat LOSSY_CONFERENCE   = True
+isIndirectGrpChat _                  = False
 
-isKillPacket :: MessageType -> Bool
-isKillPacket (Msg KillPacket) = True
-isKillPacket _                = False
+isKillPacket :: SomeMsg -> Bool
+isKillPacket (M KillPacket) = True
+isKillPacket _              = False
 
-isOFFLINE :: MessageType -> Bool
-isOFFLINE (Msg OFFLINE) = True
-isOFFLINE _             = False
+isOFFLINE :: SomeMsg -> Bool
+isOFFLINE (M OFFLINE) = True
+isOFFLINE _           = False
 
 
 data MessageName = Ping -- 0x00
diff --git a/src/Network/Tox/Session.hs b/src/Network/Tox/Session.hs
index 18e17fb6..189967fa 100644
--- a/src/Network/Tox/Session.hs
+++ b/src/Network/Tox/Session.hs
@@ -12,13 +12,14 @@ module Network.Tox.Session
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Exception
+import Data.Dependent.Sum
 import Data.Functor.Identity
 import Data.Word
 import Network.Socket         (SockAddr)
 
 import Crypto.Tox
 import Data.PacketBuffer            (PacketInboundEvent (..))
-import Data.Tox.Message
+import Data.Tox.Msg
 import DPut
 import DebugTag
 import Network.Lossless
@@ -136,10 +137,10 @@ plainHandshakeH sp saddr skey handshake = do
     forM_ m $ \(sid, t) -> do
         (t2,resend,getMissing)
             <- lossless (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp)
-                        (\seqno p _ -> do
+                        (\seqno p@(Pkt m :=> _) _ -> do
                             y <- encryptPacket sk $ bookKeeping seqno p
                             return OutgoingInfo
-                                { oIsLossy         = lossyness (msgID p) == Lossy
+                                { oIsLossy         = lossyness m == Lossy
                                 , oEncoded         = y
                                 , oHandleException = Just $ \e -> do
                                         dput XUnexpected $ unlines
@@ -151,7 +152,7 @@ plainHandshakeH sp saddr skey handshake = do
                         t
         let _ = t :: TransportA String () (CryptoPacket Identity) (CryptoPacket Encrypted)
             _ = t2 :: Transport String () CryptoMessage
-        sendMessage t2 () $ OneByte ONLINE
+        sendMessage t2 () $ (Pkt ONLINE ==> ())
         spOnNewSession sp Session
             { sOurKey            = skey
             , sTheirAddr         = saddr
@@ -236,5 +237,7 @@ checkLossless cd@CryptoData{ bufferStart = ack
                            , bufferData  = x   } = tag no x' ack
  where
     x' = decodeRawCryptoMsg cd
-    tag = case lossyness (msgID x') of Lossy -> PacketReceivedLossy
-                                       _     -> PacketReceived
+    tag = case someLossyness (msgID x') of Lossy -> PacketReceivedLossy
+                                           _     -> PacketReceived
+
+