WIP: Adapting DHT to Tox network.

2 files changed, 233 insertions, 7 deletions

diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index c22ca189..8746fff5 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -100,7 +100,9 @@ module Data.Torrent
        , layoutInfo
        , pieceInfo
        , isPrivate
+#ifdef VERSION_bencoding
        , infoDictionary
+#endif
 
          -- * Torrent file
        , Torrent(..)
@@ -122,8 +124,10 @@ module Data.Torrent
        , typeTorrent
        , torrentExt
        , isTorrentPath
+#ifdef VERSION_bencoding
        , fromFile
        , toFile
+#endif
 
          -- * Magnet
          -- $magnet-link
@@ -150,8 +154,10 @@ import Control.Exception
 import Control.Lens
 import Control.Monad
 import Crypto.Hash.SHA1 as SHA1
+#ifdef VERSION_bencoding
 import Data.BEncode as BE
 import Data.BEncode.Types as BE
+#endif
 import Data.Bits
 #ifdef VERSION_bits_extras
 import Data.Bits.Extras
@@ -223,10 +229,12 @@ instance Hashable InfoHash where
   hashWithSalt s (InfoHash ih) = hashWithSalt s ih
   {-# INLINE hashWithSalt #-}
 
+#ifdef VERSION_bencoding
 -- | Convert to\/from raw bencoded string. (no encoding)
 instance BEncode InfoHash where
   toBEncode = toBEncode . getInfoHash
   fromBEncode be = InfoHash <$> fromBEncode be
+#endif
 
 -- | Convert to\/from raw bytestring. (no encoding)
 instance Serialize InfoHash where
@@ -321,7 +329,9 @@ shortHex = T.take 7 . longHex
 -- | Size of a file in bytes.
 type FileSize = FileOffset
 
+#ifdef VERSION_bencoding
 deriving instance BEncode  FileOffset
+#endif
 
 -- | Contain metainfo about one single file.
 data FileInfo a = FileInfo {
@@ -360,6 +370,7 @@ instance NFData a => NFData (FileInfo a) where
   rnf FileInfo {..} = rnf fiName
   {-# INLINE rnf #-}
 
+#ifdef VERSION_bencoding
 instance BEncode (FileInfo [BS.ByteString]) where
   toBEncode FileInfo {..} = toDict $
        "length" .=! fiLength
@@ -375,7 +386,9 @@ instance BEncode (FileInfo [BS.ByteString]) where
   {-# INLINE fromBEncode #-}
 
 type Put a = a -> BDict -> BDict
+#endif
 
+#ifdef VERSION_bencoding
 putFileInfoSingle :: Data.Torrent.Put (FileInfo BS.ByteString)
 putFileInfoSingle FileInfo {..} cont =
        "length" .=! fiLength
@@ -395,6 +408,7 @@ instance BEncode (FileInfo BS.ByteString) where
 
   fromBEncode = fromDict getFileInfoSingle
   {-# INLINE fromBEncode #-}
+#endif
 
 instance Pretty (FileInfo BS.ByteString) where
   pPrint FileInfo {..} =
@@ -447,6 +461,7 @@ instance NFData LayoutInfo where
 instance Default LayoutInfo where
   def = MultiFile [] ""
 
+#ifdef VERSION_bencoding
 getLayoutInfo :: BE.Get LayoutInfo
 getLayoutInfo = single <|> multi
   where
@@ -463,6 +478,7 @@ putLayoutInfo MultiFile  {..} = \ cont ->
 instance BEncode LayoutInfo where
   toBEncode   = toDict . (`putLayoutInfo` endDict)
   fromBEncode = fromDict getLayoutInfo
+#endif
 
 instance Pretty LayoutInfo where
   pPrint SingleFile {..} = pPrint liFile
@@ -637,7 +653,11 @@ hashPiece Piece {..} = SHA1.hashlazy pieceData
 
 -- | A flat array of SHA1 hash for each piece.
 newtype HashList = HashList { unHashList :: BS.ByteString }
-  deriving (Show, Read, Eq, BEncode, Typeable)
+  deriving ( Show, Read, Eq, Typeable
+#ifdef VERSION_bencoding
+           , BEncode
+#endif
+           )
 
 -- | Empty hash list.
 instance Default HashList where
@@ -665,6 +685,7 @@ instance Default PieceInfo where
   def = PieceInfo 1 def
 
 
+#ifdef VERSION_bencoding
 putPieceInfo :: Data.Torrent.Put PieceInfo
 putPieceInfo PieceInfo {..} cont =
        "piece length" .=! piPieceLength
@@ -679,6 +700,7 @@ getPieceInfo = do
 instance BEncode PieceInfo where
   toBEncode   = toDict . (`putPieceInfo` endDict)
   fromBEncode = fromDict getPieceInfo
+#endif
 
 -- | Hashes are omitted.
 instance Pretty PieceInfo where
@@ -750,6 +772,13 @@ instance Hashable InfoDict where
   hashWithSalt = Hashable.hashUsing idInfoHash
   {-# INLINE hashWithSalt #-}
 
+-- | Hash lazy bytestring using SHA1 algorithm.
+hashLazyIH :: BL.ByteString -> InfoHash
+hashLazyIH = either (const (error msg)) id . safeConvert . SHA1.hashlazy
+  where
+    msg = "Infohash.hash: impossible: SHA1 is always 20 bytes long"
+
+#ifdef VERSION_bencoding
 -- | Empty info dictionary with zero-length content.
 instance Default InfoDict where
   def = infoDictionary def def False
@@ -767,12 +796,6 @@ putPrivate :: Bool -> BDict -> BDict
 putPrivate False = id
 putPrivate True  = \ cont -> "private" .=! True .: cont
 
--- | Hash lazy bytestring using SHA1 algorithm.
-hashLazyIH :: BL.ByteString -> InfoHash
-hashLazyIH = either (const (error msg)) id . safeConvert . SHA1.hashlazy
-  where
-    msg = "Infohash.hash: impossible: SHA1 is always 20 bytes long"
-
 instance BEncode InfoDict where
   toBEncode InfoDict {..} = toDict $
       putLayoutInfo idLayoutInfo   $
@@ -786,6 +809,7 @@ instance BEncode InfoDict where
                   <*> getPrivate
     where
       ih = hashLazyIH (BE.encode dict)
+#endif
 
 ppPrivacy :: Bool -> Doc
 ppPrivacy privacy = "Privacy: " <> if privacy then "private" else "public"
@@ -868,6 +892,7 @@ makeLensesFor
 instance NFData Torrent where
   rnf Torrent {..} = rnf tInfoDict
 
+#ifdef VERSION_bencoding
 -- TODO move to bencoding
 instance BEncode URI where
   toBEncode uri = toBEncode (BC.pack (uriToString id uri ""))
@@ -918,6 +943,7 @@ instance BEncode Torrent where
             <*>? "publisher"
             <*>? "publisher-url"
             <*>? "signature"
+#endif
 
 (<:>) :: Doc -> Doc -> Doc
 name <:>   v       = name <> ":" <+> v
@@ -949,9 +975,11 @@ instance Pretty Torrent where
         "Publisher URL" <:>? ((text . show) <$> tPublisherURL) $$
         "Signature"     <:>? ((text . show) <$> tSignature)
 
+#ifdef VERSION_bencoding
 -- | No files, no trackers, no nodes, etc...
 instance Default Torrent where
   def = nullTorrent def
+#endif
 
 -- | A simple torrent contains only required fields.
 nullTorrent :: InfoDict -> Torrent
@@ -971,6 +999,7 @@ torrentExt = "torrent"
 isTorrentPath :: FilePath -> Bool
 isTorrentPath filepath = takeExtension filepath == extSeparator : torrentExt
 
+#ifdef VERSION_bencoding
 -- | Read and decode a .torrent file.
 fromFile :: FilePath -> IO Torrent
 fromFile filepath = do
@@ -982,6 +1011,7 @@ fromFile filepath = do
 -- | Encode and write a .torrent file.
 toFile :: FilePath -> Torrent -> IO ()
 toFile filepath = BL.writeFile filepath . BE.encode
+#endif
 
 {-----------------------------------------------------------------------
 --  URN
diff --git a/src/Data/Tox.hs b/src/Data/Tox.hs
new file mode 100644
index 00000000..448b39eb
--- /dev/null
+++ b/src/Data/Tox.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE PatternSynonyms    #-}
+{-# LANGUAGE RecordWildCards    #-}
+{-# LANGUAGE TupleSections      #-}
+{-# LANGUAGE UnboxedTuples      #-}
+module Data.Tox where
+
+import Data.ByteString (ByteString)
+import Data.Data (Data)
+import Data.Word
+import Data.LargeWord
+import Data.IP
+import Data.Serialize
+import Network.BitTorrent.Address () -- Serialize IP
+import GHC.Generics (Generic)
+import Network.Socket
+
+type Key32   = Word256 -- 32 byte key
+type Nonce8  = Word64  -- 8 bytes
+type Nonce24 = Word192 -- 24 bytes
+type NodeId  = Word256 -- 32 bytes (mainline uses only 20-byte node IDs)
+
+
+data NodeFormat = NodeFormat
+    { nodePublicKey :: Key32 -- 32 byte public key
+    , nodeIsTCP :: Bool -- This has no analog in mainline NodeInfo structure
+    , nodeIP :: IP -- IPv4 or IPv6  address
+    , nodePort :: PortNumber
+    }
+ deriving (Eq, Ord, Show)
+
+encodeFamily :: (Family, SocketType) -> Word8
+encodeFamily (AF_INET   , Datagram) = 2
+encodeFamily (AF_INET6  , Datagram) = 10
+encodeFamily (AF_INET   , Stream  ) = 130
+encodeFamily (AF_INET6  , Stream  ) = 138
+encodeFamily _ = error "Unsupported protocol"
+
+newtype MessageType = MessageType Word8
+ deriving (Eq, Ord, Show, Read)
+
+instance Serialize MessageType where
+    put (MessageType b) = put b
+    get = MessageType <$> get
+
+pattern Ping      = MessageType 0
+pattern Pong      = MessageType 1
+pattern GetNodes  = MessageType 2
+pattern SendNodes = MessageType 4
+{-
+ #define NET_PACKET_PING_REQUEST    0   /* Ping request packet ID. */
+ #define NET_PACKET_PING_RESPONSE   1   /* Ping response packet ID. */
+ #define NET_PACKET_GET_NODES       2   /* Get nodes request packet ID. */
+ #define NET_PACKET_SEND_NODES_IPV6 4   /* Send nodes response packet ID for other addresses. */
+ #define NET_PACKET_COOKIE_REQUEST  24  /* Cookie request packet */
+ #define NET_PACKET_COOKIE_RESPONSE 25  /* Cookie response packet */
+ #define NET_PACKET_CRYPTO_HS       26  /* Crypto handshake packet */
+ #define NET_PACKET_CRYPTO_DATA     27  /* Crypto data packet */
+ #define NET_PACKET_CRYPTO          32  /* Encrypted data packet ID. */
+ #define NET_PACKET_LAN_DISCOVERY   33  /* LAN discovery packet ID. */
+
+ /* See:  docs/Prevent_Tracking.txt and onion.{c, h} */
+ #define NET_PACKET_ONION_SEND_INITIAL 128
+ #define NET_PACKET_ONION_SEND_1 129
+ #define NET_PACKET_ONION_SEND_2 130
+
+ #define NET_PACKET_ANNOUNCE_REQUEST 131
+ #define NET_PACKET_ANNOUNCE_RESPONSE 132
+ #define NET_PACKET_ONION_DATA_REQUEST 133
+ #define NET_PACKET_ONION_DATA_RESPONSE 134
+
+ #define NET_PACKET_ONION_RECV_3 140
+ #define NET_PACKET_ONION_RECV_2 141
+ #define NET_PACKET_ONION_RECV_1 142
+ -}
+
+
+-- FIXME Orphan Serialize intance for large words
+instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where
+   put (LargeKey lo hi) = put hi >> put lo
+   get = flip LargeKey <$> get <*> get
+
+-- | Use with 'PingPayload', 'GetNodesPayload', or 'SendNodesPayload'
+data Message a = Message
+    { msgType    :: MessageType
+    , msgClient  :: NodeId
+    , msgNonce   :: Nonce24
+    , msgPayload :: a
+    }
+ deriving (Show, Generic)
+
+isQuery :: Message a -> Bool
+isQuery (Message { msgType = SendNodes })                  = False
+isQuery (Message { msgType = MessageType typ }) | even typ = True
+isQuery _                                                  = False
+
+isResponse :: Message a -> Bool
+isResponse m = not (isQuery m)
+
+isError :: Message a -> Bool
+isError _ = False
+
+instance Serialize a => Serialize (Message a) where -- TODO TOX
+
+data PingPayload = PingPayload
+    { isPong :: Bool
+    , pingId :: Nonce8
+    }
+
+data GetNodesPayload = GetNodesPayload
+    { nodesForWho :: NodeId
+    , nodesNonce :: Nonce8
+    }
+
+data SendNodesPayload = SendNodesPayload
+
+-- From: docs/updates/DHT.md
+--
+-- Node format:
+-- [uint8_t family (2 == IPv4, 10 == IPv6, 130 == TCP IPv4, 138 == TCP IPv6)]
+-- [ip (in network byte order), length=4 bytes if ipv4, 16 bytes if ipv6]
+-- [port (in network byte order), length=2 bytes]
+-- [char array (node_id), length=32 bytes]
+--
+-- see also: DHT.h (pack_nodes() and unpack_nodes())
+instance Serialize NodeFormat where
+
+    get = do
+        typ <- get :: Get Word8
+        (ip,istcp) <-
+            case typ :: Word8 of
+                2 -> (,False) . IPv4 <$> get
+                130 -> (,True) . IPv4 <$> get
+                10 -> (,False) . IPv6 <$> get
+                138 -> (,True) . IPv6 <$> get
+                _ -> fail "Unsupported type of Tox node_format structure"
+        port <- get
+        pubkey <- get
+        return $ NodeFormat { nodeIsTCP     = istcp
+                            , nodeIP        = ip
+                            , nodePort      = port
+                            , nodePublicKey = pubkey
+                            }
+
+    put (NodeFormat{..}) = do
+        put $ case (# nodeIP, nodeIsTCP #) of
+                (# IPv4 _, False #) -> 2
+                (# IPv4 _, True  #) -> 130
+                (# IPv6 _, False #) -> 10
+                (# IPv6 _, True  #) -> 138 :: Word8
+        put nodeIP
+        put nodePort
+        put nodePublicKey
+
+-- Note: the char array is a public key, the 32-bytes is provided by libsodium-dev
+-- in /usr/include/sodium/crypto_box.h as the symbol crypto_box_PUBLICKEYBYTES
+-- but toxcore/crypto_core.c will fail to compile if it is not 32.
+
+
+-- Ping(Request and response):
+--
+-- [byte with value: 00 for request, 01 for response]
+-- [char array (client node_id), length=32 bytes]
+-- [random 24 byte nonce]
+-- [Encrypted with the nonce and private key of the sender:
+--   [1 byte type (0 for request, 1 for response)]
+--   [random 8 byte (ping_id)]
+--   ]
+--
+-- ping_id = a random integer, the response must contain the exact same number as the request
+
+
+-- Get nodes (Request):
+--
+-- [byte with value: 02]
+-- [char array (client node_id), length=32 bytes]
+-- [random 24 byte nonce]
+-- [Encrypted with the nonce and private key of the sender:
+--   [char array: requested_node_id (node_id of which we want the ip), length=32 bytes]
+--   [Sendback data (must be sent back unmodified by in the response), length=8 bytes]
+--   ]
+--
+-- Valid replies: a send_nodes packet
+
+-- Send_nodes (response (for all addresses)):
+--
+-- [byte with value: 04]
+-- [char array  (client node_id), length=32 bytes]
+-- [random 24 byte nonce]
+-- [Encrypted with the nonce and private key of the sender:
+--   [uint8_t number of nodes in this packet]
+--   [Nodes in node format, length=?? * (number of nodes (maximum of 4 nodes)) bytes]
+--   [Sendback data, length=8 bytes]
+--   ]
+