agitprop: set message headers

diff --git a/Network/AMQP/Utils/Options.hs b/Network/AMQP/Utils/Options.hs
index 4876deba625ddda6b73b8e3abb6572e3925ffeea..5545aaf68354f1e6449cc054ace9cbdb0baccc86 100644 (file)
--- a/Network/AMQP/Utils/Options.hs
+++ b/Network/AMQP/Utils/Options.hs
@@ -2,6 +2,7 @@ module Network.AMQP.Utils.Options where
 
 import Data.Default.Class
 import Data.Maybe
+import qualified Data.Map as M
 import Data.Text (Text, pack)
 import Data.Version (showVersion)
 import Network.AMQP.Types
@@ -45,6 +46,7 @@ data Args = Args
   , msgprio :: Maybe Octet
   , msgcorrid :: Maybe Text
   , msgexp :: Maybe Text
+  , msgheader :: Maybe FieldTable
   }
 
 instance Default Args where
@@ -85,6 +87,7 @@ instance Default Args where
       Nothing
       Nothing
       Nothing
+      Nothing
 
 -- | Common options
 cOptions :: [OptDescr (Args -> Args)]
@@ -285,6 +288,11 @@ aOptions =
       ["msgexp"]
       (ReqArg (\s o -> o {msgexp = Just $ pack s}) "EXP")
       ("Message Expiration")
+  , Option
+      ['h']
+      ["header"]
+      (ReqArg (\s o -> o {msgheader = addheader (msgheader o) s}) "HEADER=VALUE")
+      ("Message Headers")
   ]
 
 -- |
@@ -293,6 +301,16 @@ options "konsum" = kOptions ++ cOptions
 options "agitprop" = aOptions ++ cOptions
 options _ = cOptions
 
+addheader :: Maybe FieldTable -> String -> Maybe FieldTable
+addheader Nothing string = Just $ FieldTable $ M.singleton (k string) (v string)
+addheader (Just (FieldTable oldheader)) string = Just $ FieldTable $ M.insert (k string) (v string) oldheader
+
+k :: String -> Text
+k s = pack $ takeWhile (/='=') s
+
+v :: String -> FieldValue
+v s = FVString $ pack $ tail $ dropWhile (/='=') s
+
 -- | 'parseargs' exename argstring
 -- applies options onto argstring
 parseargs :: String -> [String] -> IO Args

diff --git a/agitprop.hs b/agitprop.hs
index c14f68b37350fcc4ce2d740e9e8cbb7d69620c8a..894f248b4b6c04a618c74a54776521906e5ed0dd 100644 (file)
--- a/agitprop.hs
+++ b/agitprop.hs
@@ -97,7 +97,7 @@ handleFile f x =
 -- | Publish one message with our settings
 publishOneMsg' :: Channel -> Args -> BL.ByteString -> IO ()
 publishOneMsg' c a f = do
-      now <- getCurrentTime >>= return.utcTimeToPOSIXSeconds >>= return.floor
+      now <- getCurrentTime >>= return.floor.utcTimeToPOSIXSeconds
       r <-
         publishMsg
           c
@@ -117,6 +117,6 @@ publishOneMsg' c a f = do
                  , msgPriority = msgprio a
                  , msgCorrelationID = msgcorrid a
                  , msgExpiration = msgexp a
-                 -- , msgHeaders =
+                 , msgHeaders = msgheader a
                  }
       printparam "sent" $ fmap show r