1 files changed, 108 insertions, 0 deletions

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