{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.Types.Errors.HashCmdError
  ( HashCmdError (..)
  , HttpRequestError (..)
  , FetchURLError (..)
  , HashCheckError (..)
  )
where

import           Cardano.Api
import qualified Cardano.Api.Ledger as L

import           Cardano.CLI.Read (ScriptDecodeError)
import           Cardano.Ledger.SafeHash (extractHash)
import           Cardano.Prelude (Exception (displayException), IOException)

import           Network.HTTP.Client (HttpException)

data HashCmdError
  = HashMismatchedHashError
      !(L.SafeHash L.StandardCrypto L.AnchorData)
      -- ^ Expected hash
      !(L.SafeHash L.StandardCrypto L.AnchorData)
      -- ^ Actual hash
  | HashReadFileError !FilePath !IOException
  | HashWriteFileError !(FileError ())
  | HashReadScriptError !FilePath !(FileError ScriptDecodeError)
  | HashFetchURLError !FetchURLError
  deriving Int -> HashCmdError -> ShowS
[HashCmdError] -> ShowS
HashCmdError -> String
(Int -> HashCmdError -> ShowS)
-> (HashCmdError -> String)
-> ([HashCmdError] -> ShowS)
-> Show HashCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashCmdError -> ShowS
showsPrec :: Int -> HashCmdError -> ShowS
$cshow :: HashCmdError -> String
show :: HashCmdError -> String
$cshowList :: [HashCmdError] -> ShowS
showList :: [HashCmdError] -> ShowS
Show

instance Error HashCmdError where
  prettyError :: forall ann. HashCmdError -> Doc ann
prettyError = \case
    HashMismatchedHashError SafeHash StandardCrypto AnchorData
expectedHash SafeHash StandardCrypto AnchorData
actualHash ->
      Doc ann
"Hashes do not match!"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\nExpected:"
          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Hash Blake2b_256 AnchorData -> String
forall a. Show a => a -> String
show (SafeHash StandardCrypto AnchorData
-> Hash (HASH StandardCrypto) AnchorData
forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash StandardCrypto AnchorData
expectedHash))
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n  Actual:"
          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Hash Blake2b_256 AnchorData -> String
forall a. Show a => a -> String
show (SafeHash StandardCrypto AnchorData
-> Hash (HASH StandardCrypto) AnchorData
forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash StandardCrypto AnchorData
actualHash))
    HashReadFileError String
filepath IOException
exc ->
      Doc ann
"Cannot read" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
filepath Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (IOException -> String
forall e. Exception e => e -> String
displayException IOException
exc)
    HashWriteFileError FileError ()
fileErr ->
      FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileErr
    HashReadScriptError String
filepath FileError ScriptDecodeError
err ->
      Doc ann
"Cannot read script at" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
filepath Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FileError ScriptDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError ScriptDecodeError -> Doc ann
prettyError FileError ScriptDecodeError
err
    HashFetchURLError FetchURLError
fetchErr ->
      String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (FetchURLError -> String
forall e. Exception e => e -> String
displayException FetchURLError
fetchErr)

data FetchURLError
  = FetchURLInvalidURLError !String
  | FetchURLReadFileError !FilePath !IOException
  | FetchURLUnsupportedURLSchemeError !String
  | FetchURLReadEnvVarError !IOException
  | FetchURLGetFileFromHttpError !HttpRequestError
  | FetchURLIpfsGatewayNotSetError
  deriving Int -> FetchURLError -> ShowS
[FetchURLError] -> ShowS
FetchURLError -> String
(Int -> FetchURLError -> ShowS)
-> (FetchURLError -> String)
-> ([FetchURLError] -> ShowS)
-> Show FetchURLError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FetchURLError -> ShowS
showsPrec :: Int -> FetchURLError -> ShowS
$cshow :: FetchURLError -> String
show :: FetchURLError -> String
$cshowList :: [FetchURLError] -> ShowS
showList :: [FetchURLError] -> ShowS
Show

instance Exception FetchURLError where
  displayException :: FetchURLError -> String
  displayException :: FetchURLError -> String
