{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.EraIndependent.Debug.LogEpochState.Run
  ( runLogEpochStateCmd
  )
where

import Cardano.Api
import Cardano.Api qualified as Api

import Cardano.CLI.EraIndependent.Debug.LogEpochState.Command
import Cardano.CLI.Orphan ()

import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as LBS
import System.Directory (makeAbsolute)
import System.FS.API (SomeHasFS (..))
import System.FS.API.Types (MountPoint (MountPoint))
import System.FS.IO (ioHasFS)
import System.FilePath (takeDirectory)
import System.IO qualified as IO

runLogEpochStateCmd
  :: LogEpochStateCmdArgs
  -> IO ()
runLogEpochStateCmd :: LogEpochStateCmdArgs -> IO ()
runLogEpochStateCmd
  LogEpochStateCmdArgs
    { SocketPath
nodeSocketPath :: SocketPath
nodeSocketPath :: LogEpochStateCmdArgs -> SocketPath
nodeSocketPath
    , NodeConfigFile 'In
configurationFile :: NodeConfigFile 'In
configurationFile :: LogEpochStateCmdArgs -> NodeConfigFile 'In
configurationFile
    , outputFilePath :: LogEpochStateCmdArgs -> File Configuration 'Out
outputFilePath = File String
outputFilePath
    } = do
    String -> ByteString -> IO ()
LBS.appendFile String
outputFilePath ByteString
""

    configDir <- String -> String
takeDirectory (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
makeAbsolute (NodeConfigFile 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile NodeConfigFile 'In
configurationFile)
    let fs = HasFS IO HandleIO -> SomeHasFS IO
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS (MountPoint -> HasFS IO HandleIO
forall (m :: * -> *).
(MonadIO m, PrimState IO ~ PrimState m) =>
MountPoint -> HasFS m HandleIO
ioHasFS (String -> MountPoint
MountPoint String
configDir))

    result <-
      runExceptT $
        foldEpochState
          fs
          configurationFile
          nodeSocketPath
          Api.QuickValidation
          (EpochNo maxBound)
          ()
          ( \(AnyNewEpochState ShelleyBasedEra era
sbe NewEpochState (ShelleyLedgerEra era)
nes LedgerTables (CardanoBlock StandardCrypto) ValuesMK
_) SlotNo
_ BlockNo
_ -> do
              IO () -> StateT () IO ()
forall a. IO a -> StateT () IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT () IO ()) -> IO () -> StateT () IO ()
forall a b. (a -> b) -> a -> b
$
                String -> ByteString -> IO ()
LBS.appendFile String
outputFilePath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
                  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => ByteString) -> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe (NewEpochState (ShelleyLedgerEra era) -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode NewEpochState (ShelleyLedgerEra era)
nes) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
              ConditionResult -> StateT () IO ConditionResult
forall a. a -> StateT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConditionResult
ConditionNotMet
          )

    case result of
      Right (ConditionResult, ())
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Left FoldBlocksError
e -> Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FoldBlocksError -> String
forall a. Show a => a -> String
show FoldBlocksError
e