Handle new changes in namecoin cli

This commit is contained in:
rnhmjoj 2016-08-29 06:07:56 +02:00
parent ee17e3c26c
commit b722fc7a30
No known key found for this signature in database
GPG Key ID: 362BB82B7E496B7C

19
Main.hs
View File

@ -5,17 +5,25 @@ import System.Exit
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import Data.ByteString.Lazy.Char8 (pack) import Data.ByteString.Lazy.Char8 (pack)
import Control.Exception (try)
readCommand = readProcess "namecoin-cli" ["name_list"] "" data Name = Name
updateCommand n v = readProcessWithExitCode "namecoin-cli" ["name_update", n, v] "" { name :: String
data Name = Name { name :: String
, value :: String , value :: String
, expires_in :: Int , expires_in :: Int
} }
deriveJSON defaultOptions ''Name deriveJSON defaultOptions ''Name
namecoin :: [String] -> CreateProcess
namecoin args = shell ("namecoin-cli -conf=$HOME/.config/namecoin " ++ unwords args)
readCommand = readCreateProcess (namecoin ["name_list"]) ""
updateCommand n v = readCreateProcessWithExitCode (namecoin ["name_update", n, v]) ""
updateName :: Name -> IO Int updateName :: Name -> IO Int
updateName Name{..} updateName Name{..}
| expires_in < 100 = do | expires_in < 100 = do
@ -25,13 +33,14 @@ updateName Name{..}
else putStrLn (name ++ " update failed: " ++ err) >> return 1 else putStrLn (name ++ " update failed: " ++ err) >> return 1
| otherwise = putStrLn ("No need to update " ++ name) >> return 0 | otherwise = putStrLn ("No need to update " ++ name) >> return 0
main :: IO () main :: IO ()
main = do main = do
out <- pack <$> readCommand out <- pack <$> readCommand
case eitherDecode out of case eitherDecode out of
Left err -> putStrLn ("Error communicating with namecoin: " ++ err)
Right names -> do Right names -> do
errs <- sum <$> mapM updateName (names :: [Name]) errs <- sum <$> mapM updateName (names :: [Name])
if errs > 0 if errs > 0
then putStrLn (show errs ++ " updates failed") then putStrLn (show errs ++ " updates failed")
else putStrLn "All ok" else putStrLn "All ok"
Left err -> putStrLn ("Error communicating with namecoin: " ++ err)