{-# Language TemplateHaskell, RecordWildCards #-} import System.Process import System.Exit import System.Environment (getArgs) import Data.Maybe (listToMaybe, fromMaybe) import Data.Aeson import Data.Aeson.TH import Data.ByteString.Lazy.Char8 (pack) import Control.Exception (try) data Name = Name { name :: String , value :: String , expires_in :: Int } deriveJSON defaultOptions ''Name defaultPath :: FilePath defaultPath = "$XDG_CONFIG_HOME/namecoin" namecoin :: FilePath -> [String] -> CreateProcess namecoin path args = shell ("namecoind -conf=" ++ path ++ " " ++ unwords args) readCommand conf = readCreateProcess (namecoin conf ["name_list"]) "" updateCommand conf n v = readCreateProcessWithExitCode (namecoin conf ["name_update", n, v]) "" updateName :: FilePath -> Name -> IO Int updateName conf Name{..} | expires_in < 100 = do (code, out, err) <- updateCommand conf name value if code == ExitSuccess then putStrLn (name ++ " updated: " ++ out) >> return 0 else putStrLn (name ++ " update failed: " ++ err) >> return 1 | otherwise = putStrLn ("No need to update " ++ name) >> return 0 main :: IO () main = do conf <- (fromMaybe defaultPath . listToMaybe) <$> getArgs out <- pack <$> readCommand conf case eitherDecode out of Right names -> do errs <- sum <$> mapM (updateName conf) (names :: [Name]) if errs > 0 then putStrLn (show errs ++ " updates failed") else putStrLn "All ok" Left err -> putStrLn ("Error communicating with namecoin: " ++ err)