path: root/src/Network/Tox/Crypto/Transport.hs

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
module Network.Tox.Crypto.Transport
    ( parseNetCrypto
    , encodeNetCrypto
    -- CryptoTransport
    , NetCrypto(..)
    , CryptoData(..)
    , CryptoMessage(..)
    , CryptoPacket(..)
    , HandshakeData(..)
    , Handshake(..)
    , PeerInfo(..)
    , MessageID(..)
    , UserStatus(..)
    , TypingStatus(..)
    , GroupChatId(..)
    -- feild name classes
    , HasGroupChatID(..)
    , HasGroupNumber(..)
    , HasPeerNumber(..)
    , HasMessageNumber(..)
    , HasMessageName(..)
    , HasMessageData(..)
    -- lenses
    , userStatus, nick, statusMessage, typingStatus, message, action, groupChatID
    , groupNumber, groupNumberToJoin, peerNumber, messageNumber
    , messageName, messageData
    -- constructor
    , msg
    , leaveMsg
    , peerQueryMsg
    -- utils
    , sizedN
    , sizedAtLeastN
    ) where

import Crypto.Tox
import Network.Tox.DHT.Transport (Cookie)

import Network.Socket
import Data.ByteString as B
import Data.Monoid
import Data.Word
import Crypto.Hash
import Control.Lens
import Data.Text as T
import Data.Text.Encoding as T
import Data.Serialize as S


data NetCrypto
    = NetHandshake (Handshake Encrypted)
    | NetCrypto (CryptoPacket Encrypted)

parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr)
parseNetCrypto pkt saddr = Left "TODO: parseNetCrypto"

encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr)
encodeNetCrypto _ _ = _todo

data Handshake (f :: * -> *) = Handshake
    { handshakeCookie :: Cookie
    , handshakeNonce :: Nonce24
    , hadshakeData :: f HandshakeData
    }

data HandshakeData = HandshakeData
    { baseNonce :: Nonce24
    , sessionKey :: PublicKey
    , cookieHash :: Digest SHA512
    , otherCookie :: Cookie
    }

data CryptoPacket (f :: * -> *) = CryptoPacket
    { pktNonce :: Word16
    , pktData :: f CryptoData
    }

instance Sized CryptoData where
    size = contramap bufferStart size
            <> contramap bufferEnd size
            <> contramap bufferData size

instance Serialize (CryptoPacket Encrypted) where
    get = CryptoPacket <$> get <*> get
    put (CryptoPacket n16 dta) = put n16 >> put dta

data CryptoData = CryptoData
    { -- | [our recvbuffers buffer_start, (highest packet number handled + 1), (big endian)]
      bufferStart :: Word32
      -- | [  uint32_t packet number if lossless
      --   , sendbuffer buffer_end  if lossy   , (big endian)]
    , bufferEnd :: Word32
      -- | [data]
    , bufferData :: CryptoMessage
    }

-- 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,Eq,Ord,Enum)

data TypingStatus = NotTyping | Typing deriving (Show,Eq,Ord,Enum)

data CryptoMessage
        = OneByte  { msgID :: MessageID }
        | TwoByte  { msgID :: MessageID, msgByte  :: Word8 }
        | UpToN    { msgID :: MessageID, msgBytes :: ByteString } -- length < N
    deriving (Eq,Show)

instance Sized CryptoMessage where
    size = VarSize $ \case
        OneByte {}              -> 1
        TwoByte {}              -> 2
        UpToN { msgBytes = bs } -> 1 + B.length bs

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 (TwoByte TYPING status) = toEnum $ fromIntegral status
    getter _                       = erCompat "typingStatus"
    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 => (String -> f String)-> (CryptoMessage -> f CryptoMessage)
nick = lens getter setter
  where
    getter (UpToN NICKNAME bstr) = T.unpack $ T.decodeUtf8 bstr
    getter _                     = erCompat "nick"
    setter (UpToN NICKNAME _) nick = UpToN NICKNAME (T.encodeUtf8 . T.pack $ 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"

message :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage)
message = lens getter setter
  where
    getter (UpToN MESSAGE bstr) = T.unpack $ T.decodeUtf8 bstr
    getter _                     = erCompat "message"
    setter (UpToN MESSAGE _) message = UpToN MESSAGE (T.encodeUtf8 . T.pack $ message)
    setter _ _                     = erCompat "message"

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)

