print heartbeat parameter

[fd/haskell-amqp-utils.git] / Network / AMQP / Utils / Connection.hs

diff --git a/Network/AMQP/Utils/Connection.hs b/Network/AMQP/Utils/Connection.hs
index 62cba8f46456c11c1a77ae30b1dce66f551c8523..99e808b901009f6888bb4be7a4d0a02a9db2065c 100644 (file)
--- a/Network/AMQP/Utils/Connection.hs
+++ b/Network/AMQP/Utils/Connection.hs
@@ -1,27 +1,32 @@
+-- SPDX-FileCopyrightText: 2022 Frank Doepper
+--
+-- SPDX-License-Identifier: GPL-3.0-only
+
 {-# LANGUAGE OverloadedStrings #-}
 
 module Network.AMQP.Utils.Connection where
 
-import qualified Data.ByteString as B
-import Data.Default.Class
-import qualified Data.Text as T
-import Network.AMQP
-import Network.AMQP.Utils.Helpers
-import Network.AMQP.Utils.Options
-import qualified Network.Connection as N
-import Network.TLS
-import Network.TLS.Extra
-import System.Timeout
-import System.X509
+import qualified Data.ByteString            as B
+import           Data.Default.Class
+import qualified Data.Text                  as T
+import           Network.AMQP
+import           Network.AMQP.Utils.Helpers
+import           Network.AMQP.Utils.Options
+import qualified Network.Connection         as N
+import           Network.TLS
+import           Network.TLS.Extra
+import           System.Timeout
+import           System.X509
 
 -- | opens a connection and a channel
 connect :: Args -> IO (Connection, Channel)
 connect args = do
-  printparam' "server" $ server args
-  printparam' "port" $ show $ port args
-  printparam' "vhost" $ vHost args
+  printparam "server" $ server args
+  printparam "port" $ portnumber args
+  printparam "vhost" $ vHost args
   printparam "connection_name" $ connectionName args
-  printparam' "connect timeout" $ (show (connect_timeout args)) ++ "s"
+  printparam "heartbeat" $ liftA2 (\ n m -> show n ++ m) (heartBeat args) (Just " s")
+  printparam "connect timeout" $ [show (connect_timeout args), "s"]
   globalCertificateStore <- getSystemCertificateStore
   let myTLS =
         N.TLSSettings
@@ -48,10 +53,12 @@ connect args = do
             if (tls args)
               then Just (TLSCustom myTLS)
               else Nothing
-        , coServers = [(server args, fromIntegral $ port args)]
-        , coHeartbeatDelay = fmap fromIntegral $ heartBeat args
+        , coServers = [(server args, portnumber args)]
+        , coHeartbeatDelay = heartBeat args
         , coName = fmap T.pack $ connectionName args
         }
+  getServerProperties conn >>= return . (formatheaders fieldshow) >>=
+    printparam "server properties"
   Just chan <- timeout to $ openChannel conn
   return (conn, chan)
   where
@@ -59,7 +66,7 @@ connect args = do
 
 --  addChannelExceptionHandler chan
 --                             (\exception -> closeConnection conn >>
---                                  printparam' "exiting" (show exception) >>
+--                                  printparam "exiting" (show exception) >>
 --                                  killThread tid)
 --
 -- -- noop sharedValidationCache, handy when debugging
@@ -74,6 +81,6 @@ myCert :: Maybe FilePath -> Maybe FilePath -> t -> IO (Maybe Credential)
 myCert (Just cert') (Just key') _ = do
   result <- credentialLoadX509 cert' key'
   case result of
-    Left x -> printparam' "ERROR" x >> return Nothing
+    Left x  -> printparam "ERROR" x >> return Nothing
     Right x -> return $ Just x
 myCert _ _ _ = return Nothing