{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraIndependent.Debug.CertificateView.Run
  ( runCertificateViewCmd
  )
where

import Cardano.Api
import Cardano.Api.Experimental qualified as Exp

import Cardano.CLI.Compatible.Exception
  ( CIO
  , fromEitherIOCli
  )
import Cardano.CLI.Compatible.Json.Friendly
  ( friendlyCertificate
  )
import Cardano.CLI.EraIndependent.Debug.CertificateView.Command
import Cardano.CLI.Orphan ()
import Cardano.CLI.Read
import Cardano.CLI.Type.Common

runCertificateViewCmd
  :: ()
  => CertificateViewCmdArgs
  -> CIO e ()
runCertificateViewCmd :: forall e. CertificateViewCmdArgs -> CIO e ()
runCertificateViewCmd
  CertificateViewCmdArgs
    { Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: CertificateViewCmdArgs -> Vary '[FormatJson, FormatYaml]
outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: CertificateViewCmdArgs -> Maybe (File () 'Out)
mOutFile
    , CertificateFile
inputCertificateFile :: CertificateFile
inputCertificateFile :: CertificateViewCmdArgs -> CertificateFile
inputCertificateFile
    } = do
    certificateFile <-
      IO FileOrPipe -> RIO e FileOrPipe
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> RIO e FileOrPipe)
-> IO FileOrPipe -> RIO e FileOrPipe
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileOrPipe
fileOrPipe (FilePath -> IO FileOrPipe) -> FilePath -> IO FileOrPipe
forall a b. (a -> b) -> a -> b
$ CertificateFile -> FilePath
unCertificateFile CertificateFile
inputCertificateFile
    AnyCertificate era certificate <-
      fromEitherIOCli $ readCertificate certificateFile
    fromEitherIOCli @(FileError ()) $
      friendlyCertificate outputFormat mOutFile era certificate

data AnyCertificate where
  AnyCertificate
    :: Exp.Era era
    -> Exp.Certificate (Exp.LedgerEra era)
    -> AnyCertificate

-- | Every era writes the same text envelope type. Try Dijkstra first, then
-- Conway, which also reads registration certificates without a deposit. The
-- first era that reads the certificate wins.
readCertificate
  :: FileOrPipe
  -> IO (Either [FileError TextEnvelopeError] AnyCertificate)
readCertificate :: FileOrPipe
-> IO (Either [FileError TextEnvelopeError] AnyCertificate)
readCertificate FileOrPipe
file = do
  results <-
    [IO (Either (FileError TextEnvelopeError) AnyCertificate)]
-> IO [Either (FileError TextEnvelopeError) AnyCertificate]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
      [ Era a -> IO (Either (FileError TextEnvelopeError) AnyCertificate)
forall era.
Era era -> IO (Either (FileError TextEnvelopeError) AnyCertificate)
readAs Era a
era
      | Exp.Some Era a
era <- [Some Era] -> [Some Era]
forall a. [a] -> [a]
reverse [Some Era
forall a. Bounded a => a
minBound .. Some Era
forall a. Bounded a => a
maxBound]
      ]
  pure $ toEither $ foldMap (liftError (: [])) results
 where
  readAs :: Exp.Era era -> IO (Either (FileError TextEnvelopeError) AnyCertificate)
  readAs :: forall era.
Era era -> IO (Either (FileError TextEnvelopeError) AnyCertificate)
readAs Era era
era =
    [FromSomeType HasTextEnvelope AnyCertificate]
-> FileOrPipe
-> IO (Either (FileError TextEnvelopeError) AnyCertificate)
forall b.
[FromSomeType HasTextEnvelope b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeError) b)
readFileOrPipeTextEnvelopeAnyOf
      [ Era era
-> (EraCommonConstraints era =>
    FromSomeType HasTextEnvelope AnyCertificate)
-> FromSomeType HasTextEnvelope AnyCertificate
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  FromSomeType HasTextEnvelope AnyCertificate)
 -> FromSomeType HasTextEnvelope AnyCertificate)
-> (EraCommonConstraints era =>
    FromSomeType HasTextEnvelope AnyCertificate)
-> FromSomeType HasTextEnvelope AnyCertificate
forall a b. (a -> b) -> a -> b
$
          AsType (Certificate (LedgerEra era))
-> (Certificate (LedgerEra era) -> AnyCertificate)
-> FromSomeType HasTextEnvelope AnyCertificate
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType AsType (Certificate (LedgerEra era))
forall era. AsType (Certificate era)
Exp.AsCertificate (Era era -> Certificate (LedgerEra era) -> AnyCertificate
forall era.
Era era -> Certificate (LedgerEra era) -> AnyCertificate
AnyCertificate Era era
era)
      ]
      FileOrPipe
file