{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Chain.Epoch.File (
  tests,
)
where

import Cardano.Chain.Epoch.File (ParseError, mainnetEpochSlots, parseEpochFilesWithBoundary)
import Cardano.Prelude
import Control.Monad.Trans.Resource (ResIO, runResourceT)
import Hedgehog (Group, Property, discover, (===))
import qualified Hedgehog as H
import Streaming (Of ((:>)))
import qualified Streaming as S
import System.Environment (lookupEnv)
import Test.Cardano.Mirror (mainnetEpochFiles)

tests :: Group
tests :: Group
tests = $$String
[(PropertyName, Property)]
Property
String -> PropertyName
String -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
discover

prop_deserializeEpochs :: Property
prop_deserializeEpochs :: Property
prop_deserializeEpochs = TestLimit -> Property -> Property
H.withTests TestLimit
1
  forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
H.property
  forall a b. (a -> b) -> a -> b
$ do
    Maybe String
menv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
"CARDANO_MAINNET_MIRROR"
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust Maybe String
menv

    [String]
files <- forall a. Int -> [a] -> [a]
take Int
10 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
mainnetEpochFiles
    forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files)
    -- TODO: the property cannot take any parameters (if we want discoverPrefix
    -- to work). Now the question is whether it is OK to use an hardcoded value
    -- for the number of slots per epoch, and if so in which module should we
    -- store this constant?
    let stream :: Stream
  (Of (ABlockOrBoundary ByteString))
  (ExceptT ParseError (ResourceT IO))
  ()
stream = EpochSlots
-> [String]
-> Stream
     (Of (ABlockOrBoundary ByteString))
     (ExceptT ParseError (ResourceT IO))
     ()
parseEpochFilesWithBoundary EpochSlots
mainnetEpochSlots [String]
files
    Either ParseError ()
result <- (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) r. Monad m => Stream m m r -> m r
S.run) (forall (m :: * -> *) (f :: * -> *) (g :: * -> *) r.
(Monad m, Functor f) =>
(forall x. f x -> g x) -> Stream f m r -> Stream g m r
S.maps forall a m. Of a m -> ExceptT ParseError (ResourceT IO) m
discard Stream
  (Of (ABlockOrBoundary ByteString))
  (ExceptT ParseError (ResourceT IO))
  ()
stream)
    Either ParseError ()
result forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a b. b -> Either a b
Right ()
  where
    discard :: Of a m -> ExceptT ParseError ResIO m
    discard :: forall a m. Of a m -> ExceptT ParseError (ResourceT IO) m
discard (a
_ :> m
rest) = forall (f :: * -> *) a. Applicative f => a -> f a
pure m
rest