parent
0ffe9effc0
commit
72eca0f4fe
13
app/Main.hs
13
app/Main.hs
|
@ -54,8 +54,8 @@ readConfig = do
|
||||||
bootstrapHost : bootstrapPortString : _ ->
|
bootstrapHost : bootstrapPortString : _ ->
|
||||||
[(bootstrapHost, read bootstrapPortString)]
|
[(bootstrapHost, read bootstrapPortString)]
|
||||||
_ -> []
|
_ -> []
|
||||||
fConf = FediChordConf {
|
fConf = FediChordConf
|
||||||
confDomain = confDomainString
|
{ confDomain = confDomainString
|
||||||
, confIP = toHostAddress6 . read $ ipString
|
, confIP = toHostAddress6 . read $ ipString
|
||||||
, confDhtPort = read portString
|
, confDhtPort = read portString
|
||||||
, confBootstrapNodes = confBootstrapNodes'
|
, confBootstrapNodes = confBootstrapNodes'
|
||||||
|
@ -67,11 +67,12 @@ readConfig = do
|
||||||
, confResponsePurgeAge = 60 / fromIntegral speedup
|
, confResponsePurgeAge = 60 / fromIntegral speedup
|
||||||
, confRequestTimeout = 5 * 10^6 `div` speedup
|
, confRequestTimeout = 5 * 10^6 `div` speedup
|
||||||
, confRequestRetries = 3
|
, confRequestRetries = 3
|
||||||
}
|
}
|
||||||
sConf = ServiceConf {
|
sConf = ServiceConf
|
||||||
confSubscriptionExpiryTime = fromIntegral $ 2*3600 `div` speedup
|
{ confSubscriptionExpiryTime = fromIntegral $ 2*3600 `div` speedup
|
||||||
, confServicePort = read servicePortString
|
, confServicePort = read servicePortString
|
||||||
, confServiceHost = confDomainString
|
, confServiceHost = confDomainString
|
||||||
}
|
, confLogfilePath = "../simulationData/logs/" <> confDomainString <> ".log"
|
||||||
|
}
|
||||||
pure (fConf, sConf)
|
pure (fConf, sConf)
|
||||||
|
|
||||||
|
|
|
@ -457,6 +457,8 @@ data ServiceConf = ServiceConf
|
||||||
-- ^ listening port for service
|
-- ^ listening port for service
|
||||||
, confServiceHost :: String
|
, confServiceHost :: String
|
||||||
-- ^ hostname of service
|
-- ^ hostname of service
|
||||||
|
, confLogfilePath :: String
|
||||||
|
-- ^ where to store the (measurement) log file
|
||||||
}
|
}
|
||||||
|
|
||||||
class DHT d where
|
class DHT d where
|
||||||
|
|
|
@ -25,6 +25,7 @@ import Data.Maybe (fromJust, isJust)
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
import Data.Text.Lazy (Text)
|
import Data.Text.Lazy (Text)
|
||||||
import qualified Data.Text.Lazy as Txt
|
import qualified Data.Text.Lazy as Txt
|
||||||
|
import qualified Data.Text.Lazy.IO as TxtI
|
||||||
import Data.Text.Normalize (NormalizationMode (NFC), normalize)
|
import Data.Text.Normalize (NormalizationMode (NFC), normalize)
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
import Data.Typeable (Typeable)
|
import Data.Typeable (Typeable)
|
||||||
|
@ -109,6 +110,8 @@ instance DHT d => Service PostService d where
|
||||||
}
|
}
|
||||||
port' = fromIntegral (confServicePort conf)
|
port' = fromIntegral (confServicePort conf)
|
||||||
warpSettings = Warp.setPort port' . Warp.setHost (fromString . confServiceHost $ conf) $ Warp.defaultSettings
|
warpSettings = Warp.setPort port' . Warp.setHost (fromString . confServiceHost $ conf) $ Warp.defaultSettings
|
||||||
|
-- log a start message, this also truncates existing files
|
||||||
|
TxtI.writeFile (confLogfilePath conf) "# Starting mock relay implementation\n"
|
||||||
-- Run 'concurrently_' from another thread to be able to return the
|
-- Run 'concurrently_' from another thread to be able to return the
|
||||||
-- 'PostService'.
|
-- 'PostService'.
|
||||||
-- Terminating that parent thread will make all child threads terminate as well.
|
-- Terminating that parent thread will make all child threads terminate as well.
|
||||||
|
@ -745,10 +748,18 @@ evaluateStatsThread serv statsAcc = getPOSIXTime >>= loop
|
||||||
-- be read afterwards
|
-- be read afterwards
|
||||||
now <- getPOSIXTime
|
now <- getPOSIXTime
|
||||||
-- evaluate stats rate and replace server stats
|
-- evaluate stats rate and replace server stats
|
||||||
atomically . writeTVar (loadStats serv) . evaluateStats (now - previousTs) $ summedStats
|
|
||||||
-- idea: let another thread periodically exchange the RelayStats, modify it atomically (Konzept "unterm Arsch wegziehen")
|
|
||||||
-- and now what? write a log to file, probably as a forkIO
|
|
||||||
-- persistently store in a TVar so it can be retrieved later by the DHT
|
-- persistently store in a TVar so it can be retrieved later by the DHT
|
||||||
|
atomically . writeTVar (loadStats serv) . evaluateStats (now - previousTs) $ summedStats
|
||||||
|
-- and now what? write a log to file
|
||||||
|
-- format: total relayReceiveRates;total relayDeliveryRates;postFetchRate;postPublishRate
|
||||||
|
-- later: current (reported) load, target load
|
||||||
|
TxtI.appendFile (confLogfilePath . serviceConf $ serv) $
|
||||||
|
Txt.intercalate ";" (Txt.pack <$> (
|
||||||
|
[ show . sum . relayReceiveRates
|
||||||
|
, show . sum . relayDeliveryRates
|
||||||
|
, show . postPublishRate
|
||||||
|
, show . postFetchRate
|
||||||
|
] <*> pure summedStats)) <> "\n"
|
||||||
loop now
|
loop now
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue