namecoin-update 0.2.2.0 → 0.2.3.0

raw patch · 4 files changed

+88/−61 lines, 4 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Setup.hs +0/−2
• namecoin-update.cabal +4/−4
• src/Main.hs +11/−4
• src/lib/Namecoin.hs +73/−51

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,5 +1,5 @@ name:                namecoin-update-version:             0.2.2.0+version:             0.2.3.0 synopsis:            Tool to keep namecoin names updated and well description: @@ -11,8 +11,8 @@ license:             GPL-3 license-file:        LICENSE author:              rnhmjoj-maintainer:          micheleguerinirocco@me.com-copyright:           Copyright (C) Michele Guerini Rocco+maintainer:          rnhmjoj@inventati.org+copyright:           (C) Michele Guerini Rocco 2022 category:            Network build-type:          Simple cabal-version:       >=1.10@@ -26,7 +26,7 @@   exposed-modules:     Namecoin   build-depends:       base <= 5.0, lens, wreq,                        aeson, text, attoparsec-  default-extensions:  TemplateHaskell, OverloadedStrings+  default-extensions:  OverloadedStrings                        RecordWildCards, DuplicateRecordFields   default-language:    Haskell2010 

@@ -19,12 +19,19 @@   case names of     Left  error -> putStrLn ("Name check failed. "++error)     Right names -> do+      putStrLn ("Found "++show (length names)++" names:")+      mapM (\i -> putStrLn $ " - "++name i) names+       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.")+      if (total > 0) then do+        putStrLn (show total++" names are expiring")+        failed <- sum <$> mapM (nameUpdate uri) expiring+        if failed == 0+          then putStrLn "All names updated."+          else putStrLn (show failed ++ "/" ++ show total ++ " failed.")+      else+        putStrLn "Nothing to update."  -- | Main function --

