diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-12-17 15:48:20 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-12-17 15:48:20 +0400 |
commit | 26444f9639063547d46d2aac17f555c0c56bba00 (patch) | |
tree | 3bf9bf9281cda60549cc4490ffe998a60bad177f /src | |
parent | ea8d3846ca916136eadf2cd72731ec61b7889ddc (diff) |
Move Node attributes to the Core modules
We need to share them between Exchange subsystem and DHT.
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/Core/Node.hs | 108 |
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 @@ | |||
1 | {-# LANGUAGE RecordWildCards #-} | ||
2 | {-# LANGUAGE TemplateHaskell #-} | ||
3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
4 | module Network.BitTorrent.Core.Node | ||
5 | ( -- * Node ID | ||
6 | NodeId | ||
7 | , genNodeId | ||
8 | |||
9 | -- * Node address | ||
10 | , NodeAddr (..) | ||
11 | |||
12 | -- * Node info | ||
13 | , NodeInfo (..) | ||
14 | ) where | ||
15 | |||
16 | import Control.Applicative | ||
17 | import Data.Aeson (ToJSON, FromJSON) | ||
18 | import Data.Aeson.TH | ||
19 | import Data.ByteString as BS | ||
20 | import Data.BEncode as BE | ||
21 | import Data.Serialize as S | ||
22 | import Network | ||
23 | import System.Entropy | ||
24 | |||
25 | import Data.Torrent.JSON | ||
26 | import Network.BitTorrent.Core.PeerAddr () | ||
27 | |||
28 | {----------------------------------------------------------------------- | ||
29 | -- Node id | ||
30 | -----------------------------------------------------------------------} | ||
31 | |||
32 | -- | Normally, /this/ node id should we saved between invocations of | ||
33 | -- the client software. | ||
34 | newtype NodeId = NodeId ByteString | ||
35 | deriving (Show, Eq, FromJSON, ToJSON) | ||
36 | |||
37 | nodeIdSize :: Int | ||
38 | nodeIdSize = 20 | ||
39 | |||
40 | instance Serialize NodeId where | ||
41 | get = NodeId <$> getByteString nodeIdSize | ||
42 | {-# INLINE get #-} | ||
43 | put (NodeId bs) = putByteString bs | ||
44 | {-# INLINE put #-} | ||
45 | |||
46 | -- TODO WARN is the 'system' random suitable for this? | ||
47 | -- | Generate random NodeID used for the entire session. | ||
48 | -- Distribution of ID's should be as uniform as possible. | ||
49 | -- | ||
50 | genNodeId :: IO NodeId | ||
51 | genNodeId = NodeId <$> getEntropy nodeIdSize | ||
52 | |||
53 | type Distance = NodeId | ||
54 | |||
55 | {----------------------------------------------------------------------- | ||
56 | -- Node address | ||
57 | -----------------------------------------------------------------------} | ||
58 | |||
59 | data NodeAddr a = NodeAddr | ||
60 | { nodeHost :: !a | ||
61 | , nodePort :: {-# UNPACK #-} !PortNumber | ||
62 | } deriving (Show, Eq) | ||
63 | |||
64 | $(deriveJSON omitRecordPrefix ''NodeAddr) | ||
65 | |||
66 | -- | KRPC compatible encoding. | ||
67 | instance Serialize a => Serialize (NodeAddr a) where | ||
68 | get = NodeAddr <$> get <*> get | ||
69 | put NodeAddr {..} = put nodeHost >> put nodePort | ||
70 | |||
71 | -- | Torrent file compatible encoding. | ||
72 | instance BEncode a => BEncode (NodeAddr a) where | ||
73 | toBEncode NodeAddr {..} = toBEncode (nodeHost, nodePort) | ||
74 | {-# INLINE toBEncode #-} | ||
75 | fromBEncode b = uncurry NodeAddr <$> fromBEncode b | ||
76 | {-# INLINE fromBEncode #-} | ||
77 | |||
78 | {----------------------------------------------------------------------- | ||
79 | -- Node info | ||
80 | -----------------------------------------------------------------------} | ||
81 | |||
82 | data NodeInfo a = NodeInfo | ||
83 | { nodeId :: !NodeId | ||
84 | , nodeAddr :: !(NodeAddr a) | ||
85 | } deriving (Show, Eq) | ||
86 | |||
87 | $(deriveJSON omitRecordPrefix ''NodeInfo) | ||
88 | |||
89 | -- | KRPC 'compact list' compatible encoding. | ||
90 | instance Serialize a => Serialize (NodeInfo a) where | ||
91 | get = NodeInfo <$> get <*> get | ||
92 | put NodeInfo {..} = put nodeId >> put nodeAddr | ||
93 | |||
94 | type CompactInfo = ByteString | ||
95 | |||
96 | data NodeList a = CompactNodeList [NodeInfo a] | ||
97 | |||
98 | decodeCompact :: Serialize a => CompactInfo -> [NodeInfo a] | ||
99 | decodeCompact = either (const []) id . S.runGet (many get) | ||
100 | |||
101 | encodeCompact :: [NodeId] -> CompactInfo | ||
102 | encodeCompact = S.runPut . mapM_ put | ||
103 | |||
104 | --decodePeerList :: [BEncode] -> [PeerAddr] | ||
105 | --decodePeerList = undefined | ||
106 | |||
107 | --encodePeerList :: [PeerAddr] -> [BEncode] | ||
108 | --encodePeerList = undefined | ||