btc-lsp-0.1.0.0: test/ReorgSpec.hs

{-# LANGUAGE TypeApplications #-}

module ReorgSpec
  ( spec,
  )
where

import BtcLsp.Grpc.Orphan ()
import BtcLsp.Import hiding (setGrpcCtx, setGrpcCtxT)
import qualified BtcLsp.Storage.Model.Block as Block
import qualified BtcLsp.Thread.BlockScanner as BlockScanner
import qualified Network.Bitcoin as Btc
import Test.Hspec
import TestAppM
import TestOrphan ()

spec :: Spec
spec = do
  itEnvT @'LndLsp "Reorg test" $ do
    void $ withBtcT Btc.setNetworkActive ($ False)
    _ <- BlockScanner.scan

    void $ withBtcT Btc.generate (\h -> h 5 Nothing)
    void $ withBtc2T Btc.generate (\h -> h 10 Nothing)
    blockCount <- withBtcT Btc.getBlockCount id
    _ <- BlockScanner.scan
    blkList1 <-
      lift . runSql
        . Block.getBlockByHeightSql
        . BlkHeight
        $ fromIntegral blockCount
    let blk1 = unsafeHead $ entityVal <$> blkList1
    blockHash1 <- withBtcT Btc.getBlockHash ($ blockCount)
    liftIO $ from (blockHash blk1) `shouldBe` blockHash1

    void $ withBtcT Btc.setNetworkActive ($ True)
    _ <- lift waitTillNodesSynchronized
    _ <- BlockScanner.scan
    blkList2 <-
      lift . runSql
        . Block.getBlockByHeightSql
        . BlkHeight
        $ fromIntegral blockCount
    let blk2 = unsafeHead $ entityVal <$> blkList2
    blockHash2 <- withBtcT Btc.getBlockHash ($ blockCount)
    liftIO $ from (blockHash blk2) `shouldBe` blockHash2

unsafeHead :: [Block] -> Block
unsafeHead blkList = do
  case blkList of
    [blk] -> blk
    _ -> error "There is no blocks in a list"

waitTillNodesSynchronized ::
  ( MonadReader (TestEnv o) m,
    Env m
  ) =>
  m (Either Failure ())
waitTillNodesSynchronized = runExceptT $ do
  sleep1s
  blockCount1 <- withBtcT Btc.getBlockCount id
  blockCount2 <- withBtc2T Btc.getBlockCount id
  if blockCount1 == blockCount2
    then do
      blockHash1 <- withBtcT Btc.getBlockHash ($ blockCount1)
      blockHash2 <- withBtc2T Btc.getBlockHash ($ blockCount2)
      if blockHash1 == blockHash2
        then return ()
        else ExceptT waitTillNodesSynchronized
    else ExceptT waitTillNodesSynchronized