diff options
-rw-r--r-- | examples/dhtd.hs | 19 | ||||
-rw-r--r-- | src/Control/Concurrent/Lifted/Instrument.hs | 1 |
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 | |||
36 | import Control.Exception.Lifted as Lifted | 36 | import Control.Exception.Lifted as Lifted |
37 | #ifdef THREAD_DEBUG | 37 | #ifdef THREAD_DEBUG |
38 | import Control.Concurrent.Lifted.Instrument | 38 | import Control.Concurrent.Lifted.Instrument |
39 | import Data.Time () | ||
39 | import Data.Time.Clock | 40 | import Data.Time.Clock |
40 | #else | 41 | #else |
41 | import Control.Concurrent | 42 | import Control.Concurrent |
42 | #endif | 43 | #endif |
44 | import System.Environment | ||
43 | 45 | ||
44 | mkNodeAddr :: SockAddr -> NodeAddr IPv4 | 46 | mkNodeAddr :: SockAddr -> NodeAddr IPv4 |
45 | mkNodeAddr addr = NodeAddr (fromJust $ fromSockAddr addr) | 47 | mkNodeAddr 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 | ||
108 | godht :: forall b. (NodeAddr IPv4 -> NodeId -> DHT IPv4 b) -> IO b | 110 | godht :: String -> (NodeAddr IPv4 -> NodeId -> DHT IPv4 b) -> IO b |
109 | godht f = do | 111 | godht 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 | ||
189 | defaultPort = error "TODO defaultPort" | ||
190 | |||
187 | main :: IO () | 191 | main :: IO () |
188 | main = do | 192 | main = 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 | |||
19 | import Control.Monad.Base | 19 | import Control.Monad.Base |
20 | -- import Control.Monad.IO.Class | 20 | -- import Control.Monad.IO.Class |
21 | import qualified GHC.Conc as GHC | 21 | import qualified GHC.Conc as GHC |
22 | import Data.Time() | ||
22 | import Data.Time.Clock | 23 | import Data.Time.Clock |
23 | 24 | ||
24 | data PerThread = PerThread | 25 | data PerThread = PerThread |