From d2ac4c0728b933929dad6e13083abc40be1b6f82 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Wed, 19 Feb 2014 04:21:39 +0400
Subject: Add MonadResource instance for DHT

---
 src/Network/BitTorrent/DHT/Session.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index b4ff0208..75d3294f 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -250,6 +250,7 @@ newtype DHT ip a = DHT { unDHT :: ReaderT (Node ip) IO a }
   deriving ( Functor, Applicative, Monad
            , MonadIO, MonadBase IO
            , MonadReader (Node ip)
+           , MonadThrow, MonadUnsafeIO
            )
 
 instance MonadBaseControl IO (DHT ip) where
@@ -263,6 +264,12 @@ instance MonadBaseControl IO (DHT ip) where
   restoreM = DHT . restoreM . unSt
   {-# INLINE restoreM #-}
 
+-- | All allocated resources will be closed at 'stopNode'.
+instance MonadResource (DHT ip) where
+  liftResourceT m = do
+    s <- asks resources
+    liftIO $ runInternalState m s
+
 instance MonadKRPC (DHT ip) (DHT ip) where
   getManager = asks manager
 
-- 
cgit v1.2.3