{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Haskoin.Test.Util
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX
-}
module Haskoin.Util.Arbitrary.Util (
    arbitraryBS,
    arbitraryBS1,
    arbitraryBSn,
    arbitraryBSS,
    arbitraryBSS1,
    arbitraryBSSn,
    arbitraryMaybe,
    arbitraryNetwork,
    arbitraryUTCTime,
    SerialBox (..),
    JsonBox (..),
    NetBox (..),
    ReadBox (..),
    testIdentity,
    testSerial,
    testRead,
    testJson,
    testNetJson,
    arbitraryNetData,
    genNetData,
) where

import Control.Monad (forM_, (<=<))
import qualified Data.Aeson as A
import qualified Data.Aeson.Encoding as A
import qualified Data.Aeson.Types as A
import Data.ByteString (ByteString, pack)
import qualified Data.ByteString.Short as BSS
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.Time.Clock (UTCTime (..))
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.Typeable as T
import Data.Word (Word32)
import Haskoin.Constants
import Haskoin.Data
import Test.Hspec (Spec, describe, shouldBe, shouldSatisfy)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck

-- | Arbitrary strict 'ByteString'.
arbitraryBS :: Gen ByteString
arbitraryBS :: Gen ByteString
arbitraryBS = [Word8] -> ByteString
pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary non-empty strict 'ByteString'
arbitraryBS1 :: Gen ByteString
arbitraryBS1 :: Gen ByteString
arbitraryBS1 = [Word8] -> ByteString
pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf1 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary strict 'ByteString' of a given length
arbitraryBSn :: Int -> Gen ByteString
arbitraryBSn :: Int -> Gen ByteString
arbitraryBSn Int
n = [Word8] -> ByteString
pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary 'ShortByteString'.
arbitraryBSS :: Gen BSS.ShortByteString
arbitraryBSS :: Gen ShortByteString
arbitraryBSS = [Word8] -> ShortByteString
BSS.pack ([Word8] -> ShortByteString) -> Gen [Word8] -> Gen ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary non-empty 'ShortByteString'
arbitraryBSS1 :: Gen BSS.ShortByteString
arbitraryBSS1 :: Gen ShortByteString
arbitraryBSS1 = [Word8] -> ShortByteString
BSS.pack ([Word8] -> ShortByteString) -> Gen [Word8] -> Gen ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf1 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary 'ShortByteString' of a given length
arbitraryBSSn :: Int -> Gen BSS.ShortByteString
arbitraryBSSn :: Int -> Gen ShortByteString
arbitraryBSSn Int
n = [Word8] -> ShortByteString
BSS.pack ([Word8] -> ShortByteString) -> Gen [Word8] -> Gen ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET
arbitraryUTCTime :: Gen UTCTime
arbitraryUTCTime :: Gen UTCTime
arbitraryUTCTime = do
    Word32
w <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary :: Gen Word32
    UTCTime -> Gen UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Gen UTCTime) -> UTCTime -> Gen UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Word32 -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
w

-- | Generate a Maybe from a Gen a
arbitraryMaybe :: Gen a -> Gen (Maybe a)
arbitraryMaybe :: Gen a -> Gen (Maybe a)
arbitraryMaybe Gen a
g =
    [(Int, Gen (Maybe a))] -> Gen (Maybe a)
