agitprop.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import Control.Concurrent (threadDelay)
   4 import Control.Monad (forever)
   5 import qualified Data.ByteString.Lazy.Char8 as BL
   6 import qualified Data.Text as T
   7 import Data.Version (showVersion)
   8 import Data.Word (Word64)
   9 import Network.AMQP
  10 import Network.AMQP.Utils.Connection
  11 import Network.AMQP.Utils.Helpers
  12 import Network.AMQP.Utils.Options
  13 import Paths_amqp_utils (version)
  14 import System.Environment
  15 import System.INotify
  16 import qualified System.Posix.Files as F
  17
  18 main :: IO ()
  19 main = do
  20   hr "starting"
  21     --  tid <- myThreadId
  22   args <- getArgs >>= parseargs "agitprop"
  23   printparam' "client version" $ "amqp-utils " ++ (showVersion version)
  24   printparam' "routing key" $ rKey args
  25   isDir <- F.getFileStatus (inputFile args) >>= return . F.isDirectory
  26   if isDir
  27     then printparam' "hotfolder" $ inputFile args
  28     else printparam' "input file" $
  29          (inputFile args) ++
  30          if (lineMode args)
  31            then " (line-by-line)"
  32            else ""
  33   (conn, chan) <- connect args
  34   printparam' "confirm mode" $ show $ confirm args
  35   if (confirm args)
  36     then do
  37       confirmSelect chan False
  38       addConfirmationListener chan confirmCallback
  39     else return ()
  40   let publishOneMsg f = do
  41         r <-
  42           publishMsg
  43             chan
  44             (T.pack $ currentExchange args)
  45             (T.pack $ rKey args)
  46             newMsg {msgBody = f, msgDeliveryMode = Just Persistent}
  47         printparam "sent" $ fmap show r
  48   if isDir
  49     then do
  50       inotify <- initINotify
  51       wd <-
  52         addWatch inotify [Close] (inputFile args) (handleEvent publishOneMsg)
  53       hr (inputFile args)
  54       _ <- forever $ threadDelay 1000000
  55       removeWatch wd
  56     else do
  57       hr (inputFile args)
  58       messageFile <- BL.readFile (inputFile args)
  59       if (lineMode args)
  60         then mapM_ publishOneMsg (BL.lines messageFile)
  61         else publishOneMsg messageFile
  62     -- all done. wait and close.
  63   if (confirm args)
  64     then waitForConfirms chan >>= return . show >> return ()
  65     else return ()
  66   closeConnection conn
  67
  68 -- | The handler for publisher confirms
  69 confirmCallback :: (Word64, Bool, AckType) -> IO ()
  70 confirmCallback (deliveryTag, isAll, ackType) =
  71   printparam'
  72     "confirmed"
  73     ((show deliveryTag) ++
  74      (if isAll
  75         then " all "
  76         else " this ") ++
  77      (show ackType))
  78
  79 -- | hotfolder event handler
  80 handleEvent :: (BL.ByteString -> IO ()) -> Event -> IO ()
  81 handleEvent f (Closed False (Just x) True) = hr x >> BL.readFile x >>= f
  82 handleEvent _ _ = return ()