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
|
-- |
-- Copyright : (c) Sam Truzjan 2013, 2014
-- License : BSD3
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : portable
--
-- Normally, you don't need to import this module.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Network.KRPC.Method
( Method (..)
, KRPC (..)
) where
#ifdef VERSION_bencoding
import Data.BEncode (BEncode)
#else
import Data.Serialize
#endif
import Data.ByteString.Char8 as BC
import Data.Char
import Data.Monoid
import Data.List as L
import Data.String
import Data.Typeable
import Network.DatagramServer.Mainline
import Network.DatagramServer.Types
import Network.DHT.Types
-- | Method datatype used to describe method name, parameters and
-- return values of procedure. Client use a method to /invoke/, server
-- /implements/ the method to make the actual work.
--
-- We use the following fantom types to ensure type-safiety:
--
-- * param: Type of method parameters.
--
-- * result: Type of return value of the method.
--
newtype Method dht param result = Method { methodName :: QueryMethod dht }
deriving instance Eq (QueryMethod dht) => Eq (Method dht param result)
deriving instance Ord (QueryMethod dht) => Ord (Method dht param result)
deriving instance IsString (QueryMethod dht) => IsString (Method dht param result)
deriving instance BEncode (QueryMethod dht) => BEncode (Method dht param result)
-- | Example:
--
-- @show (Method \"concat\" :: [Int] Int) == \"concat :: [Int] -> Int\"@
--
instance (Show (QueryMethod dht), Typeable a, Typeable b) => Show (Method dht a b) where
showsPrec _ = showsMethod
showsMethod :: forall dht a b. ( Show (QueryMethod dht), Typeable a , Typeable b ) => Method dht a b -> ShowS
showsMethod (Method name) =
-- showString (BC.unpack name) <>
shows (show name) <>
showString " :: " <>
shows paramsTy <>
showString " -> " <>
shows valuesTy
where
impossible = error "KRPC.showsMethod: impossible"
paramsTy = typeOf (impossible :: a)
valuesTy = typeOf (impossible :: b)
-- | In order to perform or handle KRPC query you need to provide
-- corresponding 'KRPC' class.
--
-- Example:
--
-- @
-- data Ping = Ping Text deriving BEncode
-- data Pong = Pong Text deriving BEncode
--
-- instance 'KRPC' Ping Pong where
-- method = \"ping\"
-- @
--
class ( Typeable req, Typeable resp)
=> KRPC dht req resp | req -> resp, resp -> req where
-- | Method name. Default implementation uses lowercased @req@
-- datatype name.
--
method :: Method dht req resp
-- TODO add underscores
default method :: (IsString (QueryMethod dht), Typeable req) => Method dht req resp
method = Method $ fromString $ L.map toLower $ show $ typeOf hole
where
hole = error "krpc.method: impossible" :: req
validateExchange :: dht req -> dht resp -> Bool
validateExchange _ _ = True
makeQueryExtra :: DHTData dht ip -> Proxy req -> Proxy resp -> IO (QueryExtra dht)
makeResponseExtra :: DHTData dht ip -> req -> Proxy resp -> IO (ResponseExtra dht)
|
