{- |
 Module:      Bitcoin.Core.RPC
 Stability:   experimental

 We provide limited access to the bitcoin-core daemon RPC interface.  RPC
 method descriptions come from the bitcoind RPC help pages.
-}
module Bitcoin.Core.RPC (
    -- * Interacting with bitcoind
    BitcoindClient,
    runBitcoind,
    cookieClient,
    basicAuthFromCookie,
    mkBitcoindEnv,
    BitcoindException (..),

    -- * Transactions
    getTransaction,
    sendRawTransaction,
    sendTransaction,
    testMempoolAccept,

    -- * Blocks
    getBlock,
    getBlockFilter,
    getBlockHeader,
    getBlockHash,
    getBlockCount,
    getDifficulty,
    getBestBlockHash,
    getBlockStats,
    getChainTips,
    getChainTxStats,

    -- * Mempool
    getMempoolInfo,
    getMempoolAncestors,
    getMempoolDescendants,
    getRawMempool,

    -- * Network
    getPeerInfo,
    getConnectionCount,
    getNodeAddresses,
    getAddedNodeInfo,
    listBanned,
    getNetTotals,

    -- * Control
    stop,
    uptime,
    Command (..),
    addNode,
    disconnectNode,
    clearBanned,
    generateToAddress,

    -- * Response models
    module Bitcoin.Core.RPC.Responses,
) where

import Control.Monad (join)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans.Reader (runReaderT)
import Data.Bifunctor (first, second)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Network.HTTP.Client (Manager)
import Servant.API (BasicAuthData (..))
import Servant.Client (
    BaseUrl (..),
    ClientEnv,
    ClientError,
    Scheme (..),
    mkClientEnv,
    runClientM,
 )

import Bitcoin.Core.RPC.Blockchain
import Bitcoin.Core.RPC.Control
import Bitcoin.Core.RPC.Generating
import Bitcoin.Core.RPC.Network
import Bitcoin.Core.RPC.Responses
import Bitcoin.Core.RPC.Transactions
import Servant.Bitcoind (
    BitcoindClient,
    BitcoindException (..),
 )

-- | Convenience function for sending a RPC call to bitcoind
runBitcoind ::
    Manager ->
    -- | host
    String ->
    -- | port
    Int ->
    BasicAuthData ->
    BitcoindClient a ->
    IO (Either BitcoindException a)
runBitcoind :: Manager
-> String
-> Int
-> BasicAuthData
-> BitcoindClient a
-> IO (Either BitcoindException a)
runBitcoind mgr :: Manager
mgr host :: String
host port :: Int
port auth :: BasicAuthData
auth =
    (Either ClientError (Either BitcoindException a)
 -> Either BitcoindException a)
-> IO (Either ClientError (Either BitcoindException a))
-> IO (Either BitcoindException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either ClientError (Either BitcoindException a)
-> Either BitcoindException a
forall a.
Either ClientError (Either BitcoindException a)
-> Either BitcoindException a
consolidateErrors (IO (Either ClientError (Either BitcoindException a))
 -> IO (Either BitcoindException a))
-> (BitcoindClient a
    -> IO (Either ClientError (Either BitcoindException a)))
-> BitcoindClient a
-> IO (Either BitcoindException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientM (Either BitcoindException a)
-> ClientEnv
-> IO (Either ClientError (Either BitcoindException a))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
`runClientM` ClientEnv
env) (ClientM (Either BitcoindException a)
 -> IO (Either ClientError (Either BitcoindException a)))
-> (BitcoindClient a -> ClientM (Either BitcoindException a))
-> BitcoindClient a
-> IO (Either ClientError (Either BitcoindException a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT BitcoindException ClientM a
-> ClientM (Either BitcoindException a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT BitcoindException ClientM a
 -> ClientM (Either BitcoindException a))
-> (BitcoindClient a -> ExceptT BitcoindException ClientM a)
-> BitcoindClient a
-> ClientM (Either BitcoindException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BitcoindClient a
-> BasicAuthData -> ExceptT BitcoindException ClientM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` BasicAuthData
auth)
  where
    env :: ClientEnv
env = Manager -> String -> Int -> ClientEnv
mkBitcoindEnv Manager
mgr String
host Int
port

-- | Send a RPC call to bitcoind using credentials from a cookie file
cookieClient ::
    Manager ->
    -- | path to the cookie file
    FilePath ->
    -- | host
    String ->
    -- | port
    Int ->
    BitcoindClient r ->
    IO (Either BitcoindException r)
cookieClient :: Manager
-> String
-> String
-> Int
-> BitcoindClient r
-> IO (Either BitcoindException r)
cookieClient mgr :: Manager
mgr cookiePath :: String
cookiePath host :: String
host port :: Int
port go :: BitcoindClient r
go =
    IO BasicAuthData -> IO BasicAuthData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO BasicAuthData
basicAuthFromCookie String
cookiePath)
        IO BasicAuthData
-> (BasicAuthData -> IO (Either BitcoindException r))
-> IO (Either BitcoindException r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (BasicAuthData
 -> BitcoindClient r -> IO (Either BitcoindException r))
-> BitcoindClient r
-> BasicAuthData
-> IO (Either BitcoindException r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Manager
-> String
-> Int
-> BasicAuthData
-> BitcoindClient r
-> IO (Either BitcoindException r)
forall a.
Manager
-> String
-> Int
-> BasicAuthData
-> BitcoindClient a
-> IO (Either BitcoindException a)
runBitcoind Manager
mgr String
host Int
port) BitcoindClient r
go

{- | Parse a username and password from a file.  The contents of the file
 should be exactly "username:password" (not base64 encoded).
-}
basicAuthFromCookie ::
    -- | path to the cookie file
    FilePath ->
    IO BasicAuthData
basicAuthFromCookie :: String -> IO BasicAuthData
basicAuthFromCookie f :: String
f = ByteString -> BasicAuthData
repack (ByteString -> BasicAuthData) -> IO ByteString -> IO BasicAuthData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
f
  where
    repack :: ByteString -> BasicAuthData
repack = (ByteString -> ByteString -> BasicAuthData)
-> (ByteString, ByteString) -> BasicAuthData
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> BasicAuthData
BasicAuthData ((ByteString, ByteString) -> BasicAuthData)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> BasicAuthData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> ByteString -> ByteString
BS.drop 1) ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':')

-- | Convenience function for connecting to bitcoind
mkBitcoindEnv ::
    Manager ->
    -- | bitcoind host
    String ->
    -- | bitcoind RPC port
    Int ->
    ClientEnv
mkBitcoindEnv :: Manager -> String -> Int -> ClientEnv
mkBitcoindEnv mgr :: Manager
mgr host :: String
host port :: Int
port = Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
mgr (BaseUrl -> ClientEnv) -> BaseUrl -> ClientEnv
forall a b. (a -> b) -> a -> b
$ Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
host Int
port ""

consolidateErrors :: Either ClientError (Either BitcoindException a) -> Either BitcoindException a
consolidateErrors :: Either ClientError (Either BitcoindException a)
-> Either BitcoindException a
consolidateErrors = Either BitcoindException (Either BitcoindException a)
-> Either BitcoindException a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either BitcoindException (Either BitcoindException a)
 -> Either BitcoindException a)
-> (Either ClientError (Either BitcoindException a)
    -> Either BitcoindException (Either BitcoindException a))
-> Either ClientError (Either BitcoindException a)
-> Either BitcoindException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientError -> BitcoindException)
-> Either ClientError (Either BitcoindException a)
-> Either BitcoindException (Either BitcoindException a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ClientError -> BitcoindException
ClientException