Handle new changes in namecoin cli
This commit is contained in:
parent
ee17e3c26c
commit
b722fc7a30
27
Main.hs
27
Main.hs
@ -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
|
||||||
|
, value :: String
|
||||||
data Name = Name { name :: String
|
, expires_in :: Int
|
||||||
, value :: String
|
}
|
||||||
, 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)
|
||||||
|
Loading…
Reference in New Issue
Block a user