diff --git a/app/Experiment.hs b/app/Experiment.hs index deb4cae..ffa8869 100644 --- a/app/Experiment.hs +++ b/app/Experiment.hs @@ -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