1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Network.BitTorrent.Core.Node
( -- * Node ID
NodeId
, testIdBit
, genNodeId
-- * Node address
, NodeAddr (..)
-- * Node info
, NodeInfo (..)
) where
import Control.Applicative
import Data.Aeson (ToJSON, FromJSON)
import Data.Aeson.TH
import Data.Bits
import Data.ByteString as BS
import Data.BEncode as BE
import Data.Ord
import Data.Serialize as S
import Data.Word
import Network
import System.Entropy
import Data.Torrent.JSON
import Network.BitTorrent.Core.PeerAddr ()
{-----------------------------------------------------------------------
-- Node id
-----------------------------------------------------------------------}
-- TODO more compact representation ('ShortByteString's?)
-- | Normally, /this/ node id should we saved between invocations of
-- the client software.
newtype NodeId = NodeId ByteString
deriving (Show, Eq, Ord, BEncode, FromJSON, ToJSON)
nodeIdSize :: Int
nodeIdSize = 20
instance Serialize NodeId where
get = NodeId <$> getByteString nodeIdSize
{-# INLINE get #-}
put (NodeId bs) = putByteString bs
{-# INLINE put #-}
-- | Test if the nth bit is set.
testIdBit :: NodeId -> Word -> Bool
testIdBit (NodeId bs) i
| fromIntegral i < nodeIdSize * 8
, (q, r) <- quotRem (fromIntegral i) 8
= testBit (BS.index bs q) r
| otherwise = False
{-# INLINE testIdBit #-}
-- 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
{-----------------------------------------------------------------------
-- 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)
instance Eq a => Ord (NodeInfo a) where
compare = comparing nodeId
-- | 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
|
