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 import qualified System.Posix.Files            as F
  14 import           System.INotify
  15 import           Control.Monad      ( forever )
  16 import           Control.Concurrent ( threadDelay )
  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" $ (inputFile args) ++ if (lineMode args) then " (line-by-line)" else ""
  29     (conn, chan) <- connect args
  30     printparam' "confirm mode" $ show $ confirm args
  31     if (confirm args)
  32         then do
  33             confirmSelect chan False
  34             addConfirmationListener chan confirmCallback
  35         else return ()
  36     let publishOneMsg f = do
  37             r <- publishMsg chan
  38                             (T.pack $ currentExchange args)
  39                             (T.pack $ rKey args)
  40                             newMsg { msgBody = f
  41                                    , msgDeliveryMode = Just Persistent
  42                                    }
  43             printparam "sent" $ fmap show r
  44     if isDir
  45         then do
  46             inotify <- initINotify
  47             wd <- addWatch inotify [ Close ] (inputFile args) (handleEvent publishOneMsg)
  48             hr (inputFile args)
  49             _ <- forever $ threadDelay 1000000
  50             removeWatch wd
  51         else do
  52             hr (inputFile args)
  53             messageFile <- BL.readFile (inputFile args)
  54             if (lineMode args)
  55                 then mapM_ publishOneMsg (BL.lines messageFile)
  56                 else publishOneMsg messageFile
  57
  58     -- all done. wait and close.
  59     if (confirm args)
  60         then waitForConfirms chan >>= return . show >> return ()
  61         else return ()
  62     closeConnection conn
  63
  64 -- | The handler for publisher confirms
  65 confirmCallback :: (Word64, Bool, AckType) -> IO ()
  66 confirmCallback (deliveryTag, isAll, ackType) =
  67     printparam' "confirmed"
  68                 ((show deliveryTag) ++
  69                      (if isAll then " all " else " this ") ++ (show ackType))
  70
  71 -- | hotfolder event handler
  72 handleEvent :: (BL.ByteString -> IO ()) -> Event -> IO ()
  73 handleEvent f (Closed False (Just x) True) = hr x >> BL.readFile x >>= f
  74 handleEvent _ _ = return ()