@@ -1,18 +1,36 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}+ -- | Namecoin utility library-module Namecoin where+module Namecoin+-- * JSON-RPC client+( RPCRequest(..)+, RPCResponse(..)+, RPCError(..)+, rpcRequest -import Control.Applicative         (many, (<|>))-import Control.Lens                (set, view)-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.Aeson-import Data.Aeson.TH-import Network.Wreq+-- * Name operations+, Name(..)+, nameList+, nameUpdate +-- * Miscellanea+, uri+) where +import Control.Applicative  (many, (<|>))+import Control.Lens         (set, view)+import Data.Maybe           (fromJust)+import Data.Text            (Text, unpack)+import Data.Aeson           (ToJSON, FromJSON, Value)+import GHC.Generics         (Generic)++import Network.Wreq                   as W+import qualified Data.Aeson           as J+import qualified Data.Attoparsec.Text as P+import qualified Control.Exception    as E++ -- | Alias for types with an error message type Error = Either String @@ -20,36 +38,40 @@ -- * Namecoin config parser  -- | Parse a comment (line beggining with a "#")-comment :: Parser ()+comment :: P.Parser () comment = do-  char '#' >> takeTill isEndOfLine-  endOfLine+  P.char '#' >> P.takeTill P.isEndOfLine+  P.endOfLine   return () + -- | Parse an option of form -- -- > key=value-setting :: Parser (Text, Text)+setting :: P.Parser (Text, Text) setting = do-  name <- takeTill (== '=')-  char '='-  value <- takeTill isEndOfLine-  endOfLine+  name <- P.takeTill (== '=')+  P.char '='+  value <- P.takeTill P.isEndOfLine+  P.endOfLine   return (name, value) + -- | Parse a line (either a comment or an option)-line :: Parser (Text, Text)+line :: P.Parser (Text, Text) line = (comment >> line) <|> setting + -- | Parse the namecoin config format-config :: Parser [(Text, Text)]+config :: P.Parser [(Text, Text)] config = many line + -- | Takes the content of a namecoin config file -- and gives the URI to connect to the JSON-RPC server uri :: Text -> Error String uri content = do-  dict     <- parseOnly config content+  dict     <- P.parseOnly config content   username <- get dict "rpcuser"   password <- get dict "rpcpassword"   address  <- get dict "rpcbind"@@ -64,64 +86,65 @@  -- | JSON-RPC 1.0 request record data RPCRequest = RPCRequest-  { id      :: String   -- ^ a string identificating the client-  , method  :: String   -- ^ the name of the method-  , params  :: [String] -- ^ a list of parameters for the method-  }+  { id      :: String    -- ^ a string identificating the client+  , method  :: String    -- ^ the name of the method+  , params  :: [String]  -- ^ a list of parameters for the method+  } deriving (Generic, FromJSON, ToJSON) + -- | JSON-RPC 1.0 response record data RPCResponse = RPCResponse-  { id      :: String          -- ^ the same identificative string -  , result  :: Value           -- ^ result if the method call succeded-  , error   :: Maybe RPCError  -- ^ error in case the method call failed-  }+  { id       :: String          -- ^ the same identificative string +  , result   :: Value           -- ^ result if the method call succeded+  , rpcError :: Maybe RPCError  -- ^ error in case the method call failed+  } deriving (Generic, FromJSON, ToJSON) + -- | Namecoin API error record data RPCError = RPCError   { code    :: Int     -- ^ a number indicating the kind of error   , message :: String  -- ^ a detailed explanation of the error-  }+  } deriving (Generic, FromJSON, ToJSON) + -- | Namecoin API Value record data Name = Name-  { name       :: String -- ^ the namecoin name-  , value      :: String -- ^ its value-  , expires_in :: Int    -- ^ number of blocks before the name expires-  } deriving (Show)+  { name       :: String  -- ^ the namecoin name+  , value      :: String  -- ^ its value+  , expires_in :: Int     -- ^ number of blocks before the name expires+  } deriving (Show, Generic, FromJSON) -deriveJSON defaultOptions ''RPCRequest-deriveJSON defaultOptions ''RPCResponse-deriveJSON defaultOptions ''RPCError-deriveJSON defaultOptions ''Name  -- | Turn an Aeson AST object into a 'fromJSON' type decodeValue :: FromJSON a => Value -> Error a-decodeValue = eitherDecode . encode+decodeValue = J.eitherDecode . J.encode + -- | Execute an RPC method rpcRequest-  :: String               -- ^ the URI of the JSON-RPC endpoint-  -> String               -- ^ the method name-  -> [String]             -- ^ the method parameters-  -> IO (Error Value)     -- ^ and error or the wanted result+  :: String            -- ^ the URI of the JSON-RPC endpoint+  -> String            -- ^ the method name+  -> [String]          -- ^ the method parameters+  -> IO (Error Value)  -- ^ and error or the wanted result rpcRequest uri method params = do-  req <- try (view responseBody <$> (asJSON =<< postWith options uri req))+  req <- E.try (view W.responseBody <$> (W.asJSON =<< W.postWith options uri req))   return $ case req of-    Left  err -> Left ("RPC error: "++show (err :: SomeException))-    Right res -> case (error res) of+    Left  err -> Left ("RPC error: "++show (err :: E.SomeException))+    Right res -> case (rpcError res) of       Nothing  -> Right (result res)       Just err -> Left  ("API error "++show (code err)++": "++message err)   where-    req = toJSON (RPCRequest "namecoin-update" method params)+    req = J.toJSON (RPCRequest "namecoin-update" method params)     options = set checkResponse (Just $ \_ _ -> return ()) defaults   -- * Name operations --- | Return the list of currently registered names+-- | Returns the list of currently registered names nameList :: String -> IO (Error [Name]) nameList uri = fmap (decodeValue =<<) (rpcRequest uri "name_list" []) + -- | Issue an udpate for a name (confirming its current value) nameUpdate :: String -> Name -> IO Int nameUpdate uri (Name {..}) = do@@ -129,5 +152,4 @@   req <- rpcRequest uri "name_update" [ name, value ]   case req of     Left  err -> putStrLn "failed" >> putStrLn err >> return 1-    Right _   -> putStrLn "ok" >> return 1-+    Right _   -> putStrLn "ok" >> return 0