{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Bcc.Node.Protocol.Aurum
  ( AurumProtocolInstantiationError(..)
    -- * Reusable parts
  , readGenesis
  , validateGenesis
  ) where

import           Prelude (String)
import           Bcc.Prelude

import           Bcc.Api

import qualified Bcc.Ledger.Aurum.Genesis as Aurum

import           Bcc.Node.Types
import           Bcc.Node.Orphans ()

import           Bcc.Tracing.OrphanInstances.HardFork ()
import           Bcc.Tracing.OrphanInstances.Sophie ()

import           Bcc.Node.Protocol.Sophie (readGenesisAny, GenesisReadError)

--
-- Aurum genesis
--

readGenesis :: GenesisFile
            -> Maybe GenesisHash
            -> ExceptT GenesisReadError IO
                       (Aurum.AurumGenesis, GenesisHash)
readGenesis :: GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (AurumGenesis, GenesisHash)
readGenesis = GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (AurumGenesis, GenesisHash)
forall genesis.
FromJSON genesis =>
GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (genesis, GenesisHash)
readGenesisAny

validateGenesis :: Aurum.AurumGenesis
                -> ExceptT AurumProtocolInstantiationError IO ()
validateGenesis :: AurumGenesis -> ExceptT AurumProtocolInstantiationError IO ()
validateGenesis AurumGenesis
_ = () -> ExceptT AurumProtocolInstantiationError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO aurum: do the validation

data AurumProtocolInstantiationError
  = InvalidCostModelError !FilePath
  | CostModelExtractionError !FilePath
  | AurumCostModelFileError !(FileError ())
  | AurumCostModelDecodeError !FilePath !String
  deriving Int -> AurumProtocolInstantiationError -> ShowS
[AurumProtocolInstantiationError] -> ShowS
AurumProtocolInstantiationError -> String
(Int -> AurumProtocolInstantiationError -> ShowS)
-> (AurumProtocolInstantiationError -> String)
-> ([AurumProtocolInstantiationError] -> ShowS)
-> Show AurumProtocolInstantiationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AurumProtocolInstantiationError] -> ShowS
$cshowList :: [AurumProtocolInstantiationError] -> ShowS
show :: AurumProtocolInstantiationError -> String
$cshow :: AurumProtocolInstantiationError -> String
showsPrec :: Int -> AurumProtocolInstantiationError -> ShowS
$cshowsPrec :: Int -> AurumProtocolInstantiationError -> ShowS
Show

instance Error AurumProtocolInstantiationError where
  displayError :: AurumProtocolInstantiationError -> String
displayError (InvalidCostModelError String
fp) =
    String
"Invalid cost model: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp
  displayError (CostModelExtractionError String
fp) =
    String
"Error extracting the cost model at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp
  displayError (AurumCostModelFileError FileError ()
err) =
    FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
err
  displayError (AurumCostModelDecodeError String
fp String
err) =
    String
"Error decoding cost model at: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. (Show a, ConvertText String b) => a -> b
show String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err