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:
Trolli Schmittlauch 2020-09-02 21:37:01 +02:00
parent 1aee41db88
commit 59beb3441f

View file

@ -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