2 files changed, 18 insertions, 0 deletions

diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index 75d3294f..a452b764 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -264,6 +264,12 @@ instance MonadBaseControl IO (DHT ip) where
   restoreM = DHT . restoreM . unSt
   {-# INLINE restoreM #-}
 
+-- | Check is it is possible to run 'queryNode' or handle pending
+-- query from remote node.
+instance MonadActive (DHT ip) where
+  monadActive = getManager >>= liftIO . isActive
+  {-# INLINE monadActive #-}
+
 -- | All allocated resources will be closed at 'stopNode'.
 instance MonadResource (DHT ip) where
   liftResourceT m = do
diff --git a/tests/Network/BitTorrent/DHT/SessionSpec.hs b/tests/Network/BitTorrent/DHT/SessionSpec.hs
index 381aa77d..343c8ab6 100644
--- a/tests/Network/BitTorrent/DHT/SessionSpec.hs
+++ b/tests/Network/BitTorrent/DHT/SessionSpec.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Network.BitTorrent.DHT.SessionSpec (spec) where
 import Control.Monad.Reader
+import Control.Monad.Trans.Resource
 import Data.Default
 import Data.List as L
 import Test.Hspec
@@ -29,8 +30,19 @@ isRight (Right _) = True
 isLeft :: Either a b -> Bool
 isLeft = not . isRight
 
+nullLogger :: LogFun
+nullLogger _ _ _ _ = return ()
+
 spec :: Spec
 spec = do
+  describe "session" $ do
+    it "is active until stopNode called" $ do
+      node <- startNode [] def myAddr nullLogger
+      runDHT node monadActive `shouldReturn` True
+      runDHT node monadActive `shouldReturn` True
+      stopNode node
+      runDHT node monadActive `shouldReturn` False
+
   describe "tokens" $ do
     it "should not complain about valid token" $
       property $ \ (addrs :: [NodeAddr IPv4]) -> do