WebCommonSpec.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Haskoin.Store.WebCommonSpec (
    spec,
) where

import Control.Monad (forM_)
import Data.Proxy
import Data.String.Conversions (cs)
import Data.Word
import Haskoin
import Haskoin.Store.Data
import Haskoin.Store.DataSpec ()
import Haskoin.Store.WebCommon
import Haskoin.Util.Arbitrary
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck

data GenBox = forall p. (Show p, Eq p, Param p) => GenBox (Gen p)

params :: [GenBox]
params =
    [ GenBox arbitraryAddress
    , GenBox (listOf arbitraryAddress)
    , GenBox (arbitrary :: Gen StartParam)
    , GenBox (arbitrarySizedNatural :: Gen OffsetParam)
    , GenBox (arbitrarySizedNatural :: Gen LimitParam)
    , GenBox (arbitrarySizedNatural :: Gen HeightParam)
    , GenBox (arbitrary :: Gen HeightsParam)
    , GenBox (arbitrarySizedNatural :: Gen TimeParam)
    , GenBox (snd <$> arbitraryXPubKey :: Gen XPubKey)
    , GenBox (arbitrary :: Gen DeriveType)
    , GenBox (NoCache <$> arbitrary :: Gen NoCache)
    , GenBox (NoTx <$> arbitrary :: Gen NoTx)
    , GenBox arbitraryBlockHash
    , GenBox (listOf arbitraryBlockHash)
    , GenBox arbitraryTxHash
    , GenBox (listOf arbitraryTxHash)
    ]

spec :: Spec
spec =
    describe "Parameter encoding" $
        forM_ params $ \(GenBox g) -> testParam g

testParam :: (Eq a, Show a, Param a) => Gen a -> Spec
testParam pGen =
    prop ("encodeParam/parseParam identity for parameter " <> name) $
        forAll pGen $ \p ->
            case encodeParam btc p of
                Just txts -> parseParam btc txts `shouldBe` Just p
                _ -> expectationFailure "Param encoding failed"
  where
    name = cs $ proxyLabel $ proxy pGen
    proxy :: Gen a -> Proxy a
    proxy = const Proxy

instance Arbitrary StartParam where
    arbitrary =
        oneof
            [ StartParamHash <$> arbitraryHash256
            , StartParamHeight . fromIntegral
                <$> (choose (0, 1230768000) :: Gen Word64)
            , StartParamTime . fromIntegral
                <$> (choose (1230768000, maxBound) :: Gen Word64)
            ]

instance Arbitrary HeightsParam where
    arbitrary = HeightsParam <$> listOf arbitrarySizedNatural