summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/dhtd.hs19
-rw-r--r--src/Control/Concurrent/Lifted/Instrument.hs1
2 files changed, 15 insertions, 5 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 569e1d3d..337e7d0d 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -36,10 +36,12 @@ import Network.StreamServer
36import Control.Exception.Lifted as Lifted 36import Control.Exception.Lifted as Lifted
37#ifdef THREAD_DEBUG 37#ifdef THREAD_DEBUG
38import Control.Concurrent.Lifted.Instrument 38import Control.Concurrent.Lifted.Instrument
39import Data.Time ()
39import Data.Time.Clock 40import Data.Time.Clock
40#else 41#else
41import Control.Concurrent 42import Control.Concurrent
42#endif 43#endif
44import System.Environment
43 45
44mkNodeAddr :: SockAddr -> NodeAddr IPv4 46mkNodeAddr :: SockAddr -> NodeAddr IPv4
45mkNodeAddr addr = NodeAddr (fromJust $ fromSockAddr addr) 47mkNodeAddr addr = NodeAddr (fromJust $ fromSockAddr addr)
@@ -105,10 +107,10 @@ resume = do
105 restore_attempt 107 restore_attempt
106 return saved_nodes 108 return saved_nodes
107 109
108godht :: forall b. (NodeAddr IPv4 -> NodeId -> DHT IPv4 b) -> IO b 110godht :: String -> (NodeAddr IPv4 -> NodeId -> DHT IPv4 b) -> IO b
109godht f = do 111godht p f = do
110 a <- btBindAddr "8008" False 112 a <- btBindAddr p False
111 dht def { optTimeout = 5 } a allNoise $ do 113 dht def { optTimeout = 5 } a noDebugPrints $ do
112 me0 <- asks tentativeNodeId 114 me0 <- asks tentativeNodeId
113 printReport [("tentative node-id",show $ pPrint me0) 115 printReport [("tentative node-id",show $ pPrint me0)
114 ,("listen-address", show a) 116 ,("listen-address", show a)
@@ -184,9 +186,16 @@ clientSession st signalQuit sock n h = do
184 186
185 _ -> cmd0 $ hPutClient h "error." 187 _ -> cmd0 $ hPutClient h "error."
186 188
189defaultPort = error "TODO defaultPort"
190
187main :: IO () 191main :: IO ()
188main = do 192main = do
189 godht $ \a me0 -> do 193 args <- getArgs
194 p <- case take 2 (dropWhile (/="-p") args) of
195 ["-p",port] | not ("-" `isPrefixOf` port) -> return port
196 ("-p":_) -> error "Port not specified! (-p PORT)"
197 _ -> defaultPort
198 godht p $ \a me0 -> do
190 printTable 199 printTable
191 bs <- liftIO bootstrapNodes 200 bs <- liftIO bootstrapNodes
192 `onException` 201 `onException`
diff --git a/src/Control/Concurrent/Lifted/Instrument.hs b/src/Control/Concurrent/Lifted/Instrument.hs
index 9ec5deef..e5ed9d5e 100644
--- a/src/Control/Concurrent/Lifted/Instrument.hs
+++ b/src/Control/Concurrent/Lifted/Instrument.hs
@@ -19,6 +19,7 @@ import Control.Exception.Lifted
19import Control.Monad.Base 19import Control.Monad.Base
20-- import Control.Monad.IO.Class 20-- import Control.Monad.IO.Class
21import qualified GHC.Conc as GHC 21import qualified GHC.Conc as GHC
22import Data.Time()
22import Data.Time.Clock 23import Data.Time.Clock
23 24
24data PerThread = PerThread 25data PerThread = PerThread