split library-executable

This commit is contained in:
rnhmjoj 2017-05-15 20:48:30 +02:00
parent 00487af9ba
commit 18aea7b10c
No known key found for this signature in database
GPG Key ID: 362BB82B7E496B7C
3 changed files with 70 additions and 45 deletions

View File

@ -1,6 +1,13 @@
name: namecoin-update name: namecoin-update
version: 0.2.0.0 version: 0.2.1.0
synopsis: Tool to keep namecoin names updated and well 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: GPL-3
license-file: LICENSE license-file: LICENSE
author: rnhmjoj author: rnhmjoj
@ -10,10 +17,21 @@ category: Network
build-type: Simple build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
executable namecoin-update source-repository head
main-is: Main.hs type: git
build-depends: base, lens, wreq, aeson, location: https://github.com/rnhmjoj/namecoin-update
text, attoparsec
default-language: Haskell2010 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 default-extensions: TemplateHaskell, OverloadedStrings
RecordWildCards, DuplicateRecordFields 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

41
src/Main.hs Normal file
View File

@ -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

View File

@ -1,18 +1,15 @@
-- | Tool to keep namecoin names updated and well -- | Namecoin utility library
module Main where module Namecoin where
import Control.Applicative (many, (<|>)) import Control.Applicative (many, (<|>))
import Control.Monad (when)
import Control.Lens (set, view) import Control.Lens (set, view)
import Control.Exception (try, SomeException) import Control.Exception (SomeException, try)
import Prelude hiding (error, readFile) import Prelude hiding (error)
import Data.Attoparsec.Text hiding (try) import Data.Attoparsec.Text hiding (try)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
import Data.Text.IO (readFile)
import Data.Aeson import Data.Aeson
import Data.Aeson.TH import Data.Aeson.TH
import System.Environment (getArgs)
import Network.Wreq import Network.Wreq
@ -119,11 +116,7 @@ rpcRequest uri method params = do
options = set checkResponse (Just $ \_ _ -> return ()) defaults options = set checkResponse (Just $ \_ _ -> return ()) defaults
-- * Expiration checking -- * Name operations
-- | Check whether a name is going to expire soon (~2 day)
isExpiring :: Name -> Bool
isExpiring name = expires_in name < 100
-- | Return the list of currently registered names -- | Return the list of currently registered names
nameList :: String -> IO (Error [Name]) nameList :: String -> IO (Error [Name])
@ -138,30 +131,3 @@ nameUpdate uri (Name {..}) = do
Left err -> putStrLn "failed" >> putStrLn err >> return 1 Left err -> putStrLn "failed" >> putStrLn err >> return 1
Right _ -> putStrLn "ok" >> 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