{-# LANGUAGE TupleSections #-}

{- |
Module      : Haskoin.Test.Address
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX
-}
module Haskoin.Util.Arbitrary.Address where

import qualified Data.ByteString as B
import Haskoin.Address
import Haskoin.Constants
import Haskoin.Data
import Haskoin.Util.Arbitrary.Crypto
import Haskoin.Util.Arbitrary.Util
import Test.QuickCheck

-- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.
arbitraryAddress :: Gen Address
arbitraryAddress :: Gen Address
arbitraryAddress = [Gen Address] -> Gen Address
forall a. [Gen a] -> Gen a
oneof [Gen Address
arbitraryPubKeyAddress, Gen Address
arbitraryScriptAddress]

-- | Arbitrary address including pay-to-witness
arbitraryAddressAll :: Gen Address
arbitraryAddressAll :: Gen Address
arbitraryAddressAll =
    [Gen Address] -> Gen Address
forall a. [Gen a] -> Gen a
oneof
        [ Gen Address
arbitraryPubKeyAddress
        , Gen Address
arbitraryScriptAddress
        , Gen Address
arbitraryWitnessPubKeyAddress
        , Gen Address
arbitraryWitnessScriptAddress
        , Gen Address
arbitraryWitnessAddress
        ]

-- | Arbitrary valid combination of (Network, Address)
arbitraryNetAddress :: Gen (Network, Address)
arbitraryNetAddress :: Gen (Network, Address)
arbitraryNetAddress = do
    Network
net <- Gen Network
arbitraryNetwork
    if Network
net Network -> [Network] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Network
bch, Network
bchTest, Network
bchTest4, Network
bchRegTest]
        then (Network
net,) (Address -> (Network, Address))
-> Gen Address -> Gen (Network, Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
arbitraryAddress
        else (Network
net,) (Address -> (Network, Address))
-> Gen Address -> Gen (Network, Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
arbitraryAddressAll

-- | Arbitrary pay-to-public-key-hash address.
arbitraryPubKeyAddress :: Gen Address
arbitraryPubKeyAddress :: Gen Address
arbitraryPubKeyAddress = Hash160 -> Address
PubKeyAddress (Hash160 -> Address) -> Gen Hash160 -> Gen Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash160
arbitraryHash160

-- | Arbitrary pay-to-script-hash address.
arbitraryScriptAddress :: Gen Address
arbitraryScriptAddress :: Gen Address
arbitraryScriptAddress = Hash160 -> Address
ScriptAddress (Hash160 -> Address) -> Gen Hash160 -> Gen Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash160
arbitraryHash160

-- | Arbitrary pay-to-witness public key hash
arbitraryWitnessPubKeyAddress :: Gen Address
arbitraryWitnessPubKeyAddress :: Gen Address
arbitraryWitnessPubKeyAddress = Hash160 -> Address
WitnessPubKeyAddress (Hash160 -> Address) -> Gen Hash160 -> Gen Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash160
arbitraryHash160

-- | Arbitrary pay-to-witness script hash
arbitraryWitnessScriptAddress :: Gen Address
arbitraryWitnessScriptAddress :: Gen Address
arbitraryWitnessScriptAddress = Hash160 -> Address
WitnessPubKeyAddress (Hash160 -> Address) -> Gen Hash160 -> Gen Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash160
arbitraryHash160

arbitraryWitnessAddress :: Gen Address
arbitraryWitnessAddress :: Gen Address
arbitraryWitnessAddress = do
    Word8
ver <- (Word8, Word8) -> Gen Word8
forall a. Random a => (a, a) -> Gen a
choose (Word8
1, Word8
16)
    Int
len <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
2, Int
40)
    [Word8]
ws <- Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    let bs :: ByteString
bs = [Word8] -> ByteString
B.pack [Word8]
ws
    Address -> Gen Address
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> Gen Address) -> Address -> Gen Address
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> Address
WitnessAddress Word8
ver ByteString
bs