split library-executable
This commit is contained in:
parent
00487af9ba
commit
18aea7b10c
@ -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
41
src/Main.hs
Normal 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
|
@ -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
|
|
Loading…
Reference in New Issue
Block a user