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
				
			
		|  | @ -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…
	
	Add table
		Add a link
		
	
		Reference in a new issue