{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Ouroboros.Storage.LedgerDB.Snapshots (tests) where

import Data.Aeson
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import System.FS.CRC
import Test.Tasty
import Test.Tasty.QuickCheck hiding (Success)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Snapshots"
    [ TestName -> (SnapshotBackend -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SnapshotBackend roundtrips" ((SnapshotBackend -> Property) -> TestTree)
-> (SnapshotBackend -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ forall a. (ToJSON a, FromJSON a, Eq a, Show a) => a -> Property
prop_roundtrips @SnapshotBackend
    , TestName -> (SnapshotMetadata -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SnapshotMetadata roundtrips" ((SnapshotMetadata -> Property) -> TestTree)
-> (SnapshotMetadata -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ forall a. (ToJSON a, FromJSON a, Eq a, Show a) => a -> Property
prop_roundtrips @SnapshotMetadata
    ]

prop_roundtrips :: (ToJSON a, FromJSON a, Eq a, Show a) => a -> Property
prop_roundtrips :: forall a. (ToJSON a, FromJSON a, Eq a, Show a) => a -> Property
prop_roundtrips a
a =
  case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a) of
    Error TestName
s -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
s Bool
False
    Success a
r -> a
r a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a

instance Arbitrary SnapshotBackend where
  arbitrary :: Gen SnapshotBackend
arbitrary =
    [SnapshotBackend] -> Gen SnapshotBackend
forall a. HasCallStack => [a] -> Gen a
elements
      [ SnapshotBackend
UTxOHDMemSnapshot
      , SnapshotBackend
UTxOHDLMDBSnapshot
      ]

instance Arbitrary SnapshotMetadata where
  arbitrary :: Gen SnapshotMetadata
arbitrary =
    SnapshotBackend -> CRC -> SnapshotMetadata
SnapshotMetadata
      (SnapshotBackend -> CRC -> SnapshotMetadata)
-> Gen SnapshotBackend -> Gen (CRC -> SnapshotMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SnapshotBackend
forall a. Arbitrary a => Gen a
arbitrary
      Gen (CRC -> SnapshotMetadata) -> Gen CRC -> Gen SnapshotMetadata
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> CRC) -> Gen Word32 -> Gen CRC
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> CRC
CRC Gen Word32
forall a. Arbitrary a => Gen a
arbitrary