agitprop.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import           Paths_amqp_utils              ( version )
   4 import           Data.Version                  ( showVersion )
   5 import           System.Environment
   6 import qualified Data.Text                     as T
   7 import           Network.AMQP
   8 import           Network.AMQP.Utils.Options
   9 import           Network.AMQP.Utils.Helpers
  10 import           Network.AMQP.Utils.Connection
  11 import qualified Data.ByteString.Lazy.Char8    as BL
  12 import           Data.Word                     ( Word64 )
  13
  14 main :: IO ()
  15 main = do
  16     hr "starting"
  17     --  tid <- myThreadId
  18     args <- getArgs >>= parseargs "agitprop"
  19     printparam' "client version" $ "amqp-utils " ++ (showVersion version)
  20     printparam' "routing key" $ rKey args
  21     printparam' "input file" $
  22         (inputFile args) ++ if (lineMode args) then " (line-by-line)" else ""
  23     messageFile <- BL.readFile (inputFile args)
  24     (conn, chan) <- connect args
  25     printparam' "confirm mode" $ show $ confirm args
  26     if (confirm args)
  27         then do
  28             confirmSelect chan False
  29             addConfirmationListener chan confirmCallback
  30         else return ()
  31     let publishOneMsg f = do
  32             r <- publishMsg chan
  33                             (T.pack $ currentExchange args)
  34                             (T.pack $ rKey args)
  35                             newMsg { msgBody = f
  36                                    , msgDeliveryMode = Just Persistent
  37                                    }
  38             printparam "sent" $ fmap show r
  39     if (lineMode args)
  40         then mapM_ publishOneMsg (BL.lines messageFile)
  41         else publishOneMsg messageFile
  42
  43     if (confirm args)
  44         then waitForConfirms chan >>= return . show >> return ()
  45         else return ()
  46     closeConnection conn
  47
  48 -- | The handler for publisher confirms
  49 confirmCallback :: (Word64, Bool, AckType) -> IO ()
  50 confirmCallback (deliveryTag, isAll, ackType) =
  51     printparam' "confirmed"
  52                 ((show deliveryTag) ++
  53                      (if isAll then " all " else " this ") ++ (show ackType))