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

@ -3,42 +3,49 @@
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 Network.HTTP.Client as HTTP
import System.Random
import Control.Monad (forM_)
import qualified Data.Text.Lazy as Txt
import qualified Data.Text.Lazy.IO as TxtI
import qualified Network.HTTP.Client as HTTP
import System.Environment (getArgs)
import Hash2Pub.PostService (Hashtag, clientPublishPost)
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