45 lines
1.4 KiB
Haskell
45 lines
1.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main where
|
|
|
|
import System.Random
|
|
import Control.Concurrent
|
|
import Control.Monad (forM_)
|
|
import Control.Monad.State.Class
|
|
import Control.Monad.State.Strict (evalStateT)
|
|
import Control.Monad.IO.Class
|
|
import qualified Network.HTTP.Client as HTTP
|
|
|
|
import Hash2Pub.PostService (clientPublishPost, Hashtag)
|
|
|
|
-- 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)
|
|
]
|
|
|
|
main :: IO ()
|
|
main = 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
|