{-# 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 -> GroupName
String -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
discover

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

    [String]
files <- Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
10 ([String] -> [String])
-> PropertyT IO [String] -> PropertyT IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String] -> PropertyT IO [String]
forall a. IO a -> PropertyT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
mainnetEpochFiles
    Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
H.assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
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 <- (IO (Either ParseError ()) -> PropertyT IO (Either ParseError ())
forall a. IO a -> PropertyT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError ()) -> PropertyT IO (Either ParseError ()))
-> (Stream
      (ExceptT ParseError (ResourceT IO))
      (ExceptT ParseError (ResourceT IO))
      ()
    -> IO (Either ParseError ()))
-> Stream
     (ExceptT ParseError (ResourceT IO))
     (ExceptT ParseError (ResourceT IO))
     ()
-> PropertyT IO (Either ParseError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ResourceT IO (Either ParseError ()) -> IO (Either ParseError ())
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Either ParseError ()) -> IO (Either ParseError ()))
-> (Stream
      (ExceptT ParseError (ResourceT IO))
      (ExceptT ParseError (ResourceT IO))
      ()
    -> ResourceT IO (Either ParseError ()))
-> Stream
     (ExceptT ParseError (ResourceT IO))
     (ExceptT ParseError (ResourceT IO))
     ()
-> IO (Either ParseError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExceptT ParseError (ResourceT IO) ()
-> ResourceT IO (Either ParseError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ParseError (ResourceT IO) ()
 -> ResourceT IO (Either ParseError ()))
-> (Stream
      (ExceptT ParseError (ResourceT IO))
      (ExceptT ParseError (ResourceT IO))
      ()
    -> ExceptT ParseError (ResourceT IO) ())
-> Stream
     (ExceptT ParseError (ResourceT IO))
     (ExceptT ParseError (ResourceT IO))
     ()
-> ResourceT IO (Either ParseError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Stream
  (ExceptT ParseError (ResourceT IO))
  (ExceptT ParseError (ResourceT IO))
  ()
-> ExceptT ParseError (ResourceT IO) ()
forall (m :: * -> *) r. Monad m => Stream m m r -> m r
S.run) ((forall x.
 Of (ABlockOrBoundary ByteString) x
 -> ExceptT ParseError (ResourceT IO) x)
-> Stream
     (Of (ABlockOrBoundary ByteString))
     (ExceptT ParseError (ResourceT IO))
     ()
-> Stream
     (ExceptT ParseError (ResourceT IO))
     (ExceptT ParseError (ResourceT IO))
     ()
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 Of (ABlockOrBoundary ByteString) x
-> ExceptT ParseError (ResourceT IO) x
forall x.
Of (ABlockOrBoundary ByteString) x
-> ExceptT ParseError (ResourceT IO) x
forall a m. Of a m -> ExceptT ParseError (ResourceT IO) m
discard Stream
  (Of (ABlockOrBoundary ByteString))
  (ExceptT ParseError (ResourceT IO))
  ()
stream)
    Either ParseError ()
result Either ParseError () -> Either ParseError () -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== () -> Either ParseError ()
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) = m -> ExceptT ParseError (ResourceT IO) m
forall a. a -> ExceptT ParseError (ResourceT IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
rest