class HasGroupChatID x where
    getGroupChatID :: x -> GroupChatId
    setGroupChatID :: x -> GroupChatId -> x

sizedN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0)
                                 else B.take n bs

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)
        = let (xs,ys) = B.splitAt 1 payload'
              payload' = sizedN 38 payload
              in case B.unpack xs of
                    [isResponse] | 0 <- isResponse -> GrpId (B.take 33 $ B.drop 2 ys) -- skip group number
                    [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 _ = error "getGroupChatID on non-groupchat message."

    -- Set
    setGroupChatID msg@(UpToN INVITE_GROUPCHAT  payload) (GrpId newid)
        = let (xs,ys) = B.splitAt 1 payload'
              payload' = sizedN 38 payload
              in case B.unpack xs of
                    [isResponse] | 0 <- isResponse -> UpToN INVITE_GROUPCHAT (B.concat [xs, (B.take 2 ys), sizedN 33 newid]) -- keep group number
                    [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 _ _= error "setGroupChatID on non-groupchat message."

groupChatID :: (Functor f, HasGroupChatID x) => (GroupChatId -> f GroupChatId) -> (x -> f x)
groupChatID = lens getGroupChatID setGroupChatID

type GroupNumber = Word16
type PeerNumber = Word16
type MessageNumber = Word32

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
        = let twobytes = B.take 2 xs
              Right n = S.decode twobytes
              in n
    getGroupNumber (UpToN (fromEnum -> x) (sizedN 2 -> twobytes)) | x >= 0x61 && x <= 0x63
        = let Right n = S.decode twobytes in n
    getGroupNumber (UpToN (fromEnum -> 0xC7) (sizedN 2 -> twobytes))
        = let Right n = S.decode twobytes in n

    getGroupNumber _   = error "getGroupNumber on CryptoMessage without group number field."

    setGroupNumber (UpToN INVITE_GROUPCHAT (sizedN 39 -> B.uncons -> Just (isResp,xs))) groupnum
        = UpToN INVITE_GROUPCHAT (B.cons isResp (B.append (S.encode groupnum) (B.drop 2 xs)))
    setGroupNumber (UpToN xE@(fromEnum -> x) (sizedAtLeastN 2 -> B.splitAt 2 -> (twobytes,xs))) groupnum
        | 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

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)
              Right n = S.decode twobytes
              in n
    getGroupNumberToJoin _   = error "getGroupNumberToJoin on CryptoMessage without group number (to join) field."
    setGroupNumberToJoin (UpToN INVITE_GROUPCHAT (sizedN 39 -> B.uncons -> Just (1,xs))) groupnum 
        = let (a,b)        = B.splitAt 2 xs
              (twoBytes,c) = B.splitAt 2 b
              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

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
    getPeerNumber (UpToN (fromEnum -> 0xC7) (sizedN 4 -> B.splitAt 2 -> (grpnum,twobytes)))
        = let Right n = S.decode twobytes in n
    getPeerNumber _   = error "getPeerNumber on CryptoMessage without peer number field."

    setPeerNumber (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 4 -> B.splitAt 2 -> (gnum,xs))) peernum 
        = UpToN xE (B.concat [gnum,S.encode peernum, B.drop 2 xs])
    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

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
    getMessageNumber (UpToN (fromEnum -> 0xC7) (sizedN 8 -> B.splitAt 4 -> (_,fourbytes)))
        = let Right n = S.decode fourbytes in n
    getMessageNumber _   = error "getMessageNumber on CryptoMessage without message number field."

    setMessageNumber (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 8 -> B.splitAt 4 -> (bs,xs))) messagenum 
        = UpToN xE (B.concat [bs,S.encode messagenum, B.drop 4 xs])
    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

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
              in toEnum . fromIntegral $ n
    getMessageName (UpToN (fromEnum -> 0xC7) (sizedN 9 -> B.splitAt 8 -> (_,onebyte)))
        = let [n] = B.unpack onebyte
              in toEnum . fromIntegral $ n
    getMessageName _   = error "getMessageName on CryptoMessage without message number field."

    setMessageName (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename
        = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)])
    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 number field."

messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x)
messageName = lens getMessageName setMessageName

type MessageData = B.ByteString

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
    getMessageData _   = error "getMessageData on CryptoMessage without message number field."

    setMessageData (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- MESSAGE_GROUPCHAT
        = UpToN xE (B.concat [bs,messagedata])
    setMessageData (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- LOSSY_GROUPCHAT
        = UpToN xE (B.concat [bs,messagedata])
    setMessageData _ _ = error "setMessageData on CryptoMessage without message number field."

messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x)
messageData = lens getMessageData setMessageData

data PeerInfo
      = PeerInfo
         { piPeerNum :: PeerNumber
         , piUserKey :: PublicKey
         , piDHTKey  :: PublicKey
         , piName  :: ByteString -- byte-prefix for length
         } deriving (Eq,Show)


-- |
-- default constructor, handy for formations such as:
--
-- > userStatus .~ Busy $ msg USERSTATUS
--
msg mid | Just (True,0) <- msgSizeParam mid  = OneByte mid
msg mid | Just (True,1) <- msgSizeParam mid  = TwoByte mid 0
msg mid | Just (False,_) <- msgSizeParam mid = UpToN   mid B.empty

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.
msgSizeParam :: MessageID -> Maybe (Bool,Int)
msgSizeParam ONLINE  = Just (True,0)
msgSizeParam OFFLINE = Just (True,0)
msgSizeParam USERSTATUS = Just (True,1)
msgSizeParam TYPING     = Just (True,1)
msgSizeParam NICKNAME         = Just (False,128)
msgSizeParam STATUSMESSAGE    = Just (False,1007)
msgSizeParam MESSAGE          = Just (False,1372)
msgSizeParam ACTION           = Just (False,1372)
msgSizeParam FILE_DATA        = Just (False,1372)-- up to 1373
msgSizeParam FILE_SENDREQUEST = Just (False,300) -- 1+1+4+8+32+max255 = up to 301
msgSizeParam FILE_CONTROL     = Just (False,7)   -- 8 bytes if seek, otherwise 4
msgSizeParam INVITE_GROUPCHAT = Just (False,38)
msgSizeParam ONLINE_PACKET    = Just (True,35)
msgSizeParam DIRECT_GROUPCHAT   = Nothing -- 1+2+1 thus Just (True,3) leave & peer-query, but variable in response packets
msgSizeParam MESSAGE_GROUPCHAT  = Nothing -- variable
msgSizeParam LOSSY_GROUPCHAT    = Nothing -- variable
msgSizeParam _ = Nothing

-- TODO: Flesh this out.
data MessageID              -- First byte indicates data
    = Padding               -- ^ 0 padding (skipped until we hit a non zero (data id) byte)
    | PacketRequest         -- ^ 1 packet request packet (lossy packet)
    | KillPacket            -- ^ 2 connection kill packet (lossy packet)
    | UnspecifiedPacket003  -- ^ 3+ unspecified
    | UnspecifiedPacket004
    | UnspecifiedPacket005
    | UnspecifiedPacket006
    | UnspecifiedPacket007
    | UnspecifiedPacket008
    | UnspecifiedPacket009
    | UnspecifiedPacket010
    | UnspecifiedPacket011
    | UnspecifiedPacket012
    | UnspecifiedPacket013
    | UnspecifiedPacket014
    | UnspecifiedPacket015
    | MessengerLossless016  -- ^ 16+  reserved for Messenger usage (lossless packets)
    | MessengerLossless017
    | MessengerLossless018
    | MessengerLossless019
    | MessengerLossless020
    | MessengerLossless021
    | MessengerLossless022
    | MessengerLossless023
    | ONLINE                -- 1 byte
    | OFFLINE               -- 1 byte
    | MessengerLossless026
    | MessengerLossless027
    | MessengerLossless028
    | MessengerLossless029
    | MessengerLossless030
    | MessengerLossless031
    | MessengerLossless032
    | MessengerLossless033
    | MessengerLossless034
    | MessengerLossless035
    | MessengerLossless036
    | MessengerLossless037
    | MessengerLossless038
    | MessengerLossless039
    | MessengerLossless040
    | MessengerLossless041
    | MessengerLossless042
    | MessengerLossless043
    | MessengerLossless044
    | MessengerLossless045
    | MessengerLossless046
    | MessengerLossless047
    | NICKNAME              -- up to 129 bytes
    | STATUSMESSAGE         -- up to 1008 bytes
    | USERSTATUS            -- 2 bytes
    | TYPING                -- 2 bytes
    | MessengerLossless052
    | MessengerLossless053
    | MessengerLossless054
    | MessengerLossless055
    | MessengerLossless056
    | MessengerLossless057
    | MessengerLossless058
    | MessengerLossless059
    | MessengerLossless060
    | MessengerLossless061
    | MessengerLossless062
    | MessengerLossless063
    | MESSAGE               -- up to 1373 bytes
    | ACTION                -- up to 1373 bytes
    | MessengerLossless066
    | MessengerLossless067
    | MessengerLossless068
    | MSI
    | MessengerLossless070
    | MessengerLossless071
    | MessengerLossless072
    | MessengerLossless073
    | MessengerLossless074
    | MessengerLossless075
    | MessengerLossless076
    | MessengerLossless077
    | MessengerLossless078
    | MessengerLossless079
    | FILE_SENDREQUEST      -- 1+1+4+8+32+max255 = up to 301
    | FILE_CONTROL          -- 8 bytes if seek, otherwise 4
    | FILE_DATA             -- up to 1373
    | MessengerLossless083
    | MessengerLossless084
    | MessengerLossless085
    | MessengerLossless086
    | MessengerLossless087
    | MessengerLossless088
    | MessengerLossless089
    | MessengerLossless090
    | MessengerLossless091
    | MessengerLossless092
    | MessengerLossless093
    | MessengerLossless094
    | MessengerLossless095
    | INVITE_GROUPCHAT
    | ONLINE_PACKET
    | DIRECT_GROUPCHAT
    | MESSAGE_GROUPCHAT
    | MessengerLossless100
    | MessengerLossless101
    | MessengerLossless102
    | MessengerLossless103
    | MessengerLossless104
    | MessengerLossless105
    | MessengerLossless106
    | MessengerLossless107
    | MessengerLossless108
    | MessengerLossless109
    | MessengerLossless110
    | MessengerLossless111
    | MessengerLossless112
    | MessengerLossless113
    | MessengerLossless114
    | MessengerLossless115
    | MessengerLossless116
    | MessengerLossless117
    | MessengerLossless118
    | MessengerLossless119
    | MessengerLossless120
    | MessengerLossless121
    | MessengerLossless122
    | MessengerLossless123
    | MessengerLossless124
    | MessengerLossless125
    | MessengerLossless126
    | MessengerLossless127
    | MessengerLossless128
    | MessengerLossless129
    | MessengerLossless130
    | MessengerLossless131
    | MessengerLossless132
    | MessengerLossless133
    | MessengerLossless134
    | MessengerLossless135
    | MessengerLossless136
    | MessengerLossless137
    | MessengerLossless138
    | MessengerLossless139
    | MessengerLossless140
    | MessengerLossless141
    | MessengerLossless142
    | MessengerLossless143
    | MessengerLossless144
    | MessengerLossless145
    | MessengerLossless146
    | MessengerLossless147
    | MessengerLossless148
    | MessengerLossless149
    | MessengerLossless150
    | MessengerLossless151
    | MessengerLossless152
    | MessengerLossless153
    | MessengerLossless154
    | MessengerLossless155
    | MessengerLossless156
    | MessengerLossless157
    | MessengerLossless158
    | MessengerLossless159
    | MessengerLossless160
    | MessengerLossless161
    | MessengerLossless162
    | MessengerLossless163
    | MessengerLossless164
    | MessengerLossless165
    | MessengerLossless166
    | MessengerLossless167
    | MessengerLossless168
    | MessengerLossless169
    | MessengerLossless170
    | MessengerLossless171
    | MessengerLossless172
    | MessengerLossless173
    | MessengerLossless174
    | MessengerLossless175
    | MessengerLossless176
    | MessengerLossless177
    | MessengerLossless178
    | MessengerLossless179
    | MessengerLossless180
    | MessengerLossless181
    | MessengerLossless182
    | MessengerLossless183
    | MessengerLossless184
    | MessengerLossless185
    | MessengerLossless186
    | MessengerLossless187
    | MessengerLossless188
    | MessengerLossless189
    | MessengerLossless190
    | MessengerLossless191
    | MessengerLossy192     -- ^ 192+ reserved for Messenger usage (lossy packets)
    | MessengerLossy193
    | MessengerLossy194
    | MessengerLossy195
    | MessengerLossy196
    | MessengerLossy197
    | MessengerLossy198
    | LOSSY_GROUPCHAT
    | MessengerLossy200
    | MessengerLossy201
    | MessengerLossy202
    | MessengerLossy203
    | MessengerLossy204
    | MessengerLossy205
    | MessengerLossy206
    | MessengerLossy207
    | MessengerLossy208
    | MessengerLossy209
    | MessengerLossy210
    | MessengerLossy211
    | MessengerLossy212
    | MessengerLossy213
    | MessengerLossy214
    | MessengerLossy215
    | MessengerLossy216
    | MessengerLossy217
    | MessengerLossy218
    | MessengerLossy219
    | MessengerLossy220
    | MessengerLossy221
    | MessengerLossy222
    | MessengerLossy223
    | MessengerLossy224
    | MessengerLossy225
    | MessengerLossy226
    | MessengerLossy227
    | MessengerLossy228
    | MessengerLossy229
    | MessengerLossy230
    | MessengerLossy231
    | MessengerLossy232
    | MessengerLossy233
    | MessengerLossy234
    | MessengerLossy235
    | MessengerLossy236
    | MessengerLossy237
    | MessengerLossy238
    | MessengerLossy239
    | MessengerLossy240
    | MessengerLossy241
    | MessengerLossy242
    | MessengerLossy243
    | MessengerLossy244
    | MessengerLossy245
    | MessengerLossy246
    | MessengerLossy247
    | MessengerLossy248
    | MessengerLossy249
    | MessengerLossy250
    | MessengerLossy251
    | MessengerLossy252
    | MessengerLossy253
    | MessengerLossy254
    | Messenger255          -- ^ 255 reserved for Messenger usage (lossless packet)
    deriving (Show,Eq,Enum,Ord,Bounded)



data MessageName = Ping -- 0x00
                 | MessageName0x01
                 | MessageName0x02
                 | MessageName0x03
                 | MessageName0x04
                 | MessageName0x05
                 | MessageName0x06
                 | MessageName0x07
                 | MessageName0x08
                 | MessageName0x09
                 | MessageName0x0a
                 | MessageName0x0b
                 | MessageName0x0c
                 | MessageName0x0d
                 | MessageName0x0e
                 | MessageName0x0f
                 | NewPeer  -- 0x10
                 | KillPeer -- 0x11
                 | MessageName0x12
                 | MessageName0x13
                 | MessageName0x14
                 | MessageName0x15
                 | MessageName0x16
                 | MessageName0x17
                 | MessageName0x18
                 | MessageName0x19
                 | MessageName0x1a
                 | MessageName0x1b
                 | MessageName0x1c
                 | MessageName0x1d
                 | MessageName0x1e
                 | MessageName0x1f
                 | MessageName0x20
                 | MessageName0x21
                 | MessageName0x22
                 | MessageName0x23
                 | MessageName0x24
                 | MessageName0x25
                 | MessageName0x26
                 | MessageName0x27
                 | MessageName0x28
                 | MessageName0x29
                 | MessageName0x2a
                 | MessageName0x2b
                 | MessageName0x2c
                 | MessageName0x2d
                 | MessageName0x2e
                 | MessageName0x2f
                 | NameChange -- 0x30
                 | GroupchatTitleChange -- 0x31
                 | MessageName0x32
                 | MessageName0x33
                 | MessageName0x34
                 | MessageName0x35
                 | MessageName0x36
                 | MessageName0x37
                 | MessageName0x38
                 | MessageName0x39
                 | MessageName0x3a
                 | MessageName0x3b
                 | MessageName0x3c
                 | MessageName0x3d
                 | MessageName0x3e
                 | MessageName0x3f
                 | ChatMessage -- 0x40
                 | Action -- 0x41
                 | MessageName0x42
                 | MessageName0x43
                 | MessageName0x44
                 | MessageName0x45
                 | MessageName0x46
                 | MessageName0x47
                 | MessageName0x48
                 | MessageName0x49
                 | MessageName0x4a
                 | MessageName0x4b
                 | MessageName0x4c
                 | MessageName0x4d
                 | MessageName0x4e
                 | MessageName0x4f
                 | MessageName0x50
                 | MessageName0x51
                 | MessageName0x52
                 | MessageName0x53
                 | MessageName0x54
                 | MessageName0x55
                 | MessageName0x56
                 | MessageName0x57
                 | MessageName0x58
                 | MessageName0x59
                 | MessageName0x5a
                 | MessageName0x5b
                 | MessageName0x5c
                 | MessageName0x5d
                 | MessageName0x5e
                 | MessageName0x5f
                 | MessageName0x60
                 | MessageName0x61
                 | MessageName0x62
                 | MessageName0x63
                 | MessageName0x64
                 | MessageName0x65
                 | MessageName0x66
                 | MessageName0x67
                 | MessageName0x68
                 | MessageName0x69
                 | MessageName0x6a
                 | MessageName0x6b
                 | MessageName0x6c
                 | MessageName0x6d
                 | MessageName0x6e
                 | MessageName0x6f
                 | MessageName0x70
                 | MessageName0x71
                 | MessageName0x72
                 | MessageName0x73
                 | MessageName0x74
                 | MessageName0x75
                 | MessageName0x76
                 | MessageName0x77
                 | MessageName0x78
                 | MessageName0x79
                 | MessageName0x7a
                 | MessageName0x7b
                 | MessageName0x7c
                 | MessageName0x7d
                 | MessageName0x7e
                 | MessageName0x7f
                 | MessageName0x80
                 | MessageName0x81
                 | MessageName0x82
                 | MessageName0x83
                 | MessageName0x84
                 | MessageName0x85
                 | MessageName0x86
                 | MessageName0x87
                 | MessageName0x88
                 | MessageName0x89
                 | MessageName0x8a
                 | MessageName0x8b
                 | MessageName0x8c
                 | MessageName0x8d
                 | MessageName0x8e
                 | MessageName0x8f
                 | MessageName0x90
                 | MessageName0x91
                 | MessageName0x92
                 | MessageName0x93
                 | MessageName0x94
                 | MessageName0x95
                 | MessageName0x96
                 | MessageName0x97
                 | MessageName0x98
                 | MessageName0x99
                 | MessageName0x9a
                 | MessageName0x9b
                 | MessageName0x9c
                 | MessageName0x9d
                 | MessageName0x9e
                 | MessageName0x9f
                 | MessageName0xa0
                 | MessageName0xa1
                 | MessageName0xa2
                 | MessageName0xa3
                 | MessageName0xa4
                 | MessageName0xa5
                 | MessageName0xa6
                 | MessageName0xa7
                 | MessageName0xa8
                 | MessageName0xa9
                 | MessageName0xaa
                 | MessageName0xab
                 | MessageName0xac
                 | MessageName0xad
                 | MessageName0xae
                 | MessageName0xaf
                 | MessageName0xb0
                 | MessageName0xb1
                 | MessageName0xb2
                 | MessageName0xb3
                 | MessageName0xb4
                 | MessageName0xb5
                 | MessageName0xb6
                 | MessageName0xb7
                 | MessageName0xb8
                 | MessageName0xb9
                 | MessageName0xba
                 | MessageName0xbb
                 | MessageName0xbc
                 | MessageName0xbd
                 | MessageName0xbe
                 | MessageName0xbf
                 | MessageName0xc0
                 | MessageName0xc1
                 | MessageName0xc2
                 | MessageName0xc3
                 | MessageName0xc4
                 | MessageName0xc5
                 | MessageName0xc6
                 | MessageName0xc7
                 | MessageName0xc8
                 | MessageName0xc9
                 | MessageName0xca
                 | MessageName0xcb
                 | MessageName0xcc
                 | MessageName0xcd
                 | MessageName0xce
                 | MessageName0xcf
                 | MessageName0xd0
                 | MessageName0xd1
                 | MessageName0xd2
                 | MessageName0xd3
                 | MessageName0xd4
                 | MessageName0xd5
                 | MessageName0xd6
                 | MessageName0xd7
                 | MessageName0xd8
                 | MessageName0xd9
                 | MessageName0xda
                 | MessageName0xdb
                 | MessageName0xdc
                 | MessageName0xdd
                 | MessageName0xde
                 | MessageName0xdf
                 | MessageName0xe0
                 | MessageName0xe1
                 | MessageName0xe2
                 | MessageName0xe3
                 | MessageName0xe4
                 | MessageName0xe5
                 | MessageName0xe6
                 | MessageName0xe7
                 | MessageName0xe8
                 | MessageName0xe9
                 | MessageName0xea
                 | MessageName0xeb
                 | MessageName0xec
                 | MessageName0xed
                 | MessageName0xee
                 | MessageName0xef
                 | MessageName0xf0
                 | MessageName0xf1
                 | MessageName0xf2
                 | MessageName0xf3
                 | MessageName0xf4
                 | MessageName0xf5
                 | MessageName0xf6
                 | MessageName0xf7
                 | MessageName0xf8
                 | MessageName0xf9
                 | MessageName0xfa
                 | MessageName0xfb
                 | MessageName0xfc
                 | MessageName0xfd
                 | MessageName0xfe
                 | MessageName0xff
                deriving (Show,Eq,Ord,Enum,Bounded)

-- --> CookieRequest WithoutCookie
-- <-- CookieResponse CookieAddress
-- --> Handshake CookieAddress
-- <-- Handshake CookieAddress

-- cookie request packet (145 bytes)
--
-- [uint8_t 24]
-- [Sender's DHT Public key (32 bytes)]
-- [Random nonce (24 bytes)]
-- [Encrypted message containing:
--     [Sender's real public key (32 bytes)]
--     [padding (32 bytes)]
--     [uint64_t echo id (must be sent back untouched in cookie response)]
-- ]

-- Handshake packet:
--    [uint8_t 26] (0x1a)
--    [Cookie]
--    [nonce (24 bytes)]
--    [Encrypted message containing:
--        [24 bytes base nonce]
--        [session public key of the peer (32 bytes)]
--        [sha512 hash of the entire Cookie sitting outside the encrypted part]
--        [Other Cookie (used by the other to respond to the handshake packet)]
--    ]

-- cookie response packet (161 bytes):
--
--     [uint8_t 25]
--     [Random nonce (24 bytes)]
--     [Encrypted message containing:
--         [Cookie]
--         [uint64_t echo id (that was sent in the request)]
--     ]
--
--     Encrypted message is encrypted with the exact same symmetric key as the
--     cookie request packet it responds to but with a different nonce.
--     (Encrypted message is encrypted with reqesters's DHT private key,
--     responders's DHT public key and the nonce.)
--
--     Since we don't receive the public key, we will need to lookup the key by
--     the SockAddr... I don't understand why the CookieResponse message is
--     special this way.  TODO: implement a multimap (SockAddr -> SharedSecret)
--     and wrap cookie queries with store/delete.  TODO: Should the entire
--     SharedScret cache be keyed on only SockAddr ?  Perhaps the secret cache
--     should be (NodeId -> Secret) and the cookie-request map should be
--     (SockAddr -> NodeId)

-- Encrypted packets:
--
--  Length    Contents
-- :---------:--------------------------------------------------------------
--  `1`       `uint8_t` (0x1b)
--  `2`       `uint16_t` The last 2 bytes of the nonce used to encrypt this
--  variable   Payload
--
-- The payload is encrypted with the session key and 'base nonce' set by the
-- receiver in their handshake + packet number (starting at 0, big endian math).