instrumentation script executes the prepared schedule
- reads CSV schedule from file - sends the given schedule of post events - not thoroughly tested yet implements #59
This commit is contained in:
parent
1aee41db88
commit
59beb3441f
|
@ -4,41 +4,48 @@ module Main where
|
|||
|
||||
import Control.Concurrent
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.State.Class
|
||||
import Control.Monad.State.Strict (evalStateT)
|
||||
import qualified Data.Text.Lazy as Txt
|
||||
import qualified Data.Text.Lazy.IO as TxtI
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import System.Random
|
||||
import System.Environment (getArgs)
|
||||
|
||||
import Hash2Pub.PostService (Hashtag, clientPublishPost)
|
||||
|
||||
-- placeholder post data definition
|
||||
|
||||
tagsToPostTo = [ "JustSomeTag", "WantAnotherTag234", "HereWeGoAgain", "Oyä", "通信端末" ]
|
||||
|
||||
knownRelays :: [(String, Int)]
|
||||
knownRelays =
|
||||
[ ("animalliberation.social", 3342)
|
||||
, ("hostux.social", 3343)
|
||||
, ("social.diskseven.com", 3344)
|
||||
, ("social.imirhil.fr", 3345)
|
||||
]
|
||||
-- configuration constants
|
||||
timelineFile = "../simulationData/inputs/generated/timeline_sample.csv"
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
-- read CLI parameters
|
||||
speedupStr : _ <- getArgs
|
||||
-- read and parse timeline schedule
|
||||
-- relying on lazyness of HaskellIO, hoping it does not introduce too strong delays
|
||||
postEvents <- parseSchedule <$> TxtI.readFile timelineFile
|
||||
-- actually schedule and send the post events
|
||||
executeSchedule (read speedupStr) postEvents
|
||||
pure ()
|
||||
|
||||
|
||||
|
||||
parseSchedule :: Txt.Text
|
||||
-> [(Int, Hashtag, (String, Int))] -- ^ [(delay in microseconds, hashtag, (hostname, port))]
|
||||
parseSchedule = fmap (parseEntry . Txt.split (== ';')) . Txt.lines
|
||||
where
|
||||
parseEntry [delayT, contactT, tag] =
|
||||
(read $ Txt.unpack delayT, tag, read $ Txt.unpack contactT)
|
||||
parseEntry _ = error "invalid schedule input format"
|
||||
|
||||
executeSchedule :: Int -- ^ speedup factor
|
||||
-> [(Int, Hashtag, (String, Int))] -- ^ [(delay in microseconds, hashtag, (hostname, port))]
|
||||
-> IO ()
|
||||
executeSchedule speedup events = do
|
||||
-- initialise HTTP manager
|
||||
httpMan <- HTTP.newManager HTTP.defaultManagerSettings
|
||||
-- initialise RNG
|
||||
let initRGen = mkStdGen 12
|
||||
-- cycle through tags and post to a random instance
|
||||
evalStateT (forM_ (cycle tagsToPostTo) $ publishPostRandom httpMan) initRGen
|
||||
-- wait for a specified time
|
||||
|
||||
publishPostRandom :: (RandomGen g, MonadIO m, MonadState g m) => HTTP.Manager -> Hashtag -> m ()
|
||||
publishPostRandom httpman tag = do
|
||||
index <- state $ randomR (0, length knownRelays - 1)
|
||||
let (pubHost, pubPort) = knownRelays !! index
|
||||
_ <- liftIO . forkIO $ do
|
||||
postResult <- liftIO $ clientPublishPost httpman pubHost pubPort ("foobar #" <> tag)
|
||||
either putStrLn (const $ pure ()) postResult
|
||||
liftIO $ threadDelay 500
|
||||
forM_ events $ \(delay, tag, (pubHost, pubPort)) -> do
|
||||
_ <- forkIO $
|
||||
clientPublishPost httpMan pubHost pubPort ("foobar #" <> tag)
|
||||
>>= either putStrLn (const $ pure ())
|
||||
-- while threadDelay gives only minimum delay guarantees, let's hope the
|
||||
-- additional delays are negligible
|
||||
-- otherwise: evaluate usage of https://hackage.haskell.org/package/schedule-0.3.0.0/docs/Data-Schedule.html
|
||||
threadDelay $ delay `div` speedup
|
||||
|
|
Loading…
Reference in a new issue