content: {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE ImportQualifiedPost #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  
  module Haskoin.TransactionSpec (spec) where
  
  import Control.Monad (unless)
  import Data.ByteString qualified as B
  import Data.Bytes.Get
  import Data.Bytes.Put
  import Data.Bytes.Serial
  import Data.Default (def)
  import Data.Either
  import Data.Maybe
  import Data.String (fromString)
  import Data.String.Conversions
  import Data.Text (Text)
  import Data.Word (Word32, Word64)
  import Haskoin.Address
  import Haskoin.Crypto
  import Haskoin.Network.Constants
  import Haskoin.Network.Data
  import Haskoin.Script
  import Haskoin.Transaction
  import Haskoin.Util
  import Haskoin.Util.Arbitrary
  import Test.HUnit
  import Test.Hspec
  import Test.Hspec.QuickCheck
  import Test.QuickCheck
  
  identityTests :: Ctx -> IdentityTests
  identityTests ctx =
    def
      { readTests =
          [ ReadBox arbitraryTxHash,
            ReadBox $ flip arbitraryTx ctx =<< arbitraryNetwork,
            ReadBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork,
            ReadBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork,
            ReadBox arbitraryOutPoint
          ],
        jsonTests =
          [ JsonBox arbitraryTxHash,
            JsonBox $ flip arbitraryTx ctx =<< arbitraryNetwork,
            JsonBox $ flip arbitraryWitnessTx ctx =<< arbitraryNetwork,
            JsonBox $ flip arbitraryLegacyTx ctx =<< arbitraryNetwork,
            JsonBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork,
            JsonBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork,
            JsonBox arbitraryOutPoint
          ],
        serialTests =
          [ SerialBox $ flip arbitraryTx ctx =<< arbitraryNetwork,
            SerialBox $ flip arbitraryWitnessTx ctx =<< arbitraryNetwork,
            SerialBox $ flip arbitraryLegacyTx ctx =<< arbitraryNetwork,
            SerialBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork,
            SerialBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork,
            SerialBox arbitraryOutPoint
          ]
      }
  
  spec :: Spec
  spec = prepareContext $ \ctx -> do
    testIdentity $ identityTests ctx
    describe "Transaction properties" $ do
      prop "decode and encode txid" $
        forAll arbitraryTxHash $
          \h -> hexToTxHash (txHashToHex h) == Just h
      prop "from string transaction id" $
        forAll arbitraryTxHash $
          \h -> fromString (cs $ txHashToHex h) == h
      prop "building address tx" $
        forAll arbitraryNetwork $ \net ->
          forAll arbitraryAddress $
            forAll (arbitrarySatoshi net) . testBuildAddrTx net ctx
      prop "guess transaction size" $
        forAll arbitraryNetwork $ \net ->
          forAll (arbitraryAddrOnlyTxFull net ctx) (testGuessSize net ctx)
      prop "choose coins" $
        forAll arbitraryNetwork $ \net ->
          forAll (listOf (arbitrarySatoshi net)) testChooseCoins
      prop "choose multisig coins" $
        forAll arbitraryNetwork $ \net ->
          forAll arbitraryMSParam $
            forAll (listOf (arbitrarySatoshi net)) . testChooseMSCoins
      prop "sign and validate transaction" $
        forAll arbitraryNetwork $ \net ->
          forAll (arbitrarySigningData net ctx) (testDetSignTx net ctx)
      prop "sign and validate (nested) transaction" $
        forAll arbitraryNetwork $ \net ->
          forAll (arbitrarySigningData net ctx) (testDetSignNestedTx net ctx)
      prop "merge partially signed transactions" $
        forAll arbitraryNetwork $ \net ->
          property $ forAll (arbitraryPartialTxs net ctx) (testMergeTx net ctx)
    describe "Transaction vectors" $ do
      it "compute txid from tx" $ mapM_ testTxidVector txidVectors
      it "build pkhash transaction (generated from bitcoind)" $
        mapM_ (testPKHashVector ctx) pkHashVectors
  
  -- Txid Vectors
  
  testTxidVector :: (Text, Text) -> Assertion
  testTxidVector (tid, tx) =
    assertEqual "txid" (Just tid) (txHashToHex . txHash <$> txM)
    where
      txM = eitherToMaybe . runGetS deserialize =<< decodeHex tx
  
  txidVectors :: [(Text, Text)]
  txidVectors =
    [ ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63",
        "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa4\
        \3ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75\
        \418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb\
        \60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f0000000000\
        \1976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"
      ),
      ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73",
        "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3\
        \bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a\
        \04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7\
        \d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68\
        \350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b\
        \2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d0000\
        \0000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac000000\
        \00"
      ),
      ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb",
        "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2\
        \f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332ad\
        \fca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c\
        \70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f\
        \09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919a\
        \d1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737\
        \864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a473044\
        \0220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa\
        \2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f8\
        \1e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc8\
        \0a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd32273276\
        \94c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df3\
        \2949d4646dfa10a92458cfaa88ac00000000"
      ),
      ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae",
        "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c5\
        \9da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678\
        \fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab\
        \486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b\
        \52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbe\
        \a097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045\
        \022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf9506\
        \50802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f\
        \68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e3\
        \77c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e1\
        \8217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a378\
        \8dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972\
        \d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2\
        \e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffff\
        \ff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9c\
        \fdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675\
        \d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa\
        \34b26f62db4a88ac00000000"
      )
    ]
  
  -- Build address transactions vectors generated from bitcoin-core raw tx API
  
  testPKHashVector :: Ctx -> ([(Text, Word32)], [(Text, Word64)], Text) -> Assertion
  testPKHashVector ctx (is, os, res) =
    assertEqual
      "Build PKHash Tx"
      (Right res)
      (encodeHex . runPutS . serialize <$> txE)
    where
      txE = buildAddrTx btc ctx (map f is) os
      f (tid, ix) = OutPoint (fromJust $ hexToTxHash tid) ix
  
  pkHashVectors :: [([(Text, Word32)], [(Text, Word64)], Text)]
  pkHashVectors =
    [ ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",
            14
          )
        ],
        [("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 90000000)],
        "0100000001db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\
        \a1eb29eb0e00000000ffffffff01804a5d05000000001976a91424aa604689cc58\
        \2292b97668bedd91dd5bf9374c88ac00000000"
      ),
      ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",
            0
          ),
          ( "0001000000000000000000000000000000000000000000000000000000000000",
            2147483647
          )
        ],
        [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1),
          ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000)
        ],
        "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654\
        \a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000\
        \000000000000000000000100ffffff7f00ffffffff0201000000000000001976a9\
        \1424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976\
        \a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000"
      ),
      ( [ ( "eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",
            0
          ),
          ( "0001000000000000000000000000000000000000000000000000000000000000",
            2147483647
          )
        ],
        [],
        "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a\
        \1eb29eb0000000000ffffffff000000000000000000000000000000000000000000\
        \0000000000000000000100ffffff7f00ffffffff0000000000"
      ),
      ( [],
        [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb", 1),
          ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n", 2100000000000000)
        ],
        "01000000000201000000000000001976a91424aa604689cc582292b97668bedd91d\
        \d5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954\
        \993cbca54f88ac00000000"
      )
    ]
  
  -- Transaction Properties --
  
  testBuildAddrTx :: Network -> Ctx -> Address -> TestCoin -> Bool
  testBuildAddrTx net ctx a (TestCoin v)
    | isPubKeyAddress a = PayPKHash a.hash160 == out
    | isScriptAddress a = PayScriptHash a.hash160 == out
    | otherwise = undefined
    where
      out = either error id $ do
        tx <- buildAddrTx net ctx [] [(fromJust (addrToText net a), v)]
        unmarshal ctx (head tx.outputs).script
  
  -- We compute an upper bound but it should be close enough to the real size
  -- We give 2 bytes of slack on every signature (1 on r and 1 on s)
  testGuessSize :: Network -> Ctx -> Tx -> Bool
  testGuessSize net ctx tx =
    guess >= len && guess <= len + 2 * delta
    where
      delta = pki + sum (map fst msi)
      guess = guessTxSize pki msi pkout msout
      len = B.length $ runPutS $ serialize tx
      ins = map f tx.inputs
      f i = either error id $ unmarshal (net, ctx) i.script
      pki = length $ filter isSpendPKHash ins
      msi = concatMap shData ins
      shData (ScriptHashInput _ (PayMulSig keys r)) = [(r, length keys)]
      shData _ = []
      out = map (either error id . unmarshal ctx . (.script)) tx.outputs
      pkout = length $ filter isPayPKHash out
      msout = length $ filter isPayScriptHash out
  
  testChooseCoins :: [TestCoin] -> Word64 -> Word64 -> Int -> Property
  testChooseCoins coins target byteFee nOut =
    nOut >= 0 ==>
      case chooseCoins target byteFee nOut True coins of
        Right (chosen, change) ->
          let outSum = sum $ map coinValue chosen
              fee = guessTxFee byteFee nOut (length chosen)
           in outSum == target + change + fee
        Left _ ->
          let fee = guessTxFee byteFee nOut (length coins)
           in target == 0 || s < target + fee
    where
      s = sum $ map coinValue coins
  
  testChooseMSCoins ::
    (Int, Int) ->
    [TestCoin] ->
    Word64 ->
    Word64 ->
    Int ->
    Property
  testChooseMSCoins (m, n) coins target byteFee nOut =
    nOut >= 0 ==>
      case chooseMSCoins target byteFee (m, n) nOut True coins of
        Right (chosen, change) ->
          let outSum = sum $ map coinValue chosen
              fee = guessMSTxFee byteFee (m, n) nOut (length chosen)
           in outSum == target + change + fee
        Left _ ->
          let fee = guessMSTxFee byteFee (m, n) nOut (length coins)
           in target == 0 || s < target + fee
    where
      s = sum $ map coinValue coins
  
  {- Signing Transactions -}
  
  testDetSignTx :: Network -> Ctx -> (Tx, [SigInput], [PrivateKey]) -> Bool
  testDetSignTx net ctx (tx, sigis, prv) =
    not verify1 && not verify2 && verify3
    where
      verify1 = verifyStdTx net ctx tx verData
      verify2 = verifyStdTx net ctx txSigP verData
      verify3 = verifyStdTx net ctx txSigC verData
      txSigP = either error id $ signTx net ctx tx sigis (map (.key) (tail prv))
      txSigC = either error id $ signTx net ctx txSigP sigis [(head prv).key]
      sigData SigInput {..} = (script, value, outpoint)
      verData = map sigData sigis
  
  testDetSignNestedTx :: Network -> Ctx -> (Tx, [SigInput], [PrivateKey]) -> Bool
  testDetSignNestedTx net ctx (tx, sigis, prv) =
    not verify1 && not verify2 && verify3
    where
      verify1 = verifyStdTx net ctx tx verData
      verify2 = verifyStdTx net ctx txSigP verData
      verify3 = verifyStdTx net ctx txSigC verData
      txSigP =
        either error id $
          signNestedWitnessTx net ctx tx sigis ((.key) <$> tail prv)
      txSigC =
        either error id $
          signNestedWitnessTx net ctx txSigP sigis [(head prv).key]
      verData = handleSegwit <$> sigis
      handleSegwit (SigInput s v o _ _)
        | isSegwit s = (toP2SH (encodeOutput ctx s), v, o)
        | otherwise = (s, v, o)
  
  testMergeTx :: Network -> Ctx -> ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) -> Bool
  testMergeTx net ctx (txs, os) =
    and
      [ isRight mergeRes,
        length mergedTx.inputs == length os,
        if enoughSigs
          then isValid
          else not isValid,
        -- Signature count == min (length txs) (sum required signatures)
        sum (map snd sigMap) == min (length txs) (sum (map fst sigMap))
      ]
    where
      outs = map (\(so, val, op, _, _) -> (so, val, op)) os
      mergeRes = mergeTxs net ctx txs outs
      mergedTx = fromRight (error "Could not merge") mergeRes
      isValid = verifyStdTx net ctx mergedTx outs
      enoughSigs = all (\(m, c) -> c >= m) sigMap
      sigFun (_, _, _, m, _) inp = (m, sigCnt inp)
      sigMap = zipWith sigFun os mergedTx.inputs
      sigCnt inp =
        case unmarshal (net, ctx) inp.script of
          Right (RegularInput (SpendMulSig sigs)) -> length sigs
          Right (ScriptHashInput (SpendMulSig sigs) _) -> length sigs
          _ -> error "Invalid input script type"
  