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
|
@ -3,42 +3,49 @@
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad (forM_)
|
import Control.Monad (forM_)
|
||||||
import Control.Monad.IO.Class
|
import qualified Data.Text.Lazy as Txt
|
||||||
import Control.Monad.State.Class
|
import qualified Data.Text.Lazy.IO as TxtI
|
||||||
import Control.Monad.State.Strict (evalStateT)
|
import qualified Network.HTTP.Client as HTTP
|
||||||
import qualified Network.HTTP.Client as HTTP
|
import System.Environment (getArgs)
|
||||||
import System.Random
|
|
||||||
|
|
||||||
import Hash2Pub.PostService (Hashtag, clientPublishPost)
|
import Hash2Pub.PostService (Hashtag, clientPublishPost)
|
||||||
|
|
||||||
-- placeholder post data definition
|
-- configuration constants
|
||||||
|
timelineFile = "../simulationData/inputs/generated/timeline_sample.csv"
|
||||||
tagsToPostTo = [ "JustSomeTag", "WantAnotherTag234", "HereWeGoAgain", "Oyä", "通信端末" ]
|
|
||||||
|
|
||||||
knownRelays :: [(String, Int)]
|
|
||||||
knownRelays =
|
|
||||||
[ ("animalliberation.social", 3342)
|
|
||||||
, ("hostux.social", 3343)
|
|
||||||
, ("social.diskseven.com", 3344)
|
|
||||||
, ("social.imirhil.fr", 3345)
|
|
||||||
]
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
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
|
-- initialise HTTP manager
|
||||||
httpMan <- HTTP.newManager HTTP.defaultManagerSettings
|
httpMan <- HTTP.newManager HTTP.defaultManagerSettings
|
||||||
-- initialise RNG
|
forM_ events $ \(delay, tag, (pubHost, pubPort)) -> do
|
||||||
let initRGen = mkStdGen 12
|
_ <- forkIO $
|
||||||
-- cycle through tags and post to a random instance
|
clientPublishPost httpMan pubHost pubPort ("foobar #" <> tag)
|
||||||
evalStateT (forM_ (cycle tagsToPostTo) $ publishPostRandom httpMan) initRGen
|
>>= either putStrLn (const $ pure ())
|
||||||
-- wait for a specified time
|
-- while threadDelay gives only minimum delay guarantees, let's hope the
|
||||||
|
-- additional delays are negligible
|
||||||
publishPostRandom :: (RandomGen g, MonadIO m, MonadState g m) => HTTP.Manager -> Hashtag -> m ()
|
-- otherwise: evaluate usage of https://hackage.haskell.org/package/schedule-0.3.0.0/docs/Data-Schedule.html
|
||||||
publishPostRandom httpman tag = do
|
threadDelay $ delay `div` speedup
|
||||||
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
|
|
||||||
|
|
Loading…
Reference in a new issue