Short polls

kda-tool.cabal

@@ -41,6 +41,7 @@ library
     Types.Node
     Types.TxInputs
     Utils
+    Output
 
   build-depends:
       Decimal
@@ -198,3 +199,4 @@ test-suite kda-tool-tests
     Types.KeyType
     Types.TxInputs
     Utils
+    Output

src/Commands/Local.hs

@@ -7,27 +7,24 @@ module Commands.Local
 
 ------------------------------------------------------------------------------
 import           Control.Error
-import           Control.Lens hiding ((.=))
 import           Control.Monad
 import           Control.Monad.Trans
 import           Data.Aeson
 import           Data.Aeson.Key
-import           Data.Aeson.Lens
 import           Data.Bifunctor
 import qualified Data.ByteString.Lazy as LB
 import           Data.Function
 import           Data.List
 import qualified Data.List.NonEmpty as NE
 import           Data.Ord
-import           Data.String.Conv
 import           Katip
-import           System.Exit
 import           Text.Printf
 ------------------------------------------------------------------------------
 import           Types.Env
 import           Types.HostPort
 import           Types.Node
 import           Utils
+import           Output
 ------------------------------------------------------------------------------
 
 localCommand :: Env -> LocalCmdArgs -> IO ()
@@ -49,13 +46,4 @@ localCommand e (LocalCmdArgs args verifySigs shortOutput) = do
               (schemeHostPortToText shp) (length txs) (length groups)
           responses <- lift $ mapM (localNodeQuery le verifySigs n) txs
           pure $ fromText (schemeHostPortToText shp) .= map responseToValue responses
-      case res of
-        Left er -> putStrLn er >> exitFailure
-        Right results -> do
-          let out = Object $ mconcat results
-          let status = out ^.. _Object . traverse . _Array . traverse . key "body" . key "result" . key "status" . _String
-          if shortOutput
-            then putStrLn $ toS $ encode status
-            else putStrLn $ toS $ encode out
-          when (any (/="success") status) $
-            exitWith (ExitFailure 2)
+      outputEitherResults shortOutput res

src/Commands/Poll.hs

@@ -17,20 +17,18 @@ import           Data.Function
 import           Data.List
 import qualified Data.List.NonEmpty as NE
 import           Data.Ord
-import           Data.String.Conv
-import qualified Data.Text.IO as T
 import           Katip
-import           System.Exit
 import           Text.Printf
 ------------------------------------------------------------------------------
 import           Types.Env
 import           Types.HostPort
 import           Types.Node
 import           Utils
+import           Output
 ------------------------------------------------------------------------------
 
-pollCommand :: Env -> NodeTxCmdArgs -> IO ()
-pollCommand e args = do
+pollCommand :: Env -> PollCmdArgs -> IO ()
+pollCommand e (PollCmdArgs args shortOutput) = do
   let le = _env_logEnv e
   case _nodeTxCmdArgs_files args of
     [] -> putStrLn "No tx files specified"
@@ -48,7 +46,4 @@ pollCommand e args = do
               (schemeHostPortToText shp) (length txs) (length groups)
           responses <- lift $ mapM (\ts -> pollNode le n (txChain $ NE.head ts) (_transaction_hash <$> ts)) groups
           pure $ fromText (schemeHostPortToText shp) .= map responseToValue responses
-      case res of
-        Left er -> putStrLn er >> exitFailure
-        Right results -> T.putStrLn $ toS $ encode $ Object $ mconcat results
-
+      outputEitherResults shortOutput res

src/Output.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Output
+  (
+    outputResults
+  , outputEitherResults
+  ) where
+
+------------------------------------------------------------------------------
+import           Data.Aeson
+import           Control.Lens hiding ((.=))
+import           Data.Aeson.Lens
+import           Data.String.Conv
+import           Control.Monad
+import           System.Exit
+------------------------------------------------------------------------------
+
+outputResults:: Bool -> [Object] -> IO ()
+outputResults shortOutput results = do
+  let out = Object $ mconcat results
+  let status = out ^.. cosmos . key "result" . key "status" . _String
+  if shortOutput
+    then putStrLn $ toS $ encode status
+    else putStrLn $ toS $ encode out
+  when (any (/="success") status) $
+    exitWith (ExitFailure 2)
+
+outputEitherResults:: Bool -> Either String [Object] -> IO ()
+outputEitherResults shortOutput eRes =
+  case eRes of
+    Left er -> putStrLn er >> exitFailure
+    Right results -> outputResults shortOutput results

src/Types/Env.hs

@@ -295,6 +295,11 @@ data LocalCmdArgs = LocalCmdArgs
   , _localTxCmdArgs_shortOutput :: Bool
   } deriving (Eq,Ord,Show,Read)
 
+data PollCmdArgs = PollCmdArgs
+  { _pollTxCmdArgs_txArgs :: NodeTxCmdArgs
+  , _pollTxCmdArgs_shortOutput :: Bool
+  } deriving (Eq,Ord,Show,Read)
+
 nodeOptP :: Parser HostPort
 nodeOptP = option (eitherReader (hostPortFromText . T.pack)) $ mconcat
   [ long "node"
@@ -329,6 +334,9 @@ nodeTxCmdP = NodeTxCmdArgs <$> many txFileP <*> optional schemeHostPortOptP
 localCmdP :: Parser LocalCmdArgs
 localCmdP = LocalCmdArgs <$> nodeTxCmdP <*> noVerifySigsP <*> shortOutputP
 
+pollCmdP :: Parser PollCmdArgs
+pollCmdP = PollCmdArgs <$> nodeTxCmdP <*> shortOutputP
+
 noVerifySigsP :: Parser Bool
 noVerifySigsP = flag True False $ mconcat
   [ long "no-verify-sigs"
@@ -455,7 +463,7 @@ data SubCommand
   | ListKeys (Either FilePath ChainweaverFile) (Maybe KeyIndex)
   | Local LocalCmdArgs
   | Mempool SchemeHostPort ChainId (Maybe Text) (Maybe Text)
-  | Poll NodeTxCmdArgs
+  | Poll PollCmdArgs
   | Send NodeTxCmdArgs
   | Sign SignArgs
   | Verify VerifyArgs
@@ -576,7 +584,7 @@ nodeCommands :: Mod CommandFields SubCommand
 nodeCommands = mconcat
   [ command "local" (info (Local <$> localCmdP)
       (progDesc "Test commands locally with a node's /local endpoint"))
-  , command "poll" (info (Poll <$> nodeTxCmdP)
+  , command "poll" (info (Poll <$> pollCmdP)
       (progDesc "Poll command results with a node's /poll endpoint"))
   , command "send" (info (Send <$> nodeTxCmdP)
       (progDesc "Send commands to a node's /send endpoint"))