module ElectrsClient.Helper
  ( waitTillLastBlockProcessedT,
    waitTillLastBlockProcessed,
  )
where

import qualified Control.Concurrent.Thread.Delay as Delay (delay)
import qualified Data.ByteString.Lazy as BS
import qualified Data.Digest.Pure.SHA as SHA
  ( bytestringDigest,
    sha256,
  )
import ElectrsClient.Data.Env
import ElectrsClient.Import.External
import ElectrsClient.Rpc as Rpc
import ElectrsClient.Type
import Network.Bitcoin (Client, getBlockCount, getBlockHash)
import qualified Text.Hex as TH

waitTillLastBlockProcessed ::
  ( MonadUnliftIO m
  ) =>
  Client ->
  ElectrsEnv ->
  Natural ->
  m (Either RpcError ())
waitTillLastBlockProcessed :: forall (m :: * -> *).
MonadUnliftIO m =>
Client -> ElectrsEnv -> Natural -> m (Either RpcError ())
waitTillLastBlockProcessed Client
c ElectrsEnv
e =
  ExceptT RpcError m () -> m (Either RpcError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT RpcError m () -> m (Either RpcError ()))
-> (Natural -> ExceptT RpcError m ())
-> Natural
-> m (Either RpcError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client -> ElectrsEnv -> Natural -> ExceptT RpcError m ()
forall (m :: * -> *).
MonadUnliftIO m =>
Client -> ElectrsEnv -> Natural -> ExceptT RpcError m ()
waitTillLastBlockProcessedT Client
c ElectrsEnv
e

waitTillLastBlockProcessedT ::
  ( MonadUnliftIO m
  ) =>
  Client ->
  ElectrsEnv ->
  Natural ->
  ExceptT RpcError m ()
waitTillLastBlockProcessedT :: forall (m :: * -> *).
MonadUnliftIO m =>
Client -> ElectrsEnv -> Natural -> ExceptT RpcError m ()
waitTillLastBlockProcessedT Client
_ ElectrsEnv
_ Natural
0 =
  RpcError -> ExceptT RpcError m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE RpcError
CannotSyncBlockchain
waitTillLastBlockProcessedT Client
client ElectrsEnv
env Natural
decr = do
  IO () -> ExceptT RpcError m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT RpcError m ()) -> IO () -> ExceptT RpcError m ()
forall a b. (a -> b) -> a -> b
$ Integer -> IO ()
Delay.delay Integer
300
  Integer
bHeight <- IO Integer -> ExceptT RpcError m Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> ExceptT RpcError m Integer)
-> IO Integer -> ExceptT RpcError m Integer
forall a b. (a -> b) -> a -> b
$ Client -> IO Integer
getBlockCount Client
client
  Text
bHash <- IO Text -> ExceptT RpcError m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT RpcError m Text)
-> IO Text -> ExceptT RpcError m Text
forall a b. (a -> b) -> a -> b
$ Client -> Integer -> IO Text
getBlockHash Client
client Integer
bHeight
  BlockHeader
bHeader <- m (Either RpcError BlockHeader) -> ExceptT RpcError m BlockHeader
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either RpcError BlockHeader) -> ExceptT RpcError m BlockHeader)
-> m (Either RpcError BlockHeader)
-> ExceptT RpcError m BlockHeader
forall a b. (a -> b) -> a -> b
$ ElectrsEnv -> BlkHeight -> m (Either RpcError BlockHeader)
forall (m :: * -> *).
MonadUnliftIO m =>
ElectrsEnv -> BlkHeight -> m (Either RpcError BlockHeader)
Rpc.blockHeader ElectrsEnv
env (BlkHeight -> m (Either RpcError BlockHeader))
-> BlkHeight -> m (Either RpcError BlockHeader)
forall a b. (a -> b) -> a -> b
$ Word64 -> BlkHeight
BlkHeight (Word64 -> BlkHeight) -> Word64 -> BlkHeight
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
bHeight
  if (ByteString -> ByteString
doubleSha256AndReverse (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe ByteString
TH.decodeHex (BlockHeader -> Text
coerce BlockHeader
bHeader))
    Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe ByteString
TH.decodeHex (BlockHeader -> Text
coerce (BlockHeader -> Text) -> BlockHeader -> Text
forall a b. (a -> b) -> a -> b
$ Text -> BlockHeader
Rpc.BlockHeader Text
bHash)
    then () -> ExceptT RpcError m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else Client -> ElectrsEnv -> Natural -> ExceptT RpcError m ()
forall (m :: * -> *).
MonadUnliftIO m =>
Client -> ElectrsEnv -> Natural -> ExceptT RpcError m ()
waitTillLastBlockProcessedT Client
client ElectrsEnv
env (Natural
decr Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1)
  where
    doubleSha256AndReverse :: ByteString -> ByteString
doubleSha256AndReverse =
      ByteString -> ByteString
BS.toStrict
        (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse
        (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
SHA.bytestringDigest
        (Digest SHA256State -> ByteString)
-> (ByteString -> Digest SHA256State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
SHA.sha256
        (ByteString -> Digest SHA256State)
-> (ByteString -> ByteString) -> ByteString -> Digest SHA256State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> ByteString
forall t. Digest t -> ByteString
SHA.bytestringDigest
        (Digest SHA256State -> ByteString)
-> (ByteString -> Digest SHA256State) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
SHA.sha256
        (ByteString -> Digest SHA256State)
-> (ByteString -> ByteString) -> ByteString -> Digest SHA256State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.fromStrict