Tests.hs

module Network.Haskoin.Transaction.Tests (tests) where

import Test.Framework (Test, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)

import Data.Word (Word64)
import qualified Data.ByteString as BS (length)

import Network.Haskoin.Transaction.Arbitrary
import Network.Haskoin.Transaction.Builder
import Network.Haskoin.Protocol
import Network.Haskoin.Script
import Network.Haskoin.Crypto
import Network.Haskoin.Util

tests :: [Test]
tests = 
    [ testGroup "Building Transactions"
        [ testProperty "building address tx" testBuildAddrTx
        , testProperty "testing guessTxSize function" testGuessSize
        , testProperty "testing chooseCoins function" testChooseCoins
        , testProperty "testing chooseMSCoins function" testChooseMSCoins
        ]
    -- TODO: Turn these tests into unit tests as they are very heavy 
    , testGroup "Signing Transactions"
        [ testProperty "Sign and validate PKHash transactions" testSignTx
        , testProperty "Sign and validate Multisig transactions" testSignMS
        ]
    ]

{- Building Transactions -}

testBuildAddrTx :: [OutPoint] -> Address -> Word64 -> Bool
testBuildAddrTx os a v 
    | v <= 2100000000000000 = isRight tx && case a of
        x@(PubKeyAddress _) -> Right (PayPKHash x) == out
        x@(ScriptAddress _) -> Right (PayScriptHash x) == out
    | otherwise = isLeft tx
    where tx  = buildAddrTx os [(addrToBase58 a,v)]
          out = decodeOutputBS $ scriptOutput $ txOut (fromRight tx) !! 0

testGuessSize :: SpendAddrTx -> Bool
testGuessSize (SpendAddrTx tx) =
    -- 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)
    guess >= len && guess - 2*delta <= len
    where delta   = pki + (sum $ map fst msi)
          guess   = guessTxSize pki msi pkout msout
          len     = BS.length $ encode' tx
          ins     = map f $ txIn tx
          f i     = fromRight $ decodeInputBS $ scriptInput i
          pki     = length $ filter isSpendPKHash ins
          msi     = concat $ map shData ins
          shData (ScriptHashInput _ (PayMulSig keys r)) = [(r,length keys)]
          shData _ = []
          out      = map (fromRight . decodeOutputBS . scriptOutput) $ txOut tx
          pkout    = length $ filter isPayPKHash out
          msout    = length $ filter isPayScriptHash out

testChooseCoins :: Word64 -> Word64 -> [Coin] -> Bool
testChooseCoins target kbfee xs = case chooseCoins target kbfee xs of
    Right (chosen,change) ->
        let outSum = sum $ map coinValue chosen
            fee    = getFee kbfee (length chosen) 
        in outSum == target + change + fee
    Left _ -> 
        let fee = getFee kbfee (length xs) 
        in target == 0 || s < target || s < target + fee
    where s = sum $ map coinValue xs

testChooseMSCoins :: Word64 -> Word64 -> MSParam -> [Coin] -> Bool
testChooseMSCoins target kbfee (MSParam m n) xs = 
    case chooseMSCoins target kbfee (m,n) xs of
        Right (chosen,change) ->
            let outSum = sum $ map coinValue chosen
                fee    = getMSFee kbfee (m,n) (length chosen) 
            in outSum == target + change + fee
        Left _ -> 
            let fee = getMSFee kbfee (m,n) (length xs) 
            in target == 0 || s < target + fee
    where s = sum $ map coinValue xs

{- Signing Transactions -}

testSignTx :: PKHashSigTemplate -> Bool
testSignTx (PKHashSigTemplate tx sigi prv)
    | null $ txIn tx = (isLeft res) && (isLeft resP)
    | otherwise = (not $ verifyStdTx tx verData)
                      && isRight res && stat
                      && verifyStdTx txSig verData
                      && isRight resP && (not statP)
                      && (not $ verifyStdTx txSigP verData)
                      && isRight resC && statC
                      && verifyStdTx txSigC verData
    where res             = detSignTx tx sigi prv
          (txSig, stat)   = fromRight res
          resP            = detSignTx tx sigi (tail prv)
          (txSigP, statP) = fromRight resP
          resC            = detSignTx txSigP sigi [head prv]
          (txSigC, statC) = fromRight resC
          verData = map (\(SigInput s o _ _) -> (s,o)) sigi
         
testSignMS :: MulSigTemplate -> Bool
testSignMS (MulSigTemplate tx sigi prv)
    | null $ txIn tx = (isLeft res) && (isLeft resP)
    | otherwise = (not $ verifyStdTx tx verData)
                      && isRight res && stat
                      && verifyStdTx txSig verData
                      && isRight resP && (not statP)
                      && (not $ verifyStdTx txSigP verData)
                      && isRight resC && statC
                      && verifyStdTx txSigC verData
    where res             = detSignTx tx sigi prv
          (txSig, stat)   = fromRight res
          resP            = detSignTx tx sigi (tail prv)
          (txSigP, statP) = fromRight resP
          resC            = detSignTx txSigP sigi [head prv]
          (txSigC, statC) = fromRight resC
          verData = map (\(SigInput s o _ _) -> (s,o)) sigi