summaryrefslogtreecommitdiff
path: root/src/Network/KRPC
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/KRPC')
-rw-r--r--src/Network/KRPC/Manager.hs31
1 files changed, 22 insertions, 9 deletions
diff --git a/src/Network/KRPC/Manager.hs b/src/Network/KRPC/Manager.hs
index a8c90b33..a883a34a 100644
--- a/src/Network/KRPC/Manager.hs
+++ b/src/Network/KRPC/Manager.hs
@@ -50,8 +50,13 @@ type CallRes = MVar KResult
50type PendingCalls = IORef (Map CallId CallRes) 50type PendingCalls = IORef (Map CallId CallRes)
51 51
52type HandlerBody h = SockAddr -> BValue -> h (BE.Result BValue) 52type HandlerBody h = SockAddr -> BValue -> h (BE.Result BValue)
53
54-- | Handler is a function which will be invoked then some /remote/
55-- node querying /this/ node.
53type Handler h = (MethodName, HandlerBody h) 56type Handler h = (MethodName, HandlerBody h)
54 57
58-- | Keep track pending queries made by /this/ node and handle queries
59-- made by /remote/ nodes.
55data Manager h = Manager 60data Manager h = Manager
56 { sock :: !Socket 61 { sock :: !Socket
57 , queryTimeout :: !Int -- ^ in seconds 62 , queryTimeout :: !Int -- ^ in seconds
@@ -61,12 +66,15 @@ data Manager h = Manager
61 , handlers :: [Handler h] 66 , handlers :: [Handler h]
62 } 67 }
63 68
69-- | A monad which can perform or handle queries.
64class (MonadBaseControl IO m, MonadIO m) => MonadKRPC h m | m -> h where 70class (MonadBaseControl IO m, MonadIO m) => MonadKRPC h m | m -> h where
71 -- | Ask for manager.
65 getManager :: m (Manager h) 72 getManager :: m (Manager h)
66 73
67 default getManager :: MonadReader (Manager h) m => m (Manager h) 74 default getManager :: MonadReader (Manager h) m => m (Manager h)
68 getManager = ask 75 getManager = ask
69 76
77 -- | Can be used to add logging for instance.
70 liftHandler :: h a -> m a 78 liftHandler :: h a -> m a
71 79
72 default liftHandler :: m a -> m a 80 default liftHandler :: m a -> m a
@@ -87,7 +95,11 @@ seedTransaction = 0
87defaultQueryTimeout :: Int 95defaultQueryTimeout :: Int
88defaultQueryTimeout = 120 96defaultQueryTimeout = 120
89 97
90newManager :: SockAddr -> [Handler h] -> IO (Manager h) 98-- | Bind socket to the specified address. To enable query handling
99-- run 'listen'.
100newManager :: SockAddr -- ^ address to listen on;
101 -> [Handler h] -- ^ handlers to run on incoming queries.
102 -> IO (Manager h) -- ^ new manager.
91newManager servAddr handlers = do 103newManager servAddr handlers = do
92 sock <- bindServ 104 sock <- bindServ
93 tref <- newEmptyMVar 105 tref <- newEmptyMVar
@@ -110,18 +122,19 @@ closeManager Manager {..} = do
110 -- TODO unblock calls 122 -- TODO unblock calls
111 close sock 123 close sock
112 124
113-- | Normally you should use Control.Monad.Trans.allocate function. 125-- | Normally you should use Control.Monad.Trans.Resource.allocate
126-- function.
114withManager :: SockAddr -> [Handler h] -> (Manager h -> IO a) -> IO a 127withManager :: SockAddr -> [Handler h] -> (Manager h -> IO a) -> IO a
115withManager addr hs = bracket (newManager addr hs) closeManager 128withManager addr hs = bracket (newManager addr hs) closeManager
116 129
117sendMessage :: MonadIO m => BEncode a => Socket -> SockAddr -> a -> m ()
118sendMessage sock addr a = do
119 liftIO $ sendManyTo sock (BL.toChunks (BE.encode a)) addr
120
121{----------------------------------------------------------------------- 130{-----------------------------------------------------------------------
122-- Client 131-- Client
123-----------------------------------------------------------------------} 132-----------------------------------------------------------------------}
124 133
134sendMessage :: MonadIO m => BEncode a => Socket -> SockAddr -> a -> m ()
135sendMessage sock addr a = do
136 liftIO $ sendManyTo sock (BL.toChunks (BE.encode a)) addr
137
125genTransactionId :: TransactionCounter -> IO TransactionId 138genTransactionId :: TransactionCounter -> IO TransactionId
126genTransactionId ref = do 139genTransactionId ref = do
127 cur <- atomicModifyIORef' ref $ \ cur -> (succ cur, cur) 140 cur <- atomicModifyIORef' ref $ \ cur -> (succ cur, cur)
@@ -148,7 +161,7 @@ queryResponse ares = do
148 Right r -> pure r 161 Right r -> pure r
149 Left e -> throwIO $ decodeError e respId 162 Left e -> throwIO $ decodeError e respId
150 163
151-- | 164-- | Enqueue query to the given node.
152-- 165--
153-- This function will throw exception if quered node respond with 166-- This function will throw exception if quered node respond with
154-- @error@ message or timeout expires. 167-- @error@ message or timeout expires.
@@ -178,8 +191,8 @@ query addr params = do
178-- Handlers 191-- Handlers
179-----------------------------------------------------------------------} 192-----------------------------------------------------------------------}
180 193
181-- | Any thrown exception will be supressed and send over wire back to 194-- | Make handler from handler function. Any thrown exception will be
182-- the quering node. 195-- supressed and send over the wire back to the querying node.
183handler :: forall h a b. (KRPC a b, Monad h) 196handler :: forall h a b. (KRPC a b, Monad h)
184 => (SockAddr -> a -> h b) -> Handler h 197 => (SockAddr -> a -> h b) -> Handler h
185handler body = (name, wrapper) 198handler body = (name, wrapper)