[RSC-143] Fix index bug + cosmetics

Author: volhovm

src/User/Actions.hs

@@ -81,7 +81,7 @@ processCommand
 #if GtkGui
 processCommand st O.StartGUI opts = processStartGUI st opts
 #endif
-processCommand st command _ = processCommandNoOpts st command
+processCommand st command _       = processCommandNoOpts st command
 
 -- | Processes command line user command
 processCommandNoOpts
@@ -173,26 +173,27 @@ processFormTransaction
     -> [(Int64, Int)]
     -> (Maybe U.UserCache)
     -> m ()
-processFormTransaction st inputs outputAddrStr outputCoins cache =
-    eWrap $
-    do let outputAddr = C.Address <$> C.constructPublicKey outputAddrStr
-           inputs' = map (foldr1 (\(a,b) (_,d) -> (a, b ++ d))) $
-                     groupBy ((==) `on` snd) $
-                     map (\(idx,o,c) -> (idx - 1, [C.Coin (C.Color c) (C.CoinAmount $ toRational o)]))
-                     inputs
-           outputs' = map (uncurry (flip C.Coin) . bimap (C.CoinAmount . toRational) C.Color)
-                          outputCoins
-           td = TransactionData
-                { tdInputs = inputs'
-                , tdOutputAddress = fromJust outputAddr
-                , tdOutputCoins = outputs'
-                }
-       unless (isJust outputAddr) $
-           U.commitError $ "Provided key can't be exported: " <> outputAddrStr
-       tx <- submitTransactionRetry 2 st cache td
-       C.logInfo $
-           sformat ("Successfully submitted transaction with hash: " % build) $
-               C.hash tx
+processFormTransaction st inputs outputAddrStr outputCoins cache = eWrap $ do
+    let outputAddr = C.Address <$> C.constructPublicKey outputAddrStr
+        inputs' =
+            map (foldr1 (\(a,b) (_,d) -> (a, b ++ d))) $
+            groupBy ((==) `on` snd) $
+            map (\(idx,o,c) -> (idx - 1, [C.Coin (C.Color c) (C.CoinAmount $ toRational o)]))
+            inputs
+        outputs' =
+            map (uncurry (flip C.Coin) . bimap (C.CoinAmount . toRational) C.Color)
+                outputCoins
+        td = TransactionData
+             { tdInputs = inputs'
+             , tdOutputAddress = fromJust outputAddr
+             , tdOutputCoins = outputs'
+             }
+    unless (isJust outputAddr) $
+        U.commitError $ "Provided key can't be exported: " <> outputAddrStr
+    tx <- submitTransactionRetry 2 st cache td
+    C.logInfo $
+        sformat ("Successfully submitted transaction with hash: " % build) $
+            C.hash tx
 
 processMultisigAddress
     :: (MonadIO m, WorkMode m)
@@ -203,59 +204,58 @@ processMultisigAddress
     -> T.Text
     -> T.Text
     -> m ()
-processMultisigAddress
-    st
-    m
-    textUAddrs
-    textTAddrs
-    masterPkText
-    masterSlaveSigText
-  = do
+processMultisigAddress st m textUAddrs textTAddrs masterPkText masterSlaveSigText = do
     when (null textUAddrs && null textTAddrs) $
         U.commitError "Can't create multisig with empty addrs list"
-
-    userAddrs  <- map C.UserAlloc  <$> parseTextAddresses textUAddrs
+    userAddrs <- map C.UserAlloc <$> parseTextAddresses textUAddrs
     trustAddrs <- map C.TrustAlloc <$> parseTextAddresses textTAddrs
     let partiesAddrs = userAddrs ++ trustAddrs
     when (m > length partiesAddrs) $
         U.commitError "Parameter m should be less than length of list"
-
     msPublicKey <- snd <$> liftIO C.keyGen
-    (userAddress, userSk) <- head <$> query' st U.GetUserAddresses
-    let msAddr    = C.Address msPublicKey
+    (userAddress,userSk) <- head <$> query' st U.GetUserAddresses
+    let msAddr = C.Address msPublicKey
     let partyAddr = C.UserParty userAddress
