haskell-opentimestamps-0.5.5.0: test/VerifySpec.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}

module VerifySpec (spec) where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (TimeZone (..), utcToZonedTime)
import qualified OpenTimestamps.DetachedTimestampFile as DTSF
import OpenTimestamps.Verify
  ( BitcoinConfig (..)
  , verifyDetachedTimestampFile
  )
import System.Directory (doesFileExist, getHomeDirectory)
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)
import Test.Hspec
  ( Spec
  , describe
  , expectationFailure
  , it
  , shouldSatisfy
  )

-- | RPC credentials for Bitcoin node
data RPCCredentials where
  RPCCredentials ::
    { rpcUser :: T.Text
    , rpcPassword :: T.Text
    } ->
    RPCCredentials
  deriving (Show, Eq)

-- | Reads RPC credentials from a Bitcoin cookie file
readCookieFile :: FilePath -> IO (Maybe RPCCredentials)
readCookieFile path = do
  exists <- doesFileExist path
  if exists
    then do
      content <- TIO.readFile path
      case T.splitOn (T.pack ":") content of
        [user, pass] -> pure $ Just $ RPCCredentials user pass
        _ -> pure Nothing
    else do
      hPutStrLn stderr $ "Cookie file not found at: " ++ path
      pure Nothing

getBitcoinConfig :: IO BitcoinConfig
getBitcoinConfig = do
  homeDir <- getHomeDirectory
  let cookieFilePath = homeDir </> ".bitcoin" </> ".cookie"
  mrpcc <- readCookieFile cookieFilePath
  config <- case mrpcc of
    Nothing -> do
      hPutStrLn
        stderr
        "Error: Bitcoin cookie file not found. A local Bitcoin node is required for this test to work."
      hPutStrLn stderr $ "Expected cookie file at: " ++ cookieFilePath
      pure $
        BitcoinConfig
          { bitcoinHost = "localhost"
          , bitcoinPort = 8332
          , bitcoinUser = "testuser"
          , bitcoinPass = "testpass"
          }
    Just rpcc ->
      pure $
        BitcoinConfig
          { bitcoinHost = "localhost"
          , bitcoinPort = 8332
          , bitcoinUser = T.unpack $ rpcUser rpcc
          , bitcoinPass = T.unpack $ rpcPassword rpcc
          }
  putStrLn $ "Using Bitcoin Config: " ++ show config
  pure config

spec :: Spec
spec = describe "OpenTimestamps.Verify" $ do
  describe "verifyDetachedTimestampFile with incomplete.txt.ots" $ do
    it "should indicate verify success for incomplete.txt.ots" $ do
      otsFileContent <- BS.readFile "examples/incomplete.txt.ots"
      let dtsfEither = DTSF.deserialize (BSL.fromStrict otsFileContent)
      case dtsfEither of
        Left err -> expectationFailure $ "Failed to deserialize OTS file: " ++ err
        Right dtsf -> do
          let fileHash = B16.decodeLenient (BS8.pack "05c4f616a8e5310d19d938cfd769864d7f4ccdc2ca8b479b10af83564b097af9")
          let calendarUrls = [] -- No calendar URLs needed for this test
          bitcoinConfig <- getBitcoinConfig

          result <- verifyDetachedTimestampFile bitcoinConfig calendarUrls dtsf fileHash
          case result of
            Right (blockHeight, utcTime) -> do
              -- TODO Hardcoded CEST (UTC+2), so -2 hours from UTC
              let zonedTime = utcToZonedTime (TimeZone (-(1 * 60 * 4)) False "CEST") utcTime
              let formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z" zonedTime
              putStrLn $
                "Success! Bitcoin block " ++ show blockHeight ++ " attests existence as of " ++ formattedTime
            _ -> putStrLn "Failed"
          result
            `shouldSatisfy` ( \case
                                Right _ -> True
                                _ -> False
                            )