forked from schmittlauch/Hash2Pub
		
	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
					
				
					 1 changed files with 39 additions and 32 deletions
				
			
		|  | @ -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 | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue