module Main where import Network.Haskoin.Wallet (Config(..), WalletRequest(..), WalletResponse(..), AddressType(..), OutputFormat(..), SPVMode(..), NodeAction(..)) import Network.Haskoin.Wallet.Server (runSPVServerWithContext) import Network.Haskoin.Wallet.Internals (BTCNode(..), Notif(..)) import qualified Network.Haskoin.Node.STM as Node import Data.String.Conversions (cs) import qualified System.ZMQ4 as ZMQ import qualified Control.Monad.Logger as Log import qualified Data.HashMap.Strict as HM import qualified Database.Persist.Sqlite as DB import qualified Control.Monad.Trans.Resource as Resource import qualified Data.Aeson as JSON import qualified Control.Concurrent as Con import qualified Data.Aeson.Encode.Pretty as PrettyJSON import qualified Control.Monad as M import qualified Control.Exception as Except databaseConf :: DB.SqliteConf databaseConf = DB.SqliteConf "/tmp/tmpdb" 1 cmdSocket :: String cmdSocket = "inproc://cmd" notifSocket :: String notifSocket = "inproc://notif" -- |Simple example app that embeds a haskoin-wallet server. -- Start wallet server + notification thread, and execute Status command when pressing ENTER main :: IO () main = ZMQ.withContext $ \ctx -> do -- Server putStrLn "Starting server..." _ <- Con.forkIO $ runWallet walletServerConf ctx -- Notify thread putStrLn "Starting notification thread..." _ <- Con.forkIO $ notifyThread ctx notifyHandler -- Status loop M.forever $ do putStrLn "Press ENTER to get server status..." _ <- getLine cmdGetStatus ctx >>= printStatusJSON where printStatusJSON = putStrLn . cs . PrettyJSON.encodePretty notifyHandler notif = putStrLn $ "NOTIFY: New block: " ++ cs (PrettyJSON.encodePretty notif) -- |Run haskoin-wallet using the specified ZeroMQ Context, -- and log to stderr. runWallet :: Config -> ZMQ.Context -> IO () runWallet cfg ctx = run $ runSPVServerWithContext cfg ctx where run = Resource.runResourceT . runLogging runLogging = Log.runStderrLoggingT . Log.filterLogger logFilter logFilter _ l = l >= configLogLevel cfg cmdGetStatus :: ZMQ.Context -> IO Node.NodeStatus cmdGetStatus ctx = sendCmdOrFail (PostNodeR NodeActionStatus) ctx >>= \res -> case res of Nothing -> error "ERROR: Status command: no response." Just status -> return status sendCmdOrFail :: (JSON.FromJSON a, JSON.ToJSON a) => WalletRequest -> ZMQ.Context -> IO (Maybe a) sendCmdOrFail cmd ctx = sendCmd cmd ctx >>= either error return >>= \res -> case res of ResponseError e -> error $ "ERROR: Send cmd, ResponseError: " ++ cs e ResponseValid r -> return r sendCmd :: (JSON.FromJSON a, JSON.ToJSON a) => WalletRequest -> ZMQ.Context -> IO (Either String (WalletResponse a)) sendCmd req ctx = ZMQ.withSocket ctx ZMQ.Req $ \sock -> do ZMQ.setLinger (ZMQ.restrict (0 :: Int)) sock ZMQ.connect sock cmdSocket ZMQ.send sock [] (cs $ JSON.encode req) JSON.eitherDecode . cs <$> ZMQ.receive sock -- |Connect to notify socket, subscribe to new blocks, -- and execute the supplied handler for each new block as it arrives. notifyThread :: ZMQ.Context -> (Notif -> IO ()) -> IO () notifyThread ctx handler = waitAndCatch $ ZMQ.withSocket ctx ZMQ.Sub $ \sock -> do ZMQ.setLinger (ZMQ.restrict (0 :: Int)) sock ZMQ.connect sock notifSocket ZMQ.subscribe sock "[block]" putStrLn "NOTIFY: Connected. Subscribed to new blocks." M.forever $ do [_,m] <- ZMQ.receiveMulti sock notif <- either failOnErr return $ JSON.eitherDecode (cs m) handler notif where failOnErr = fail . ("NOTIFY: ERROR: recv failed: " ++) waitAndCatch ioa = Con.threadDelay 10000 >> ioa `Except.finally` waitAndCatch ioa btcNodes :: [BTCNode] btcNodes = [ BTCNode "dnsseed.bluematt.me" 8333 , BTCNode "dnsseed.bitcoin.dashjr.org" 8333 , BTCNode "dnsseed.bluematt.me" 8333 , BTCNode "seed.bitcoinstats.com" 8333 , BTCNode "seed.bitcoin.jonasschnelli.ch" 8333 , BTCNode "seed.bitcoin.sipa.be" 8333 , BTCNode "seed.bitnodes.io" 8333 , BTCNode "seed.btcc.com" 8333 ] walletServerConf :: Config walletServerConf = Config { configCount = 100 -- ^ Output size of commands , configMinConf = 6 -- ^ Minimum number of confirmations , configSignTx = True -- ^ Sign transactions , configFee = 50000 -- ^ Fee to pay per 1000 bytes when creating new transactions , configRcptFee = False -- ^ Recipient pays fee (dangerous, no config file setting) , configAddrType = AddressExternal -- ^ Return internal instead of external addresses , configOffline = False -- ^ Display the balance including offline transactions , configReversePaging = False -- ^ Use reverse paging for displaying addresses and transactions , configPath = Nothing -- ^ Derivation path when creating account , configFormat = OutputNormal -- ^ How to format the command-line results , configConnect = cmdSocket -- ^ ZeroMQ socket to connect to (location of the server) , configConnectNotif = notifSocket -- ^ ZeroMQ socket to connect for notifications , configDetach = False -- ^ Detach server when launched from command-line , configFile = "" -- ^ Configuration file , configTestnet = False -- ^ Use Testnet3 network , configDir = "" -- ^ Working directory , configBind = cmdSocket -- ^ Bind address for the ZeroMQ socket , configBindNotif = notifSocket -- ^ Bind address for ZeroMQ notifications , configBTCNodes = HM.fromList [ ( "prodnet", btcNodes ) ] -- ^ Trusted Bitcoin full nodes to connect to , configMode = SPVOnline -- ^ Operation mode of the SPV node. , configBloomFP = 0.00001 -- ^ False positive rate for the bloom filter. , configDatabase = HM.fromList [ ( "prodnet", databaseConf ) ] -- ^ Database configuration , configLogFile = "" -- ^ Log file , configPidFile = "" -- ^ PID File , configLogLevel = Log.LevelInfo -- ^ Log level , configVerbose = True -- ^ Verbose , configServerKey = Nothing -- ^ Server key for authentication and encryption (server config) , configServerKeyPub = Nothing -- ^ Server public key for authentication and encryption (client config) , configClientKey = Nothing -- ^ Client key for authentication and encryption (client config) , configClientKeyPub = Nothing -- ^ Client public key for authentication and encryption }