content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  -- DUPLICATE -- adapted from: cardano-node/src/Cardano/Node/Protocol/Byron.hs
  
  module Cardano.Node.Protocol.Byron
    ( -- * Errors
      ByronProtocolInstantiationError (..)
  
      -- * Reusable parts
    , readGenesis
    , readLeaderCredentials
    ) where
  
  import Cardano.Api.Any
  import Cardano.Api.KeysByron
  import qualified Cardano.Chain.Genesis as Genesis
  import qualified Cardano.Chain.UTxO as UTxO
  import qualified Cardano.Crypto.Hash as Crypto
  import qualified Cardano.Crypto.Hashing as Byron.Crypto
  import Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic)
  import Cardano.Node.Types
  import Cardano.Prelude
  import Control.Monad.Trans.Except.Extra
    ( bimapExceptT
    , firstExceptT
    , hoistEither
    , hoistMaybe
    , left
    )
  import qualified Data.ByteString.Lazy as LB
  import Data.Text as Text (unpack)
  import Ouroboros.Consensus.Cardano
  import Prelude hiding (show, (.))
  
  ------------------------------------------------------------------------------
  -- Byron protocol
  --
  
  readGenesis ::
    GenesisFile ->
    Maybe GenesisHash ->
    RequiresNetworkMagic ->
    ExceptT
      ByronProtocolInstantiationError
      IO
      Genesis.Config
  readGenesis (GenesisFile file) mbExpectedGenesisHash ncReqNetworkMagic = do
    (genesisData, genesisHash) <-
      firstExceptT (GenesisReadError file) $
        Genesis.readGenesisData file
    checkExpectedGenesisHash genesisHash
    return
      Genesis.Config
        { Genesis.configGenesisData = genesisData
        , Genesis.configGenesisHash = genesisHash
        , Genesis.configReqNetMagic = ncReqNetworkMagic
        , Genesis.configUTxOConfiguration = UTxO.defaultUTxOConfiguration
        -- TODO: add config support for the UTxOConfiguration if needed
        }
   where
    checkExpectedGenesisHash ::
      Genesis.GenesisHash ->
      ExceptT ByronProtocolInstantiationError IO ()
    checkExpectedGenesisHash actual' =
      case mbExpectedGenesisHash of
        Just expected
          | actual /= expected ->
              throwError (GenesisHashMismatch actual expected)
         where
          actual = fromByronGenesisHash actual'
        _ -> return ()
  
    fromByronGenesisHash :: Genesis.GenesisHash -> GenesisHash
    fromByronGenesisHash (Genesis.GenesisHash h) =
      GenesisHash
        . fromMaybe impossible
        . Crypto.hashFromBytes
        . Byron.Crypto.hashToBytes
        $ h
     where
      impossible =
        panic "fromByronGenesisHash: old and new crypto libs disagree on hash size"
  
  readLeaderCredentials ::
    Genesis.Config ->
    Maybe ProtocolFilepaths ->
    ExceptT
      ByronProtocolInstantiationError
      IO
      (Maybe ByronLeaderCredentials)
  readLeaderCredentials _ Nothing = return Nothing
  readLeaderCredentials
    genesisConfig
    ( Just
        ProtocolFilepaths
          { byronCertFile
          , byronKeyFile
          }
      ) =
      case (byronCertFile, byronKeyFile) of
        (Nothing, Nothing) -> pure Nothing
        (Just _, Nothing) -> left SigningKeyFilepathNotSpecified
        (Nothing, Just _) -> left DelegationCertificateFilepathNotSpecified
        (Just delegCertFile, Just signingKeyFile) -> do
          signingKeyFileBytes <- liftIO $ LB.readFile signingKeyFile
          delegCertFileBytes <- liftIO $ LB.readFile delegCertFile
          ByronSigningKey signingKey <-
            hoistMaybe (SigningKeyDeserialiseFailure signingKeyFile) $
              deserialiseFromRawBytes (AsSigningKey AsByronKey) $
                LB.toStrict signingKeyFileBytes
          delegCert <-
            firstExceptT (CanonicalDecodeFailure delegCertFile)
              . hoistEither
              $ canonicalDecodePretty delegCertFileBytes
  
          bimapExceptT CredentialsError Just
            . hoistEither
            $ mkByronLeaderCredentials genesisConfig signingKey delegCert "Byron"
  
  ------------------------------------------------------------------------------
  -- Byron Errors
  --
  
  data ByronProtocolInstantiationError
    = CanonicalDecodeFailure !FilePath !Text
    | GenesisHashMismatch !GenesisHash !GenesisHash -- actual, expected
    | DelegationCertificateFilepathNotSpecified
    | GenesisConfigurationError !FilePath !Genesis.ConfigurationError
    | GenesisReadError !FilePath !Genesis.GenesisDataError
    | CredentialsError !ByronLeaderCredentialsError
    | SigningKeyDeserialiseFailure !FilePath
    | SigningKeyFilepathNotSpecified
    deriving Show
  
  instance Error ByronProtocolInstantiationError where
    displayError (CanonicalDecodeFailure fp failure) =
      "Canonical decode failure in "
        <> fp
        <> " Canonical failure: "
        <> Text.unpack failure
    displayError (GenesisHashMismatch actual expected) =
      "Wrong Byron genesis file: the actual hash is "
        <> show actual
        <> ", but the expected Byron genesis hash given in the node configuration "
        <> "file is "
        <> show expected
    displayError DelegationCertificateFilepathNotSpecified =
      "Delegation certificate filepath not specified"
    -- TODO: Implement configuration error render function in cardano-ledger
    displayError (GenesisConfigurationError fp genesisConfigError) =
      "Genesis configuration error in: "
        <> toS fp
        <> " Error: "
        <> show genesisConfigError
    displayError (GenesisReadError fp err) =
      "There was an error parsing the genesis file: "
        <> toS fp
        <> " Error: "
        <> show err
    -- TODO: Implement ByronLeaderCredentialsError render function in ouroboros-network
    displayError (CredentialsError byronLeaderCredentialsError) =
      "Byron leader credentials error: " <> show byronLeaderCredentialsError
    displayError (SigningKeyDeserialiseFailure fp) =
      "Signing key deserialisation error in: " <> toS fp
    displayError SigningKeyFilepathNotSpecified =
      "Signing key filepath not specified"
  