{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use lambda-case" #-}

module Spec (main) where

import qualified PruneSpec
import qualified UpgradeSpec
import qualified VerifySpec

import Arbitrary ()
import Data.Binary.Get (runGet, runGetOrFail)
import Data.Binary.Put (runPut)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL
import Data.List (isPrefixOf)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified OpenTimestamps as OTS
import OpenTimestamps.Attestation (Attestation (..))
import OpenTimestamps.DetachedTimestampFile
  ( DetachedTimestampFile
  )
import qualified OpenTimestamps.DetachedTimestampFile as DTSF
  ( deserialize
  , digestLen
  , digestType
  , serialize
  , timestamp
  )
import OpenTimestamps.Op as Op
  ( Op (Append, Hexlify, Keccak256, Prepend, Reverse, Ripemd160, Sha1, Sha256)
  , execute
  , getOp
  , opToTag
  , putOp
  )
import OpenTimestamps.Timestamp as TS
  ( Timestamp (..)
  , deserialize
  , getAttestations
  , getMerkleRoot
  , getPendingAttestationsWithMsgs
  , isTimestampComplete
  , merge
  , serialize
  )
import qualified OpenTimestamps.Upgrade as Upgrade
import System.FilePath ((</>))
import System.Random (newStdGen, randomRs)
import Test.Hspec
  ( Spec
  , describe
  , expectationFailure
  , hspec
  , it
  , shouldBe
  , shouldSatisfy
  )
import Test.QuickCheck
  ( quickCheck
  )

main :: IO ()
main = hspec spec

{-
calendarUrls :: [String]
calendarUrls =
  [ "https://a.pool.opentimestamps.org"
  , "https://b.pool.opentimestamps.org"
  , "https://a.pool.eternitywall.com"
  , "https://ots.btc.catallaxy.com"
  ]
-}

spec :: Spec
spec = do
  let examplesDir = "examples"
  describe "stamp" $ do
    it "creates a timestamp with the correct structure" $ do
      let originalDigest = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"
      let nonce = "\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f"
      let appendedDigest = originalDigest <> nonce
      let submissionDigest = "\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f"

      let serverTimestamp = TS.Timestamp {TS.timestampMsg = submissionDigest, TS.attestations = mempty, TS.ops = mempty}

      let expectedTimestamp =
            TS.Timestamp
              { TS.timestampMsg = originalDigest
              , TS.attestations = mempty
              , TS.ops =
                  Map.singleton (Op.Append nonce) $
                    TS.Timestamp
                      { TS.timestampMsg = appendedDigest
                      , TS.attestations = mempty
                      , TS.ops = Map.singleton Op.Sha256 serverTimestamp
                      }
              }

      TS.timestampMsg expectedTimestamp `shouldBe` originalDigest

      case Map.toList (TS.ops expectedTimestamp) of
        [(Op.Append nonce', intermediateTimestamp)] -> do
          nonce' `shouldBe` nonce
          TS.timestampMsg intermediateTimestamp `shouldBe` appendedDigest
          case Map.toList (TS.ops intermediateTimestamp) of
            [(Op.Sha256, finalTimestamp)] -> do
              TS.timestampMsg finalTimestamp `shouldBe` submissionDigest
            _ -> expectationFailure "Expected a Sha256 operation"
        _ -> expectationFailure "Expected an Append operation"

    it "stamps random content and verifies the resulting OTS file using internal info" $ do
      -- Generate random content
      gen <- newStdGen
      let randomBytes = BSC.pack $ take 32 $ randomRs ('a', 'z') gen
      let randomContent = BSL.fromStrict randomBytes

      -- Stamp the random content
      let calendarUrl = "https://a.pool.opentimestamps.org"
      stampResult <- OTS.stamp [calendarUrl] (BSL.toStrict randomContent)

      -- Verify no errors and a timestamp file is returned
      OTS.srErrors stampResult `shouldBe` []
      OTS.srTimestampFile stampResult
        `shouldSatisfy` (\x -> case x of Just _ -> True; Nothing -> False)

      -- Extract and serialize the DetachedTimestampFile
      case OTS.srTimestampFile stampResult of
        Just otsFile -> do
          let serializedOts = DTSF.serialize otsFile
          let infoResult = OTS.info serializedOts
          infoResult `shouldSatisfy` either (const False) (const True)
        Nothing -> expectationFailure "No timestamp file returned by stamp operation"
  describe "OpenTimestamps.Op" $ do
    it "can be round-tripped" $
      quickCheck propRoundtripOp
    it "hash operations are idempotent" $
      quickCheck propHashIdempotent
    it "operations compose consistently" $
      quickCheck propOpComposition
    it "length is preserved for non-appending operations" $
      quickCheck propLengthPreservation

  describe "OpenTimestamps.Timestamp" $ do
    it "serialization is round-trip" $
      quickCheck propTimestampRoundTrip
    it "serialization is deterministic" $
      quickCheck propSerializationDeterministic
    it "message is preserved through serialization" $
      quickCheck propMessagePreservation
    it "merge is idempotent" $
      quickCheck propMergeIdempotent
    it "merge is commutative" $
      quickCheck propMergeCommutative
    it "merge accumulates attestations" $
      quickCheck propMergeAttestationAccumulation
    it "merkle root is consistent with operations" $
      quickCheck propMerkleRootConsistency
    it "merkle root is deterministic" $
      quickCheck propMerkleRootDeterministic
    it "completeness depends only on Bitcoin attestations" $
      quickCheck propCompletenessBitcoinDetection
    it "completeness propagates from sub-timestamps" $
      quickCheck propCompletenessNested

  describe "OpenTimestamps.DetachedTimestampFile" $ do
    it "serialization is round-trip" $
      quickCheck propDetachedFileRoundTrip
    it "digest type consistency" $
      quickCheck propDigestTypeConsistency

  describe "OpenTimestamps.Attestation" $ do
    it "collection is complete" $
      quickCheck propAttestationCollectionComplete
    it "collection has no duplicates" $
      quickCheck propAttestationCollectionUnique
    it "pending attestations are correctly filtered" $
      quickCheck propPendingAttestationFiltering
    it "all attestation types are handled" $
      quickCheck propAttestationTypeDistribution

  describe "OpenTimestamps" $ do
    let otsFiles =
          [ "bad-stamp.txt.ots"
          , "bitcoin.pdf.ots"
          , "different-blockchains.txt.ots"
          , "empty.ots"
          , "hello-world.txt.ots"
          , "incomplete.txt.ots"
          , "invalid/bad-major-version.ots"
          , "invalid/exceeds-max-msg-length.ots"
          , "invalid/invalid-file-digest-type.ots"
          , "known-and-unknown-notary.txt.ots"
          , "merkle1.txt.ots"
          , "merkle2.txt.ots"
          , "merkle3.txt.ots"
          , "sha1/a-or-b.ots"
          , "two-calendars.txt.ots"
          , "unknown-notary.txt.ots"
          ]
    mapM_
      ( \otsFile ->
          it ("info parses " ++ otsFile) $ do
            otsFileContent <- BSL.readFile (examplesDir </> otsFile)
            let result = OTS.info otsFileContent
            if "invalid/" `isPrefixOf` otsFile
              then result `shouldSatisfy` either (const True) (const False)
              else result `shouldSatisfy` either (const False) (const True)
      )
      otsFiles

  describe "upgrade" $ do
    it "upgrades an incomplete example timestamp from a calendar" $ do
      let otsFile = examplesDir </> "incomplete.txt.ots"
      otsFileContent <- BSL.readFile otsFile
      -- let calendarUrl = "https://alice.btc.calendar.opentimestamps.org"
      -- result <- OTS.upgrade calendarUrls otsFileContent
      -- result <- OTS.upgrade [calendarUrl] otsFileContent
      result <- OTS.upgrade [] otsFileContent
      case result of
        Left err -> expectationFailure $ "Upgrade failed: " ++ err
        Right upgradedOtsContent -> do
          let deserializedResult = OTS.info upgradedOtsContent
          case deserializedResult of
            Left err -> expectationFailure $ "Failed to deserialize upgraded OTS: " ++ err
            Right dtfs -> do
              TS.isTimestampComplete (DTSF.timestamp dtfs) `shouldBe` True
              putStrLn $ "\nLength of example upgradedOtsContent: " ++ show (BSL.length upgradedOtsContent)
              putStrLn $
                "First 100 bytes of example upgradedOtsContent: " ++ show (BSL.take 100 upgradedOtsContent)

  describe "fetchTimestampFromCalendar" $ do
    it "fetches a complete timestamp to upgrade from a calendar" $ do
      let calendarUrl = "https://alice.btc.calendar.opentimestamps.org"
      let msgHex = "57cfa5c46716df9bd9e83595bce439c58108d8fcc1678f30d4c6731c3f1fa6c79ed712c66fb1ac8d4e4eb0e7"
      let msg = case B16.decode $ TE.encodeUtf8 msgHex of
            Left err -> error $ "Failed to decode hex: " ++ err
            Right bs -> bs
      result <- Upgrade.fetchTimestampFromCalendar (T.pack calendarUrl) msg
      case result of
        Left err -> expectationFailure $ "fetchTimestampFromCalendar failed: " ++ err
        Right ts ->
          TS.isTimestampComplete ts `shouldBe` True

  PruneSpec.spec
  UpgradeSpec.spec
  VerifySpec.spec

propRoundtripOp :: Op -> Bool
propRoundtripOp op =
  let serialized = runPut (putOp op)
      tag = opToTag op
      deserialized = runGet (getOp tag) (BSL.drop 1 serialized)
   in deserialized == op

-- | Hash operations should be idempotent (applying twice gives same result)
propHashIdempotent :: Op -> BS.ByteString -> Bool
propHashIdempotent op input =
  case op of
    Sha1 -> execute op (execute op input) == execute op input
    Sha256 -> execute op (execute op input) == execute op input
    Ripemd160 -> execute op (execute op input) == execute op input
    Keccak256 -> execute op (execute op input) == execute op input
    _ -> True -- Skip non-hash operations

-- | Operations should compose consistently
propOpComposition :: Op -> Op -> BS.ByteString -> Bool
propOpComposition op1 op2 input =
  let result1 = execute op2 (execute op1 input)
      result2 = execute op1 (execute op2 input)
   in -- For commutative operations, results should be the same
      -- For non-commutative, we just check they're both valid
      case (op1, op2) of
        (Reverse, Reverse) -> result1 == result2 -- Double reverse should be identity
        (Append _, Prepend _) -> True -- Different append/prepend order gives different results
        (Prepend _, Append _) -> True -- Different append/prepend order gives different results
        _ -> BS.length result1 == BS.length result2 -- Same length for same type operations

-- | Length preservation for operations that shouldn't change length
propLengthPreservation :: Op -> BS.ByteString -> Bool
propLengthPreservation op input =
  case op of
    Sha1 -> BS.length (execute op input) == 20 -- SHA1 produces 20 bytes
    Sha256 -> BS.length (execute op input) == 32 -- SHA256 produces 32 bytes
    Ripemd160 -> BS.length (execute op input) == 20 -- RIPEMD160 produces 20 bytes
    Keccak256 -> BS.length (execute op input) == 32 -- Keccak256 produces 32 bytes
    Hexlify -> BS.length (execute op input) == BS.length input * 2 -- Hexlify doubles length
    Reverse -> BS.length (execute op input) == BS.length input -- Reverse preserves length
    Append bs -> BS.length (execute op input) == BS.length input + BS.length bs -- Append adds length
    Prepend bs -> BS.length (execute op input) == BS.length input + BS.length bs -- Prepend adds length

-- | Check if a timestamp tree contains any empty timestamps
hasEmptyTimestamps :: Timestamp -> Bool
hasEmptyTimestamps ts =
  (Set.null (TS.attestations ts) && Map.null (TS.ops ts))
    || any hasEmptyTimestamps (Map.elems (TS.ops ts))

-- | Timestamp serialization round-trip property
propTimestampRoundTrip :: Timestamp -> Bool
propTimestampRoundTrip ts =
  -- Skip timestamps that contain empty sub-timestamps
  hasEmptyTimestamps ts
    || ( let serialized = TS.serialize ts
             deserialized = TS.deserialize (TS.timestampMsg ts)
          in case runGetOrFail deserialized serialized of
               Left _ -> False
               Right (_, _, result) -> result == ts
       )

-- | Serialization should be deterministic (same timestamp always serializes the same way)
propSerializationDeterministic :: Timestamp -> Bool
propSerializationDeterministic ts =
  -- Skip timestamps that contain empty sub-timestamps
  hasEmptyTimestamps ts
    || ( let ser1 = TS.serialize ts
             ser2 = TS.serialize ts
          in ser1 == ser2
       )

-- | The root message should be preserved through serialization cycles
propMessagePreservation :: Timestamp -> Bool
propMessagePreservation ts =
  -- Skip timestamps that contain empty sub-timestamps
  hasEmptyTimestamps ts
    || ( let serialized = TS.serialize ts
             deserialized = TS.deserialize (TS.timestampMsg ts)
          in case runGetOrFail deserialized serialized of
               Left _ -> False
               Right (_, _, result) ->
                 TS.timestampMsg result == TS.timestampMsg ts
       )

-- | Merge operation should be idempotent
propMergeIdempotent :: Timestamp -> Bool
propMergeIdempotent ts =
  let (merged, changed) = TS.merge ts ts
   in merged == ts && not changed

-- | Merge operation should be commutative
propMergeCommutative :: Timestamp -> Timestamp -> Bool
propMergeCommutative ts1 ts2 =
  let (merged1, _) = TS.merge ts1 ts2
      (merged2, _) = TS.merge ts2 ts1
   in merged1 == merged2

-- | Merge should accumulate all unique attestations
propMergeAttestationAccumulation :: Timestamp -> Timestamp -> Bool
propMergeAttestationAccumulation ts1 ts2 =
  let (merged, _) = TS.merge ts1 ts2
      originalAtts = Set.union (TS.attestations ts1) (TS.attestations ts2)
   in TS.attestations merged == originalAtts

-- | DetachedTimestampFile serialization round-trip property
propDetachedFileRoundTrip :: DetachedTimestampFile -> Bool
propDetachedFileRoundTrip dtf =
  -- Skip files with empty timestamps that can't be serialized
  hasEmptyTimestamps (DTSF.timestamp dtf)
    || let serialized = DTSF.serialize dtf
           deserialized = DTSF.deserialize serialized
        in case deserialized of
             Left _ -> False
             Right result -> result == dtf

-- | Digest type should be consistent with message length
propDigestTypeConsistency :: DetachedTimestampFile -> Bool
propDigestTypeConsistency dtf =
  let msg = TS.timestampMsg (DTSF.timestamp dtf)
      expectedLen = DTSF.digestLen (DTSF.digestType dtf)
   in BS.length msg == expectedLen

-- | Merkle root should be consistent with timestamp operations
propMerkleRootConsistency :: Timestamp -> Bool
propMerkleRootConsistency ts =
  -- Skip empty timestamps
  -- The merkle root should be the result of applying all operations to the root message
  -- For now, just check that it's deterministic for the same timestamp
  hasEmptyTimestamps ts || (getMerkleRoot ts == getMerkleRoot ts)

-- | Merkle root should be deterministic for identical timestamps
propMerkleRootDeterministic :: Timestamp -> Bool
propMerkleRootDeterministic ts =
  -- Skip empty timestamps
  hasEmptyTimestamps ts || (getMerkleRoot ts == getMerkleRoot ts)

-- | Completeness should depend only on Bitcoin attestations
propCompletenessBitcoinDetection :: Timestamp -> Bool
propCompletenessBitcoinDetection ts =
  -- Skip empty timestamps
  hasEmptyTimestamps ts
    || (isTimestampComplete ts == any isBitcoinAttestation (getAttestations ts))
  where
    isBitcoinAttestation (Bitcoin _) = True
    isBitcoinAttestation _ = False

-- | Completeness should propagate from sub-timestamps
propCompletenessNested :: Timestamp -> Bool
propCompletenessNested ts =
  -- Skip empty timestamps
  -- A timestamp is complete if any sub-timestamp is complete
  hasEmptyTimestamps ts
    || (isTimestampComplete ts == any isTimestampComplete (ts : allSubTimestamps ts))
  where
    allSubTimestamps t = concatMap (allSubTimestamps . snd) (Map.toList (TS.ops t))

-- | All attestations in the tree are collected
propAttestationCollectionComplete :: Timestamp -> Bool
propAttestationCollectionComplete ts =
  -- Skip empty timestamps
  hasEmptyTimestamps ts
    || let collected = getAttestations ts
           allAtts = collectAllAttestations ts
        in length collected == length allAtts
             && all (`elem` collected) allAtts

-- | No duplicate attestations in collection
propAttestationCollectionUnique :: Timestamp -> Bool
propAttestationCollectionUnique ts =
  let collected = getAttestations ts
      deduplicated = Set.toList $ Set.fromList collected
   in length collected == length deduplicated

-- | Pending attestations are correctly filtered and paired
propPendingAttestationFiltering :: Timestamp -> Bool
propPendingAttestationFiltering ts =
  let pendingPairs = getPendingAttestationsWithMsgs ts
      allAtts = getAttestations ts
      pendingAtts = filter isPending allAtts
   in length pendingPairs == length pendingAtts
        && all
          ( \(msg, att) ->
              isPending att
                && any (\ts' -> TS.timestampMsg ts' == msg) (allTimestamps ts)
          )
          pendingPairs

-- | All attestation types are handled
propAttestationTypeDistribution :: Timestamp -> Bool
propAttestationTypeDistribution ts =
  let allAtts = getAttestations ts
      hasBitcoin = any isBitcoin allAtts
      hasPending = any isPending allAtts
      hasUnknown = any isUnknown allAtts
   in -- At least one type should be present if there are attestations
      (null allAtts || (hasBitcoin || hasPending || hasUnknown))

-- Helper functions for attestation property tests

-- | Recursively collect all attestations from timestamp tree
collectAllAttestations :: Timestamp -> [Attestation]
collectAllAttestations ts =
  Set.toList (TS.attestations ts)
    ++ concatMap (collectAllAttestations . snd) (Map.toList $ TS.ops ts)

-- | Get all timestamps in the tree
allTimestamps :: Timestamp -> [Timestamp]
allTimestamps ts = ts : concatMap (allTimestamps . snd) (Map.toList $ TS.ops ts)

-- | Type predicates
isBitcoin, isPending, isUnknown :: Attestation -> Bool
isBitcoin (Bitcoin _) = True
isBitcoin _ = False
isPending (Pending _) = True
isPending _ = False
isUnknown (Unknown _ _) = True
isUnknown _ = False