forall a. [(Int, Gen a)] -> Gen a
frequency
        [ (Int
1, Maybe a -> Gen (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
        , (Int
5, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g)
        ]

-- | Generate an Network
arbitraryNetwork :: Gen Network
arbitraryNetwork :: Gen Network
arbitraryNetwork = [Network] -> Gen Network
forall a. [a] -> Gen a
elements [Network]
allNets

-- Helpers for creating Serial and JSON Identity tests

data SerialBox
    = forall a.
        (Show a, Eq a, T.Typeable a, Serial a) =>
      SerialBox (Gen a)

data ReadBox
    = forall a.
        (Read a, Show a, Eq a, T.Typeable a) =>
      ReadBox (Gen a)

data JsonBox
    = forall a.
        (Show a, Eq a, T.Typeable a, A.ToJSON a, A.FromJSON a) =>
      JsonBox (Gen a)

data NetBox
    = forall a.
        (Show a, Eq a, T.Typeable a) =>
      NetBox
        ( Network -> a -> A.Value
        , Network -> a -> A.Encoding
        , Network -> A.Value -> A.Parser a
        , Gen (Network, a)
        )

testIdentity :: [SerialBox] -> [ReadBox] -> [JsonBox] -> [NetBox] -> Spec
testIdentity :: [SerialBox] -> [ReadBox] -> [JsonBox] -> [NetBox] -> Spec
testIdentity [SerialBox]
serialVals [ReadBox]
readVals [JsonBox]
jsonVals [NetBox]
netVals = do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Binary Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        [SerialBox] -> (SerialBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SerialBox]
serialVals ((SerialBox -> Spec) -> Spec) -> (SerialBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(SerialBox Gen a
g) -> Gen a -> Spec
forall a. (Eq a, Show a, Typeable a, Serial a) => Gen a -> Spec
testSerial Gen a
g
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Read/Show Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        [ReadBox] -> (ReadBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ReadBox]
readVals ((ReadBox -> Spec) -> Spec) -> (ReadBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(ReadBox Gen a
g) -> Gen a -> Spec
forall a. (Eq a, Read a, Show a, Typeable a) => Gen a -> Spec
testRead Gen a
g
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Data.Aeson Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        [JsonBox] -> (JsonBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [JsonBox]
jsonVals ((JsonBox -> Spec) -> Spec) -> (JsonBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(JsonBox Gen a
g) -> Gen a -> Spec
forall a.
(Eq a, Show a, Typeable a, ToJSON a, FromJSON a) =>
Gen a -> Spec
testJson Gen a
g
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Data.Aeson Encoding with Network" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        [NetBox] -> (NetBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [NetBox]
netVals ((NetBox -> Spec) -> Spec) -> (NetBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ \(NetBox (Network -> a -> Value
j, Network -> a -> Encoding
e, Network -> Value -> Parser a
p, Gen (Network, a)
g)) -> (Network -> a -> Value)
-> (Network -> a -> Encoding)
-> (Network -> Value -> Parser a)
-> Gen (Network, a)
-> Spec
forall a.
(Eq a, Show a, Typeable a) =>
(Network -> a -> Value)
-> (Network -> a -> Encoding)
-> (Network -> Value -> Parser a)
-> Gen (Network, a)
-> Spec
testNetJson Network -> a -> Value
j Network -> a -> Encoding
e Network -> Value -> Parser a
p Gen (Network, a)
g

-- | Generate binary identity tests
testSerial ::
    (Eq a, Show a, T.Typeable a, Serial a) => Gen a -> Spec
testSerial :: Gen a -> Spec
testSerial Gen a
gen =
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Binary encoding/decoding identity for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
x -> do
            (Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
runGetL Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize) a
x a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
x
            (Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
runGetL Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize) a
x a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
x
            (Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Either String a)
-> (a -> ByteString) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize) a
x Either String a -> Either String a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a -> Either String a
forall a b. b -> Either a b
Right a
x
            (Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Either String a)
-> (a -> ByteString) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize) a
x Either String a -> Either String a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a -> Either String a
forall a b. b -> Either a b
Right a
x
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen a -> Proxy a
forall a. Gen a -> Proxy a
proxy Gen a
gen
    proxy :: Gen a -> Proxy a
    proxy :: Gen a -> Proxy a
proxy = Proxy a -> Gen a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy

-- | Generate Read/Show identity tests
testRead ::
    (Eq a, Read a, Show a, T.Typeable a) => Gen a -> Spec
testRead :: Gen a -> Spec
testRead Gen a
gen =
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"read/show identity for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
x -> (String -> a
forall a. Read a => String -> a
read (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) a
x a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
x
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen a -> Proxy a
forall a. Gen a -> Proxy a
proxy Gen a
gen
    proxy :: Gen a -> Proxy a
    proxy :: Gen a -> Proxy a
proxy = Proxy a -> Gen a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy

-- | Generate Data.Aeson identity tests
testJson ::
    (Eq a, Show a, T.Typeable a, A.ToJSON a, A.FromJSON a) => Gen a -> Spec
testJson :: Gen a -> Spec
testJson Gen a
gen = do
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Data.Aeson toJSON/fromJSON identity for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen (a -> (a -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` a -> Bool
forall a. (Eq a, FromJSON a, ToJSON a) => a -> Bool
jsonID)
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Data.Aeson toEncoding/fromJSON identity for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen (a -> (a -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` a -> Bool
forall a. (Eq a, FromJSON a, ToJSON a) => a -> Bool
encodingID)
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen a -> Proxy a
forall a. Gen a -> Proxy a
proxy Gen a
gen
    proxy :: Gen a -> Proxy a
    proxy :: Gen a -> Proxy a
proxy = Proxy a -> Gen a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy
    jsonID :: a -> Bool
jsonID a
x = (Value -> Result (Map String a)
forall a. FromJSON a => Value -> Result a
A.fromJSON (Value -> Result (Map String a))
-> (Map String a -> Value) -> Map String a -> Result (Map String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String a -> Value
forall a. ToJSON a => a -> Value
A.toJSON) (a -> Map String a
forall a. a -> Map String a
toMap a
x) Result (Map String a) -> Result (Map String a) -> Bool
forall a. Eq a => a -> a -> Bool
== Map String a -> Result (Map String a)
forall a. a -> Result a
A.Success (a -> Map String a
forall a. a -> Map String a
toMap a
x)
    encodingID :: a -> Bool
encodingID a
x =
        (ByteString -> Maybe (Map String a)
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe (Map String a))
-> (Map String a -> ByteString)
-> Map String a
-> Maybe (Map String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
forall a. Encoding' a -> ByteString
A.encodingToLazyByteString (Encoding -> ByteString)
-> (Map String a -> Encoding) -> Map String a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String a -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding) (a -> Map String a
forall a. a -> Map String a
toMap a
x)
            Maybe (Map String a) -> Maybe (Map String a) -> Bool
forall a. Eq a => a -> a -> Bool
== Map String a -> Maybe (Map String a)
forall a. a -> Maybe a
Just (a -> Map String a
forall a. a -> Map String a
toMap a
x)

-- | Generate Data.Aeson identity tests for type that need the @Network@
testNetJson ::
    (Eq a, Show a, T.Typeable a) =>
    (Network -> a -> A.Value) ->
    (Network -> a -> A.Encoding) ->
    (Network -> A.Value -> A.Parser a) ->
    Gen (Network, a) ->
    Spec
testNetJson :: (Network -> a -> Value)
-> (Network -> a -> Encoding)
-> (Network -> Value -> Parser a)
-> Gen (Network, a)
-> Spec
testNetJson Network -> a -> Value
j Network -> a -> Encoding
e Network -> Value -> Parser a
p Gen (Network, a)
g = do
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Data.Aeson toJSON/fromJSON identity (with network) for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen (Network, a) -> ((Network, a) -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Network, a)
g (((Network, a) -> IO ()) -> Property)
-> ((Network, a) -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \(Network
net, a
x) -> Network -> ByteString -> Maybe a
dec Network
net (Network -> a -> ByteString
encVal Network
net a
x) Maybe a -> Maybe a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a -> Maybe a
forall a. a -> Maybe a
Just a
x
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Data.Aeson toEncoding/fromJSON identity (with network) for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen (Network, a) -> ((Network, a) -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (Network, a)
g (((Network, a) -> IO ()) -> Property)
-> ((Network, a) -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \(Network
net, a
x) -> Network -> ByteString -> Maybe a
dec Network
net (Network -> a -> ByteString
encEnc Network
net a
x) Maybe a -> Maybe a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a -> Maybe a
forall a. a -> Maybe a
Just a
x
  where
    encVal :: Network -> a -> ByteString
encVal Network
net = Map String Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Map String Value -> ByteString)
-> (a -> Map String Value) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Map String Value
forall a. a -> Map String a
toMap (Value -> Map String Value)
-> (a -> Value) -> a -> Map String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> a -> Value
j Network
net
    encEnc :: Network -> a -> ByteString
encEnc Network
net = Encoding -> ByteString
forall a. Encoding' a -> ByteString
A.encodingToLazyByteString (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> Encoding
toMapE (Encoding -> Encoding) -> (a -> Encoding) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> a -> Encoding
e Network
net
    dec :: Network -> ByteString -> Maybe a
dec Network
net = (Value -> Parser a) -> Value -> Maybe a
forall a b. (a -> Parser b) -> a -> Maybe b
A.parseMaybe (Network -> Value -> Parser a
p Network
net) (Value -> Maybe a)
-> (Map String Value -> Value) -> Map String Value -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String Value -> Value
forall a. Map String a -> a
fromMap (Map String Value -> Maybe a)
-> (ByteString -> Maybe (Map String Value))
-> ByteString
-> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe (Map String Value)
forall a. FromJSON a => ByteString -> Maybe a
A.decode
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ (Network -> a -> Value) -> Proxy a
forall a. (Network -> a -> Value) -> Proxy a
proxy Network -> a -> Value
j
    proxy :: (Network -> a -> A.Value) -> Proxy a
    proxy :: (Network -> a -> Value) -> Proxy a
proxy = Proxy a -> (Network -> a -> Value) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy

arbitraryNetData :: Arbitrary a => Gen (Network, a)
arbitraryNetData :: Gen (Network, a)
arbitraryNetData = do
    Network
net <- Gen Network
arbitraryNetwork
    a
x <- Gen a
forall a. Arbitrary a => Gen a
arbitrary
    (Network, a) -> Gen (Network, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Network
net, a
x)

genNetData :: Gen a -> Gen (Network, a)
genNetData :: Gen a -> Gen (Network, a)
genNetData Gen a
gen = do
    Network
net <- Gen Network
arbitraryNetwork
    a
x <- Gen a
gen
    (Network, a) -> Gen (Network, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Network
net, a
x)

toMap :: a -> Map.Map String a
toMap :: a -> Map String a
toMap = String -> a -> Map String a
forall k a. k -> a -> Map k a
Map.singleton String
"object"

toMapE :: A.Encoding -> A.Encoding
toMapE :: Encoding -> Encoding
toMapE = Series -> Encoding
A.pairs (Series -> Encoding)
-> (Encoding -> Series) -> Encoding -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Encoding -> Series
A.pair Key
"object"

fromMap :: Map.Map String a -> a
fromMap :: Map String a -> a
fromMap = (Map String a -> String -> a
forall k a. Ord k => Map k a -> k -> a
Map.! String
"object")