52 lines
2 KiB
Haskell
52 lines
2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main where
|
|
|
|
import Control.Concurrent
|
|
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)
|
|
|
|
-- 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 entry = error $ "invalid schedule input format: " <> show entry
|
|
|
|
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
|
|
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
|