Arbitrary.hs

{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Arbitrary instances and data types for use in test suites.
module Network.Haskoin.Stratum.Arbitrary
( -- * Arbitrary Data
  ReqRes(..)
) where

import Control.Applicative
import Data.Aeson.Types hiding (Error)
import Data.Text (Text)
import qualified Data.Text as T
import Network.JsonRpc
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen
import Network.Haskoin.Protocol.Arbitrary ()
import Network.Haskoin.Stratum
import Network.Haskoin.Protocol hiding (Message)

-- | A pair of a request and its corresponding response.
-- Id and version should match.
data ReqRes q r = ReqRes !(Request q) !(Response r)
    deriving (Show, Eq)

instance Arbitrary (ReqRes Value Value) where
    arbitrary = do
        rq <- arbitrary
        rs <- arbitrary
        let rs' = rs { getResId = getReqId rq, getResVer = getReqVer rq }
        return $ ReqRes rq rs'

instance Arbitrary Text where
    arbitrary = T.pack <$> arbitrary

instance Arbitrary Ver where
    arbitrary = elements [V1, V2]

instance (Arbitrary q, ToRequest q) => Arbitrary (Request q) where
    arbitrary = do
        q <- arbitrary
        v <- arbitrary
        let m = requestMethod q
        Request v m q <$> arbitrary

instance (Arbitrary n, ToNotif n) => Arbitrary (Notif n) where
    arbitrary = do
        n <- arbitrary
        v <- arbitrary
        let m = notifMethod n
        return $ Notif v m n

instance Arbitrary r => Arbitrary (Response r) where
    arbitrary = Response <$> arbitrary <*> arbitrary <*> arbitrary

instance Arbitrary ErrorObj where
    arbitrary = ErrorObj <$> arbitrary <*> arbitrary <*> arbitrary
                         <*> arbitrary <*> arbitrary

instance ( Arbitrary q, Arbitrary n, Arbitrary r
         , ToRequest q, ToNotif n, ToJSON r )
    => Arbitrary (Message q n r)
  where
    arbitrary = oneof [ MsgRequest  <$> arbitrary
                      , MsgNotif    <$> arbitrary
                      , MsgResponse <$> arbitrary
                      , MsgError    <$> arbitrary ]

instance Arbitrary Id where
    arbitrary = oneof [IdInt <$> arbitrary, IdTxt <$> arbitrary]

instance Arbitrary Value where
    arbitrary = resize 10 $ oneof [val, lsn, objn] where
        val = oneof [ toJSON <$> (arbitrary :: Gen String)
                    , toJSON <$> (arbitrary :: Gen Int)
                    , toJSON <$> (arbitrary :: Gen Double)
                    , toJSON <$> (arbitrary :: Gen Bool) ]
        ls   = toJSON <$> listOf val
        obj  = object . map (\(t, v) -> (T.pack t, v)) <$> listOf ps
        ps   = (,) <$> (arbitrary :: Gen String) <*> oneof [val, ls]
        lsn  = toJSON <$> listOf (oneof [ls, obj, val])
        objn = object . map (\(t, v) -> (T.pack t, v)) <$> listOf psn
        psn  = (,) <$> (arbitrary :: Gen String) <*> oneof [val, ls, obj]



--
-- Stratum
--

instance Arbitrary StratumTxInfo where
    arbitrary = StratumTxInfo <$> arbitrary <*> arbitrary

instance Arbitrary StratumCoin where
    arbitrary = do
        h <- arbitrary
        o@(OutPoint i _) <- arbitrary
        let t = StratumTxInfo h i
        StratumCoin o t <$> arbitrary

instance Arbitrary StratumRequest where
    arbitrary = oneof [ StratumReqVersion <$> arbitrary <*> arbitrary
                      , StratumReqHistory <$> arbitrary
                      , StratumReqBalance <$> arbitrary
                      , StratumReqUnspent <$> arbitrary
                      , StratumReqTx      <$> arbitrary
                      , StratumBcastTx    <$> arbitrary
                      , StratumSubAddr    <$> arbitrary ]

instance Arbitrary StratumNotif where
    arbitrary = StratumNotifAddr <$> arbitrary <*> arbitrary

instance Arbitrary StratumResult where
    arbitrary = oneof [ StratumSrvVersion  <$> arbitrary
                      , StratumAddrHistory <$> arbitrary
                      , StratumAddrBalance <$> arbitrary <*> arbitrary
                      , StratumAddrUnspent <$> arbitrary
                      , StratumAddrStatus  <$> arbitrary
                      , StratumTx          <$> arbitrary
                      , StratumBcastId     <$> arbitrary ]

instance Arbitrary (ReqRes StratumRequest StratumResult) where
    arbitrary = do
        (q, s) <- oneof
            [ (,) <$> (StratumReqVersion  <$> arbitrary <*> arbitrary)
                  <*> (StratumSrvVersion  <$> arbitrary)
            , (,) <$> (StratumReqHistory  <$> arbitrary)
                  <*> (StratumAddrHistory <$> arbitrary)
            , (,) <$> (StratumReqBalance  <$> arbitrary)
                  <*> (StratumAddrBalance <$> arbitrary <*> arbitrary)
            , (,) <$> (StratumReqUnspent  <$> arbitrary)
                  <*> (StratumAddrUnspent <$> arbitrary)
            , (,) <$> (StratumReqTx       <$> arbitrary)
                  <*> (StratumTx          <$> arbitrary)
            , (,) <$> (StratumBcastTx     <$> arbitrary)
                  <*> (StratumBcastId     <$> arbitrary) ]
        i <- arbitrary
        ver <- arbitrary
        return $ ReqRes (Request ver (requestMethod q) q i) (Response ver s i)