-    let msStrat   = C.AllocationStrategy m $ HS.fromList partiesAddrs
-    let userSignature   = C.sign userSk (msAddr, msStrat)
+    let msStrat = C.AllocationStrategy m $ HS.fromList partiesAddrs
+    let userSignature = C.sign userSk (msAddr, msStrat)
     -- @TODO: replace with Either and liftA2
-    let !masterPk       = fromMaybe
-                             (error "Master pk is not parseable!")
-                             (C.constructPublicKey masterPkText)
-    let !masterSlaveSig = fromMaybe
-                             (error "Master slave signature is not parseable!")
-                             (C.constructSignature masterSlaveSigText)
-
+    let !masterPk =
+            fromMaybe
+                (error "Master pk is not parseable!")
+                (C.constructPublicKey masterPkText)
+    let !masterSlaveSig =
+            fromMaybe
+                (error "Master slave signature is not parseable!")
+                (C.constructSignature masterSlaveSigText)
     C.allocateMultisignatureAddress
         msAddr
         partyAddr
         msStrat
         userSignature
         (masterPk, masterSlaveSig)
     C.logInfo $
-       sformat ("Your new address will be added in the next block: " % build) msPublicKey
+        sformat
+            ("Your new address will be added in the next block: " % build)
+            msPublicKey
   where
-    parseTextAddresses :: WorkMode m => [T.Text] -> m [C.Address]
+    parseTextAddresses
+        :: WorkMode m
+        => [T.Text] -> m [C.Address]
     parseTextAddresses textAddrs = do
