module ElectrsClient.Client
  ( send,
  )
where

import ElectrsClient.Data.Env
import ElectrsClient.Import.External
import ElectrsClient.Type
import Network.Socket
import Network.Socket.ByteString (recv, sendAll)
import qualified UnliftIO.Exception as E

send ::
  ( MonadUnliftIO m
  ) =>
  ByteString ->
  ElectrsEnv ->
  m (Either RpcError ByteString)
send :: forall (m :: * -> *).
MonadUnliftIO m =>
ByteString -> ElectrsEnv -> m (Either RpcError ByteString)
send ByteString
req ElectrsEnv
env = do
  IO (Either RpcError ByteString) -> m (Either RpcError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either RpcError ByteString) -> m (Either RpcError ByteString))
-> IO (Either RpcError ByteString)
-> m (Either RpcError ByteString)
forall a b. (a -> b) -> a -> b
$
    HostName
-> HostName
-> (Socket -> IO (Either RpcError ByteString))
-> IO (Either RpcError ByteString)
forall (m :: * -> *).
MonadUnliftIO m =>
HostName
-> HostName
-> (Socket -> m (Either RpcError ByteString))
-> m (Either RpcError ByteString)
runTCPClient
      (Text -> HostName
unpack (Text -> HostName) -> Text -> HostName
forall a b. (a -> b) -> a -> b
$ ElectrsEnv -> Text
electrsEnvHost ElectrsEnv
env)
      (Text -> HostName
unpack (Text -> HostName) -> Text -> HostName
forall a b. (a -> b) -> a -> b
$ ElectrsEnv -> Text
electrsEnvPort ElectrsEnv
env)
      ((Socket -> IO (Either RpcError ByteString))
 -> IO (Either RpcError ByteString))
-> (Socket -> IO (Either RpcError ByteString))
-> IO (Either RpcError ByteString)
forall a b. (a -> b) -> a -> b
$ \Socket
s -> do
        Socket -> ByteString -> IO ()
sendAll Socket
s (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> Either RpcError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either RpcError ByteString)
-> IO ByteString -> IO (Either RpcError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int -> IO ByteString
recv Socket
s Int
1024

runTCPClient ::
  ( MonadUnliftIO m
  ) =>
  HostName ->
  ServiceName ->
  (Socket -> m (Either RpcError ByteString)) ->
  m (Either RpcError ByteString)
runTCPClient :: forall (m :: * -> *).
MonadUnliftIO m =>
HostName
-> HostName
-> (Socket -> m (Either RpcError ByteString))
-> m (Either RpcError ByteString)
runTCPClient HostName
host HostName
port Socket -> m (Either RpcError ByteString)
client = ((forall a. m a -> IO a) -> IO (Either RpcError ByteString))
-> m (Either RpcError ByteString)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Either RpcError ByteString))
 -> m (Either RpcError ByteString))
-> ((forall a. m a -> IO a) -> IO (Either RpcError ByteString))
-> m (Either RpcError ByteString)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
x -> do
  Either RpcError AddrInfo
addr <- IO (Either RpcError AddrInfo)
forall (m :: * -> *).
MonadUnliftIO m =>
m (Either RpcError AddrInfo)
resolve
  case Either RpcError AddrInfo
addr of
    Left RpcError
err -> Either RpcError ByteString -> IO (Either RpcError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RpcError ByteString -> IO (Either RpcError ByteString))
-> Either RpcError ByteString -> IO (Either RpcError ByteString)
forall a b. (a -> b) -> a -> b
$ RpcError -> Either RpcError ByteString
forall a b. a -> Either a b
Left RpcError
err
    Right AddrInfo
addr0 -> do
      IO (Either RpcError ByteString) -> IO (Either RpcError ByteString)
forall a. IO a -> IO a
withSocketsDo (IO (Either RpcError ByteString)
 -> IO (Either RpcError ByteString))
-> IO (Either RpcError ByteString)
-> IO (Either RpcError ByteString)
forall a b. (a -> b) -> a -> b
$ do
        m (Either RpcError ByteString) -> IO (Either RpcError ByteString)
forall a. m a -> IO a
x (m (Either RpcError ByteString) -> IO (Either RpcError ByteString))
-> m (Either RpcError ByteString)
-> IO (Either RpcError ByteString)
forall a b. (a -> b) -> a -> b
$
          m Socket
-> (Socket -> m ())
-> (Socket -> m (Either RpcError ByteString))
-> m (Either RpcError ByteString)
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracket
            (AddrInfo -> m Socket
forall (m :: * -> *). MonadUnliftIO m => AddrInfo -> m Socket
open AddrInfo
addr0)
            (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Socket -> IO ()) -> Socket -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
close)
            Socket -> m (Either RpcError ByteString)
client
  where
    resolve :: (MonadUnliftIO m) => m (Either RpcError AddrInfo)
    resolve :: forall (m :: * -> *).
MonadUnliftIO m =>
m (Either RpcError AddrInfo)
resolve = do
      IO (Either RpcError AddrInfo) -> m (Either RpcError AddrInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either RpcError AddrInfo) -> m (Either RpcError AddrInfo))
-> IO (Either RpcError AddrInfo) -> m (Either RpcError AddrInfo)
forall a b. (a -> b) -> a -> b
$
        RpcError -> Maybe AddrInfo -> Either RpcError AddrInfo
forall l r. l -> Maybe r -> Either l r
maybeToRight RpcError
RpcNoAddress
          (Maybe AddrInfo -> Either RpcError AddrInfo)
-> ([AddrInfo] -> Maybe AddrInfo)
-> [AddrInfo]
-> Either RpcError AddrInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AddrInfo] -> Maybe AddrInfo
forall t. Container t => t -> Maybe (Element t)
safeHead
          ([AddrInfo] -> Either RpcError AddrInfo)
-> IO [AddrInfo] -> IO (Either RpcError AddrInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
host) (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
port)
    open :: (MonadUnliftIO m) => AddrInfo -> m Socket
    open :: forall (m :: * -> *). MonadUnliftIO m => AddrInfo -> m Socket
open AddrInfo
addr =
      m Socket -> (Socket -> m ()) -> (Socket -> m Socket) -> m Socket
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError
        (IO Socket -> m Socket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ AddrInfo -> IO Socket
openSocket AddrInfo
addr)
        (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Socket -> IO ()) -> Socket -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
close)
        ((Socket -> m Socket) -> m Socket)
-> (Socket -> m Socket) -> m Socket
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
          ()
_ <- IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> SockAddr -> IO ()
connect Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr
          Socket -> m Socket
forall (f :: * -> *) a. Applicative f => a -> f a
pure Socket
sock