blob: 7fb0e571cb499777703058f93f8ead68872c5329 (
plain)
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
|
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Network.RPC where
import Data.Bits
import Data.ByteString (ByteString)
import Data.Kind (Constraint)
import Data.Data
import Network.Socket
import Text.PrettyPrint.HughesPJClass hiding (($$), (<>))
import Data.Serialize as S
import qualified Data.ByteString.Char8 as Char8
import Data.ByteString.Base16 as Base16
data MessageClass = Error | Query | Response
deriving (Eq,Ord,Enum,Bounded,Data,Show,Read)
class Envelope envelope where
type TransactionID envelope
type NodeId envelope
envelopePayload :: envelope a -> a
envelopeTransaction :: envelope a -> TransactionID envelope
envelopeClass :: envelope a -> MessageClass
-- | > buildReply self addr qry response
--
-- [ self ] this node's id.
--
-- [ addr ] SockAddr of query origin.
--
-- [ qry ] received query message.
--
-- [ response ] response payload.
--
-- Returns: response message envelope
buildReply :: NodeId envelope -> SockAddr -> envelope a -> b -> envelope b
-- | In Kademlia, the distance metric is XOR and the result is
-- interpreted as an unsigned integer.
newtype NodeDistance nodeid = NodeDistance nodeid
deriving (Eq, Ord)
-- | distance(A,B) = |A xor B| Smaller values are closer.
distance :: Bits nid => nid -> nid -> NodeDistance nid
distance a b = NodeDistance $ xor a b
instance Serialize nodeid => Show (NodeDistance nodeid) where
show (NodeDistance w) = Char8.unpack $ Base16.encode $ S.encode w
instance Serialize nodeid => Pretty (NodeDistance nodeid) where
pPrint n = text $ show n
class Envelope envelope => WireFormat raw envelope where
type SerializableTo raw :: * -> Constraint
type CipherContext raw envelope
decodeHeaders :: CipherContext raw envelope -> ByteString -> Either String (envelope raw)
decodePayload :: SerializableTo raw a => envelope raw -> Either String (envelope a)
encodeHeaders :: CipherContext raw envelope -> envelope raw -> ByteString
encodePayload :: SerializableTo raw a => envelope a -> envelope raw
|