-        let partiesAddrs = mapMaybe (fmap C.Address . C.constructPublicKey) textAddrs
-        when (length partiesAddrs /= length textAddrs) $ do
-            let parsed = T.unlines (map show' partiesAddrs)
-            U.commitError $
-                sformat ("Some addresses were not parsed, parsed only those: " % stext) parsed
+        let partiesAddrs =
+                mapMaybe (fmap C.Address . C.constructPublicKey) textAddrs
+        when (length partiesAddrs /= length textAddrs) $
+            do let parsed = T.unlines (map show' partiesAddrs)
+               U.commitError $
+                   sformat
+                       ("Some addresses were not parsed, parsed only those: " %
+                        stext)
+                       parsed
         return partiesAddrs
 
 processUpdateBlockchain
     :: (MonadIO m, WorkMode m)
-    => U.RSCoinUserState
-    -> m ()
+    => U.RSCoinUserState -> m ()
 processUpdateBlockchain st =
     eWrap $
     do res <- updateBlockchain st True
@@ -266,69 +266,72 @@ processUpdateBlockchain st =
 
 processConfirmAllocation
     :: (MonadIO m, WorkMode m)
-    => U.RSCoinUserState
-    -> Int
-    -> Maybe String
-    -> T.Text
-    -> T.Text
-    -> m ()
-processConfirmAllocation
-    st
-    i
-    mHot
-    masterPkText
-    masterSlaveSigText
-  = eWrap $ do
-    when (i <= 0) $ U.commitError $
-        sformat ("Index i should be greater than 0 but given: " % int) i
-
-    (msAddr, C.AllocationInfo{..}) <- query' st $ U.GetAllocationByIndex (i - 1)
-    (slaveSk, partyAddr)           <- case mHot of
-        Just (read -> (hotSkPath, partyPkStr)) -> do
-            hotSk <- liftIO $ C.readSecretKey hotSkPath
-            let party     = C.Address $ fromMaybe
-                              (error "Not valid hot partyPk!")
-                              (C.constructPublicKey $ T.pack partyPkStr)
-            let partyAddr = C.TrustParty { partyAddress = party
-                                         , hotTrustKey  = C.derivePublicKey hotSk }
-            return (hotSk, partyAddr)
-        Nothing -> do
-            (userAddress, userSk) <- head <$> query' st U.GetUserAddresses
-            return (userSk, C.UserParty userAddress)
-
-    let partySignature  = C.sign slaveSk (msAddr, _allocationStrategy)
-    let !masterPk       = fromMaybe
-                             (error "Master pk is not parseable!")
-                             (C.constructPublicKey masterPkText)
-    let !masterSlaveSig = fromMaybe
-                             (error "Master slave signature is not parseable!")
-                             (C.constructSignature masterSlaveSigText)
-
-    C.allocateMultisignatureAddress
-        msAddr
-        partyAddr
-        _allocationStrategy
-        partySignature
-        (masterPk, masterSlaveSig)
-    C.logInfo "Address allocation successfully confirmed!"
+    => U.RSCoinUserState -> Int -> Maybe String -> T.Text -> T.Text -> m ()
+processConfirmAllocation st i mHot masterPkText masterSlaveSigText =
+    eWrap $
+    do when (i <= 0) $
+           U.commitError $
+           sformat ("Index i should be greater than 0 but given: " % int) i
+       (msAddr,C.AllocationInfo{..}) <-
+           query' st $ U.GetAllocationByIndex (i - 1)
+       (slaveSk,partyAddr) <-
+           case mHot of
+               Just (read -> (hotSkPath,partyPkStr)) -> do
+                   hotSk <- liftIO $ C.readSecretKey hotSkPath
+                   let party =
+                           C.Address $
+                           fromMaybe
+                               (error "Not valid hot partyPk!")
+                               (C.constructPublicKey $ T.pack partyPkStr)
+                   let partyAddr =
+                           C.TrustParty
+                           { partyAddress = party
+                           , hotTrustKey = C.derivePublicKey hotSk
+                           }
+                   return (hotSk, partyAddr)
+               Nothing -> do
+                   (userAddress,userSk) <-
+                       head <$> query' st U.GetUserAddresses
+                   return (userSk, C.UserParty userAddress)
+       let partySignature = C.sign slaveSk (msAddr, _allocationStrategy)
+       let !masterPk =
+               fromMaybe
+                   (error "Master pk is not parseable!")
+                   (C.constructPublicKey masterPkText)
+       let !masterSlaveSig =
+               fromMaybe
+                   (error "Master slave signature is not parseable!")
+                   (C.constructSignature masterSlaveSigText)
+       C.allocateMultisignatureAddress
+           msAddr
+           partyAddr
+           _allocationStrategy
+           partySignature
+           (masterPk, masterSlaveSig)
+       C.logInfo "Address allocation successfully confirmed!"
 
 processListAllocation
     :: (MonadIO m, WorkMode m)
-    => U.RSCoinUserState
-    -> m ()
-processListAllocation st = eWrap $ do
-    -- update local cache
-    U.retrieveAllocationsList st
-    msAddrsList <- query' st U.GetAllocationStrategies
-    liftIO $ TIO.putStrLn $ T.pack $ show msAddrsList
-    msigAddrsList <- (`zip` [(1::Int)..]) . M.assocs <$> query' st U.GetAllocationStrategies
-    when (null msigAddrsList) $
-        liftIO $ putStrLn "Allocation address list is empty"
-    forM_ msigAddrsList $ \((addr,allocStrat), i) -> do
-        let numLength = length $ show i
-        let padding = foldr1 (%) (replicate numLength " ")
-        let form = int % ". " % build % "\n  " % build % padding
-        liftIO $ TIO.putStrLn $ sformat form i addr allocStrat
+    => U.RSCoinUserState -> m ()
+processListAllocation st =
+    eWrap $
+    do
+       -- update local cache
+       U.retrieveAllocationsList
+           st
+       msAddrsList <- query' st U.GetAllocationStrategies
+       liftIO $ TIO.putStrLn $ T.pack $ show msAddrsList
+       msigAddrsList <-
+           (`zip` [(1 :: Int) ..]) . M.assocs <$>
+           query' st U.GetAllocationStrategies
+       when (null msigAddrsList) $
+           liftIO $ putStrLn "Allocation address list is empty"
+       forM_ msigAddrsList $
+           \((addr,allocStrat),i) -> do
+               let numLength = length $ show i
+               let padding = foldr1 (%) (replicate numLength " ")
+               let form = int % ". " % build % "\n  " % build % padding
+               liftIO $ TIO.putStrLn $ sformat form i addr allocStrat
 
 processImportAddress
     :: (MonadIO m, WorkMode m)
@@ -365,39 +368,47 @@ processExportAddress st addrId filepath = do
             addrN
             addrId
             addrN
-    let addr = allAddresses !! (addrId -1)
+    let addr = allAddresses !! (addrId - 1)
     strategy <- fromJust <$> query' st (U.GetAddressStrategy addr)
     case strategy of
         C.DefaultStrategy -> do
             C.logInfo
                 "The strategy of your address is default, dumping it to the file"
-            (addr'@(C.getAddress->pk),sk) <-
+            (addr'@(C.getAddress -> pk),sk) <-
                 second fromJust <$> query' st (U.FindUserAddress addr)
             unless (addr' == addr) $
                 C.logError $
                 "Internal error, address found is not the same " <>
                 "as requested one for default strategy"
             liftIO $ C.writeSecretKey filepath sk
             liftIO $ C.writePublicKey (filepath <> ".pub") pk
-            C.logInfo $ sformat
-                ("Dumped secret key into " % shown % ", public into " %
-                 shown % ".pub") filepath filepath
+            C.logInfo $
+                sformat
+                    ("Dumped secret key into " % shown % ", public into " %
+                     shown %
+                     ".pub")
+                    filepath
+                    filepath
         C.MOfNStrategy m parties ->
             U.commitError $
-                sformat ("This address is " % int % "/" % int %
-                         " strategy address, export correspondent key instead. " %
-                         "Correspondent m/n key are autoexported " %
-                         "when you import their party.") m (S.size parties)
+            sformat
+                ("This address is " % int % "/" % int %
+                 " strategy address, export correspondent key instead. " %
+                 "Correspondent m/n key are autoexported " %
+                 "when you import their party.")
+                m
+                (S.size parties)
 
 processDeleteAddress
     :: (MonadIO m, WorkMode m)
     => U.RSCoinUserState
     -> Int
     -> m ()
-processDeleteAddress st ix = eWrap $ do
-    C.logInfo $ sformat ("Deleting address #" % int) ix
-    deleteUserAddress st ix
-    C.logInfo "Address was successfully deleted"
+processDeleteAddress st ix =
+    eWrap $
+    do C.logInfo $ sformat ("Deleting address #" % int) ix
+       deleteUserAddress st $ ix - 1
+       C.logInfo "Address was successfully deleted"
 
 processSignSeed
     :: MonadIO m
@@ -424,25 +435,27 @@ processStartGUI
     -> U.RSCoinUserState
     -> O.UserOptions
     -> m ()
-processStartGUI st opts@O.UserOptions{..}= do
+processStartGUI st opts@O.UserOptions{..} = do
     initialized <- U.isInitialized st
     unless initialized $ liftIO G.initGUI >> initLoop
-    liftIO $ bracket
-        (ACID.openLocalStateFrom guidbPath emptyGUIAcid)
-        (\cs -> do ACID.createCheckpoint cs
-                   ACID.closeAcidState cs)
-        (\cs -> startGUI (Just configPath) st cs)
+    liftIO $
+        bracket
+            (ACID.openLocalStateFrom guidbPath emptyGUIAcid)
+            (\cs -> do
+                 ACID.createCheckpoint cs
+                 ACID.closeAcidState cs)
+            (\cs ->
+                  startGUI (Just configPath) st cs)
   where
     initLoop =
         initializeStorage st opts `catch`
-        (\(e :: SomeException) ->
-              do liftIO $
-                     reportSimpleErrorNoWindow $
-                     "Couldn't initialize rscoin. Check connection, close this " ++
-                     "dialog and we'll try again. Error: "
-                     ++ show e
-                 wait $ for 500 ms
-                 initLoop)
+        (\(e :: SomeException) -> do
+             liftIO $
+                 reportSimpleErrorNoWindow $
+                 "Couldn't initialize rscoin. Check connection, close this " ++
+                 "dialog and we'll try again. Error: " ++ show e
+             wait $ for 500 ms
+             initLoop)
 #endif
 
 dumpCommand