54 lines
1.5 KiB
Haskell
54 lines
1.5 KiB
Haskell
{-# 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)
|