From 26444f9639063547d46d2aac17f555c0c56bba00 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Tue, 17 Dec 2013 15:48:20 +0400
Subject: Move Node attributes to the Core modules

We need to share them between Exchange subsystem and DHT.
---
 bittorrent.cabal                    |   4 +-
 src/Network/BitTorrent/Core/Node.hs | 108 ++++++++++++++++++++++++++++++++++++
 2 files changed, 111 insertions(+), 1 deletion(-)
 create mode 100644 src/Network/BitTorrent/Core/Node.hs

diff --git a/bittorrent.cabal b/bittorrent.cabal
index faf72c75..947461a9 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -54,9 +54,11 @@ library
                        Network.BitTorrent.Client.Swarm
                        Network.BitTorrent.Core
                        Network.BitTorrent.Core.Fingerprint
+                       Network.BitTorrent.Core.Node
                        Network.BitTorrent.Core.PeerId
                        Network.BitTorrent.Core.PeerAddr
 --                     Network.BitTorrent.DHT
+--                     Network.BitTorrent.DHT.Message
 --                     Network.BitTorrent.DHT.Protocol
 --                     Network.BitTorrent.DHT.Session
 --                     Network.BitTorrent.Exchange
@@ -133,7 +135,7 @@ library
 
                        -- Network
                      , network      >= 2.4
---                     , krpc        >= 0.4
+                     , krpc         >= 0.4
                      , http-types   >= 0.8
                      , http-conduit >= 1.9 && < 2.0
                      , wai          >= 1.4 && < 2.0
diff --git a/src/Network/BitTorrent/Core/Node.hs b/src/Network/BitTorrent/Core/Node.hs
new file mode 100644
index 00000000..e93c3586
--- /dev/null
+++ b/src/Network/BitTorrent/Core/Node.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Network.BitTorrent.Core.Node
+       (  -- * Node ID
+         NodeId
+       , genNodeId
+
+         -- * Node address
+       , NodeAddr (..)
+
+         -- * Node info
+       , NodeInfo (..)
+       ) where
+
+import Control.Applicative
+import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson.TH
+import Data.ByteString as BS
+import Data.BEncode as BE
+import Data.Serialize as S
+import Network
+import System.Entropy
+
+import Data.Torrent.JSON
+import Network.BitTorrent.Core.PeerAddr ()
+
+{-----------------------------------------------------------------------
+--  Node id
+-----------------------------------------------------------------------}
+
+-- | Normally, /this/ node id should we saved between invocations of
+-- the client software.
+newtype NodeId = NodeId ByteString
+  deriving (Show, Eq, FromJSON, ToJSON)
+
+nodeIdSize :: Int
+nodeIdSize = 20
+
+instance Serialize NodeId where
+  get = NodeId <$> getByteString nodeIdSize
+  {-# INLINE get #-}
+  put (NodeId bs) = putByteString bs
+  {-# INLINE put #-}
+
+-- TODO WARN is the 'system' random suitable for this?
+-- | Generate random NodeID used for the entire session.
+--   Distribution of ID's should be as uniform as possible.
+--
+genNodeId :: IO NodeId
+genNodeId = NodeId <$> getEntropy nodeIdSize
+
+type Distance = NodeId
+
+{-----------------------------------------------------------------------
+--  Node address
+-----------------------------------------------------------------------}
+
+data NodeAddr a = NodeAddr
+  { nodeHost ::                !a
+  , nodePort :: {-# UNPACK #-} !PortNumber
+  } deriving (Show, Eq)
+
+$(deriveJSON omitRecordPrefix ''NodeAddr)
+
+-- | KRPC compatible encoding.
+instance Serialize a => Serialize (NodeAddr a) where
+  get = NodeAddr <$> get <*> get
+  put NodeAddr {..} = put nodeHost >> put nodePort
+
+-- | Torrent file compatible encoding.
+instance BEncode a => BEncode (NodeAddr a) where
+  toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort)
+  {-# INLINE toBEncode #-}
+  fromBEncode b = uncurry NodeAddr <$> fromBEncode b
+  {-# INLINE fromBEncode #-}
+
+{-----------------------------------------------------------------------
+--  Node info
+-----------------------------------------------------------------------}
+
+data NodeInfo a = NodeInfo
+  { nodeId   :: !NodeId
+  , nodeAddr :: !(NodeAddr a)
+  } deriving (Show, Eq)
+
+$(deriveJSON omitRecordPrefix ''NodeInfo)
+
+-- | KRPC 'compact list' compatible encoding.
+instance Serialize a => Serialize (NodeInfo a) where
+  get = NodeInfo <$> get <*> get
+  put NodeInfo {..} = put nodeId >> put nodeAddr
+
+type CompactInfo = ByteString
+
+data NodeList a = CompactNodeList [NodeInfo a]
+
+decodeCompact :: Serialize a => CompactInfo -> [NodeInfo a]
+decodeCompact = either (const []) id . S.runGet (many get)
+
+encodeCompact :: [NodeId] -> CompactInfo
+encodeCompact = S.runPut . mapM_ put
+
+--decodePeerList :: [BEncode] -> [PeerAddr]
+--decodePeerList = undefined
+
+--encodePeerList :: [PeerAddr] -> [BEncode]
+--encodePeerList = undefined
-- 
cgit v1.2.3