From 18aea7b10c26fabb04f0490a8976847b989d2064 Mon Sep 17 00:00:00 2001 From: rnhmjoj Date: Mon, 15 May 2017 20:48:30 +0200 Subject: [PATCH] split library-executable --- namecoin-update.cabal | 30 ++++++++++++++++++----- src/Main.hs | 41 +++++++++++++++++++++++++++++++ Main.hs => src/lib/Namecoin.hs | 44 ++++------------------------------ 3 files changed, 70 insertions(+), 45 deletions(-) create mode 100644 src/Main.hs rename Main.hs => src/lib/Namecoin.hs (74%) diff --git a/namecoin-update.cabal b/namecoin-update.cabal index 0a10f40..7651c1e 100644 --- a/namecoin-update.cabal +++ b/namecoin-update.cabal @@ -1,6 +1,13 @@ name: namecoin-update -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Tool to keep namecoin names updated and well +description: + + A small program that updates the names in a namecoin wallet + to prevent expiration. It uses the JSON-RPC API provided by + namecoind to scan and update the values of the name when needed. + The tool is intended to be run regularly, for example from cron. + license: GPL-3 license-file: LICENSE author: rnhmjoj @@ -10,10 +17,21 @@ category: Network build-type: Simple cabal-version: >=1.10 -executable namecoin-update - main-is: Main.hs - build-depends: base, lens, wreq, aeson, - text, attoparsec - default-language: Haskell2010 +source-repository head + type: git + location: https://github.com/rnhmjoj/namecoin-update + +library + hs-source-dirs: src/lib + exposed-modules: Namecoin + build-depends: base >= 4.9 && < 4.10, lens, wreq, + aeson, text, attoparsec default-extensions: TemplateHaskell, OverloadedStrings RecordWildCards, DuplicateRecordFields + default-language: Haskell2010 + +executable namecoin-update + hs-source-dirs: src + main-is: Main.hs + build-depends: base >= 4.9 && < 4.10, text, namecoin-update + default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..6d21d6f --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,41 @@ +-- | Tool to keep namecoin names updated and well +module Main where + +import Control.Monad (when) +import System.Environment (getArgs) +import Namecoin (Name(..), nameList, nameUpdate, uri) + +import qualified Data.Text.IO as T + + +-- | Check whether a name is going to expire soon (~2 day) +isExpiring :: Name -> Bool +isExpiring name = expires_in name < 100 + +-- | Check for names that will expire soon and update them +nameCheck :: String -> IO () +nameCheck uri = do + names <- nameList uri + case names of + Left error -> putStrLn ("Name check failed. "++error) + Right names -> do + let expiring = filter isExpiring names + total = length expiring + failed <- sum <$> mapM (nameUpdate uri) expiring + if failed == 0 + then putStrLn "Names updated: all ok." + else putStrLn (show failed ++ "/" ++ show total ++ " failed.") + +-- | Main function +-- +-- Reads the path of a namecoin config file +-- from the process arguments, connects to the +-- RPC server and updates the names found, if necessary. +main :: IO () +main = do + args <- getArgs + when (null args) (fail "Must provide a namecoin config file.") + conf <- T.readFile (head args) + case uri conf of + Left err -> putStrLn ("Error reading config: " ++ err) + Right uri -> nameCheck uri diff --git a/Main.hs b/src/lib/Namecoin.hs similarity index 74% rename from Main.hs rename to src/lib/Namecoin.hs index 96cb9ed..0808365 100644 --- a/Main.hs +++ b/src/lib/Namecoin.hs @@ -1,18 +1,15 @@ --- | Tool to keep namecoin names updated and well -module Main where +-- | Namecoin utility library +module Namecoin where import Control.Applicative (many, (<|>)) -import Control.Monad (when) import Control.Lens (set, view) -import Control.Exception (try, SomeException) -import Prelude hiding (error, readFile) +import Control.Exception (SomeException, try) +import Prelude hiding (error) import Data.Attoparsec.Text hiding (try) import Data.Maybe (fromJust) import Data.Text (Text, unpack) -import Data.Text.IO (readFile) import Data.Aeson import Data.Aeson.TH -import System.Environment (getArgs) import Network.Wreq @@ -119,11 +116,7 @@ rpcRequest uri method params = do options = set checkResponse (Just $ \_ _ -> return ()) defaults --- * Expiration checking - --- | Check whether a name is going to expire soon (~2 day) -isExpiring :: Name -> Bool -isExpiring name = expires_in name < 100 +-- * Name operations -- | Return the list of currently registered names nameList :: String -> IO (Error [Name]) @@ -138,30 +131,3 @@ nameUpdate uri (Name {..}) = do Left err -> putStrLn "failed" >> putStrLn err >> return 1 Right _ -> putStrLn "ok" >> return 1 --- | Check for names that will expire soon and update them -nameCheck :: String -> IO () -nameCheck uri = do - names <- nameList uri - case names of - Left error -> putStrLn ("Name check failed. "++error) - Right names -> do - let expiring = filter isExpiring names - total = length expiring - failed <- sum <$> mapM (nameUpdate uri) expiring - if failed == 0 - then putStrLn "Names updated: all ok." - else putStrLn (show failed ++ "/" ++ show total ++ " failed.") - --- | Main function --- --- Reads the path of a namecoin config file --- from the process arguments, connects to the --- RPC server and updates the names found, if necessary. -main :: IO () -main = do - args <- getArgs - when (null args) (fail "Must provide a namecoin config file.") - conf <- readFile (head args) - case uri conf of - Left err -> putStrLn ("Error reading config: " ++ err) - Right uri -> nameCheck uri