{-# LANGUAGE OverloadedStrings #-}

-- | Module for loading and parsing reference CDDL specifications from CIP-0165
module Test.Cardano.Ledger.CanonicalState.Reference (
  parseReferenceCDDL,
  loadReferenceCDDL,
  allReferenceCDDLs,
  loadAllReferenceCDDLs,
  LoadError (..),
) where

import Codec.CBOR.Cuddle.CDDL.CTree (CTreeRoot)
import Codec.CBOR.Cuddle.CDDL.Resolve (
  MonoReferenced,
  NameResolutionFailure,
  asMap,
  buildMonoCTree,
  buildRefCTree,
  buildResolvedCTree,
 )
import Codec.CBOR.Cuddle.IndexMappable (mapCDDLDropExt)
import Codec.CBOR.Cuddle.Parser (pCDDL)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Void (Void)
import System.Directory (doesFileExist)
import System.Environment (lookupEnv)
import System.FilePath ((</>))
import Text.Megaparsec (ParseErrorBundle, errorBundlePretty, runParser)

data LoadError
  = FailedToParseCDDL (ParseErrorBundle Text Void)
  | FailedToCompileCDDL NameResolutionFailure
  | FailedToLoadFile FilePath

instance Show LoadError where
  show :: LoadError -> String
show (FailedToParseCDDL ParseErrorBundle Text Void
err) = String
"Failed to parse CDDL: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
err
  show (FailedToCompileCDDL NameResolutionFailure
err) = String
"Failed to compile CDDL: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NameResolutionFailure -> String
forall a. Show a => a -> String
show NameResolutionFailure
err
  show (FailedToLoadFile String
path) = String
"Reference CDDL file not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path

parseReferenceCDDL :: Text -> Text -> Either LoadError (CTreeRoot MonoReferenced)
parseReferenceCDDL :: Text -> Text -> Either LoadError (CTreeRoot MonoReferenced)
parseReferenceCDDL Text
namespace Text
cddlText = do
  parsedCDDL <- case Parsec Void Text (CDDL ParserStage)
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (CDDL ParserStage)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text (CDDL ParserStage)
pCDDL (Text -> String
T.unpack Text
namespace) Text
cddlText of
    Left ParseErrorBundle Text Void
err -> LoadError -> Either LoadError (CDDL ParserStage)
forall a b. a -> Either a b
Left (LoadError -> Either LoadError (CDDL ParserStage))
-> LoadError -> Either LoadError (CDDL ParserStage)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> LoadError
FailedToParseCDDL ParseErrorBundle Text Void
err
    Right CDDL ParserStage
c -> CDDL ParserStage -> Either LoadError (CDDL ParserStage)
forall a b. b -> Either a b
Right CDDL ParserStage
c

  case buildMonoCTree =<< buildResolvedCTree (buildRefCTree $ asMap $ mapCDDLDropExt parsedCDDL) of
    Left NameResolutionFailure
err -> LoadError -> Either LoadError (CTreeRoot MonoReferenced)
forall a b. a -> Either a b
Left (LoadError -> Either LoadError (CTreeRoot MonoReferenced))
-> LoadError -> Either LoadError (CTreeRoot MonoReferenced)
forall a b. (a -> b) -> a -> b
$ NameResolutionFailure -> LoadError
FailedToCompileCDDL NameResolutionFailure
err
    Right CTreeRoot MonoReferenced
c -> CTreeRoot MonoReferenced
-> Either LoadError (CTreeRoot MonoReferenced)
forall a b. b -> Either a b
Right CTreeRoot MonoReferenced
c

loadReferenceCDDL :: FilePath -> Text -> IO (Either LoadError (CTreeRoot MonoReferenced))
loadReferenceCDDL :: String -> Text -> IO (Either LoadError (CTreeRoot MonoReferenced))
loadReferenceCDDL String
path Text
namespace = do
  fileExists <- String -> IO Bool
doesFileExist String
path
  if not fileExists
    then pure $ Left $ FailedToLoadFile path
    else do
      content <- TIO.readFile path
      pure $ parseReferenceCDDL namespace content

allReferenceCDDLs :: [(Text, FilePath)]
allReferenceCDDLs :: [(Text, String)]
allReferenceCDDLs =
  -- This should match the CDDL files listed in CIP-0165
  [ (Text
"utxo/v0", String
"utxo_v0.cddl")
  , (Text
"blocks/v0", String
"blocks_v0.cddl")
  , (Text
"entities/accounts/v0", String
"entities_accounts_v0.cddl")
  , (Text
"entities/committee/v0", String
"entities_committee_v0.cddl")
  , (Text
"entities/dreps/v0", String
"entities_dreps_v0.cddl")
  , (Text
"entities/stake_pools/v0", String
"entities_stake_pools_v0.cddl")
  , (Text
"entities/stake_pools/vrf_key_hashes/v0", String
"entities_stake_pools_vrf_key_hashes_v0.cddl")
  , (Text
"gov/committee/v0", String
"gov_committee_v0.cddl")
  , (Text
"gov/constitution/v0", String
"gov_constitution_v0.cddl")
  , (Text
"gov/pparams/v0", String
"gov_pparams_v0.cddl")
  , (Text
"gov/proposals/v0", String
"gov_proposals_v0.cddl")
  , (Text
"gov/proposals/roots/v0", String
"gov_proposals_roots_v0.cddl")
  ]

loadAllReferenceCDDLs :: IO (Maybe [(Text, Either LoadError (CTreeRoot MonoReferenced))])
loadAllReferenceCDDLs :: IO (Maybe [(Text, Either LoadError (CTreeRoot MonoReferenced))])
loadAllReferenceCDDLs = do
  mCddlDir <- String -> IO (Maybe String)
lookupEnv String
"REFERENCE_CDDL_DIR"
  case mCddlDir of
    Maybe String
Nothing -> do
      Maybe [(Text, Either LoadError (CTreeRoot MonoReferenced))]
-> IO (Maybe [(Text, Either LoadError (CTreeRoot MonoReferenced))])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(Text, Either LoadError (CTreeRoot MonoReferenced))]
forall a. Maybe a
Nothing
    Just String
cddlDir -> do
      results <- ((Text, String)
 -> IO (Text, Either LoadError (CTreeRoot MonoReferenced)))
-> [(Text, String)]
-> IO [(Text, Either LoadError (CTreeRoot MonoReferenced))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String
-> (Text, String)
-> IO (Text, Either LoadError (CTreeRoot MonoReferenced))
loadOne String
cddlDir) [(Text, String)]
allReferenceCDDLs

      pure $ Just results
  where
    loadOne :: FilePath -> (Text, FilePath) -> IO (Text, Either LoadError (CTreeRoot MonoReferenced))
    loadOne :: String
-> (Text, String)
-> IO (Text, Either LoadError (CTreeRoot MonoReferenced))
loadOne String
cddlDir (Text
ns, String
fileName) = do
      let path :: String
path = String
cddlDir String -> ShowS
</> String
fileName
      result <- String -> Text -> IO (Either LoadError (CTreeRoot MonoReferenced))
loadReferenceCDDL String
path Text
ns
      pure (ns, result)