displayException (FetchURLInvalidURLError String
text) = String
"Cannot parse URI: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
text
  displayException (FetchURLReadFileError String
filepath IOException
exc) =
    String
"Cannot read " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
filepath String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> IOException -> String
forall e. Exception e => e -> String
displayException IOException
exc
  displayException (FetchURLUnsupportedURLSchemeError String
text) = String
"Unsupported URL scheme: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
text
  displayException (FetchURLReadEnvVarError IOException
exc) = String
"Cannot read environment variable: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> IOException -> String
forall e. Exception e => e -> String
displayException IOException
exc
  displayException (FetchURLGetFileFromHttpError HttpRequestError
err) = HttpRequestError -> String
forall e. Exception e => e -> String
displayException HttpRequestError
err
  displayException FetchURLError
FetchURLIpfsGatewayNotSetError = String
"IPFS schema requires IPFS_GATEWAY_URI environment variable to be set."

data HttpRequestError
  = BadStatusCodeHRE !Int !String
  | HttpExceptionHRE !HttpException
  | IOExceptionHRE !IOException
  deriving Int -> HttpRequestError -> ShowS
[HttpRequestError] -> ShowS
HttpRequestError -> String
(Int -> HttpRequestError -> ShowS)
-> (HttpRequestError -> String)
-> ([HttpRequestError] -> ShowS)
-> Show HttpRequestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpRequestError -> ShowS
showsPrec :: Int -> HttpRequestError -> ShowS
$cshow :: HttpRequestError -> String
show :: HttpRequestError -> String
$cshowList :: [HttpRequestError] -> ShowS
showList :: [HttpRequestError] -> ShowS
Show

instance Exception HttpRequestError where
  displayException :: HttpRequestError -> String
  displayException :: HttpRequestError -> String
displayException (BadStatusCodeHRE Int
code String
description) = String
"Bad status code when downloading anchor data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
code String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
description String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  displayException (HttpExceptionHRE HttpException
exc) = String
"HTTP(S) request error when downloading anchor data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HttpException -> String
forall e. Exception e => e -> String
displayException HttpException
exc
  displayException (IOExceptionHRE IOException
exc) = String
"I/O error when downloading anchor data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> IOException -> String
forall e. Exception e => e -> String
displayException IOException
exc

data HashCheckError
  = HashMismatchError
      (L.SafeHash L.StandardCrypto L.AnchorData)
      -- ^ The expected DRep metadata hash.
      (L.SafeHash L.StandardCrypto L.AnchorData)
      -- ^ The actual DRep metadata hash.
  | FetchURLError FetchURLError
  deriving Int -> HashCheckError -> ShowS
[HashCheckError] -> ShowS
HashCheckError -> String
(Int -> HashCheckError -> ShowS)
-> (HashCheckError -> String)
-> ([HashCheckError] -> ShowS)
-> Show HashCheckError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashCheckError -> ShowS
showsPrec :: Int -> HashCheckError -> ShowS
$cshow :: HashCheckError -> String
show :: HashCheckError -> String
$cshowList :: [HashCheckError] -> ShowS
showList :: [HashCheckError] -> ShowS
Show

instance Exception HashCheckError where
  displayException :: HashCheckError -> String
  displayException :: HashCheckError -> String
displayException (HashMismatchError SafeHash StandardCrypto AnchorData
expectedHash SafeHash StandardCrypto AnchorData
actualHash) =
    String
"Hashes do not match!"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\nExpected: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash Blake2b_256 AnchorData -> String
forall a. Show a => a -> String
show (SafeHash StandardCrypto AnchorData
-> Hash (HASH StandardCrypto) AnchorData
forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash StandardCrypto AnchorData
expectedHash)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n  Actual: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Hash Blake2b_256 AnchorData -> String
forall a. Show a => a -> String
show (SafeHash StandardCrypto AnchorData
-> Hash (HASH StandardCrypto) AnchorData
forall c i. SafeHash c i -> Hash (HASH c) i
extractHash SafeHash StandardCrypto AnchorData
actualHash)
  displayException (FetchURLError FetchURLError
fetchErr) = FetchURLError -> String
forall e. Exception e => e -> String
displayException FetchURLError
fetchErr