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

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