{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Helpers
  ( HelpersError(..)
  , printWarning
  , deprecationWarning
  , ensureNewFile
  , ensureNewFileLBS
  , pPrintCBOR
  , readCBOR
  , renderHelpersError
  , validateCBOR
  , hushM
  ) where

import           Cardano.Prelude (ConvertText (..))

import           Codec.CBOR.Pretty (prettyHexEnc)
import           Codec.CBOR.Read (DeserialiseFailure, deserialiseFromBytes)
import           Codec.CBOR.Term (decodeTerm, encodeTerm)
import           Control.Exception (Exception (..), IOException)
import           Control.Monad (unless, when)
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (handleIOExceptT, left)
import           Data.Bifunctor (Bifunctor (..))
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LB
import           Data.Functor (void)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified System.Console.ANSI as ANSI
import           System.Console.ANSI
import qualified System.Directory as IO
import qualified System.IO as IO

import           Cardano.Binary (Decoder, fromCBOR)
import           Cardano.Chain.Block (fromCBORABlockOrBoundary)
import qualified Cardano.Chain.Delegation as Delegation
import qualified Cardano.Chain.Update as Update
import qualified Cardano.Chain.UTxO as UTxO
import           Cardano.CLI.Types

data HelpersError
  = CBORPrettyPrintError !DeserialiseFailure
  | CBORDecodingError !DeserialiseFailure
  | IOError' !FilePath !IOException
  | OutputMustNotAlreadyExist FilePath
  | ReadCBORFileFailure !FilePath !Text
  deriving Int -> HelpersError -> ShowS
[HelpersError] -> ShowS
HelpersError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HelpersError] -> ShowS
$cshowList :: [HelpersError] -> ShowS
show :: HelpersError -> String
$cshow :: HelpersError -> String
showsPrec :: Int -> HelpersError -> ShowS
$cshowsPrec :: Int -> HelpersError -> ShowS
Show

renderHelpersError :: HelpersError -> Text
renderHelpersError :: HelpersError -> Text
renderHelpersError HelpersError
err =
  case HelpersError
err of
    OutputMustNotAlreadyExist String
fp -> Text
"Output file/directory must not already exist: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp
    ReadCBORFileFailure String
fp Text
err' -> Text
"CBOR read failure at: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
err')
    CBORPrettyPrintError DeserialiseFailure
err' -> Text
"Error with CBOR decoding: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show DeserialiseFailure
err')
    CBORDecodingError DeserialiseFailure
err' -> Text
"Error with CBOR decoding: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show DeserialiseFailure
err')
    IOError' String
fp IOException
ioE -> Text
"Error at: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp forall a. Semigroup a => a -> a -> a
<> Text
" Error: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show IOException
ioE)

decodeCBOR
  :: LB.ByteString
  -> (forall s. Decoder s a)
  -> Either HelpersError (LB.ByteString, a)
decodeCBOR :: forall a.
ByteString
-> (forall s. Decoder s a) -> Either HelpersError (ByteString, a)
decodeCBOR ByteString
bs forall s. Decoder s a
decoder =
  forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserialiseFailure -> HelpersError
CBORDecodingError forall a b. (a -> b) -> a -> b
$ forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s a
decoder ByteString
bs

printWarning :: String -> IO ()
printWarning :: String -> IO ()
printWarning String
warning = do
  Handle -> [SGR] -> IO ()
ANSI.hSetSGR Handle
IO.stderr [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Yellow]
  Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr forall a b. (a -> b) -> a -> b
$ String
"WARNING: " forall a. Semigroup a => a -> a -> a
<> String
warning
  Handle -> [SGR] -> IO ()
ANSI.hSetSGR Handle
IO.stderr [SGR
Reset]
    -- We need to flush, or otherwise what's on stdout may have the wrong colour
    -- since it's likely sharing a console with stderr
  Handle -> IO ()
IO.hFlush Handle
IO.stderr

deprecationWarning :: String -> IO ()
deprecationWarning :: String -> IO ()
deprecationWarning String
cmd = String -> IO ()
printWarning forall a b. (a -> b) -> a -> b
$
  String
"This CLI command is deprecated.  Please use " forall a. Semigroup a => a -> a -> a
<> String
cmd forall a. Semigroup a => a -> a -> a
<> String
" command instead."

-- | Checks if a path exists and throws and error if it does.
ensureNewFile :: (FilePath -> a -> IO ()) -> FilePath -> a -> ExceptT HelpersError IO ()
ensureNewFile :: forall a.
(String -> a -> IO ()) -> String -> a -> ExceptT HelpersError IO ()
ensureNewFile String -> a -> IO ()
writer String
outFile a
blob = do
  Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
IO.doesPathExist String
outFile
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ String -> HelpersError
OutputMustNotAlreadyExist String
outFile
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> a -> IO ()
writer String
outFile a
blob

ensureNewFileLBS :: FilePath -> ByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS :: String -> ByteString -> ExceptT HelpersError IO ()
ensureNewFileLBS = forall a.
(String -> a -> IO ()) -> String -> a -> ExceptT HelpersError IO ()
ensureNewFile String -> ByteString -> IO ()
BS.writeFile

pPrintCBOR :: LB.ByteString -> ExceptT HelpersError IO ()
pPrintCBOR :: ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
bs = do
  case forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s Term
decodeTerm ByteString
bs of
    Left DeserialiseFailure
err -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ DeserialiseFailure -> HelpersError
CBORPrettyPrintError DeserialiseFailure
err
    Right (ByteString
remaining, Term
decodedVal) -> do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> String
prettyHexEnc forall a b. (a -> b) -> a -> b
$ Term -> Encoding
encodeTerm Term
decodedVal
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
LB.null ByteString
remaining) forall a b. (a -> b) -> a -> b
$
        ByteString -> ExceptT HelpersError IO ()
pPrintCBOR ByteString
remaining

readCBOR :: FilePath -> ExceptT HelpersError IO LB.ByteString
readCBOR :: String -> ExceptT HelpersError IO ByteString
readCBOR String
fp =
  forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT
    (String -> Text -> HelpersError
ReadCBORFileFailure String
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> String
displayException)
    (String -> IO ByteString
LB.readFile String
fp)

validateCBOR :: CBORObject -> LB.ByteString -> Either HelpersError Text
validateCBOR :: CBORObject -> ByteString -> Either HelpersError Text
validateCBOR CBORObject
cborObject ByteString
bs =
  case CBORObject
cborObject of
    CBORBlockByron EpochSlots
epochSlots -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a.
ByteString
-> (forall s. Decoder s a) -> Either HelpersError (ByteString, a)
decodeCBOR ByteString
bs (forall s. EpochSlots -> Decoder s (ABlockOrBoundary ByteSpan)
fromCBORABlockOrBoundary EpochSlots
epochSlots)
      forall a b. b -> Either a b
Right Text
"Valid Byron block."

    CBORObject
CBORDelegationCertificateByron -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a.
ByteString
-> (forall s. Decoder s a) -> Either HelpersError (ByteString, a)
decodeCBOR ByteString
bs (forall a s. FromCBOR a => Decoder s a
fromCBOR :: Decoder s Delegation.Certificate)
      forall a b. b -> Either a b
Right Text
"Valid Byron delegation certificate."

    CBORObject
CBORTxByron -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a.
ByteString
-> (forall s. Decoder s a) -> Either HelpersError (ByteString, a)
decodeCBOR ByteString
bs (forall a s. FromCBOR a => Decoder s a
fromCBOR :: Decoder s UTxO.Tx)
      forall a b. b -> Either a b
Right Text
"Valid Byron Tx."

    CBORObject
CBORUpdateProposalByron -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a.
ByteString
-> (forall s. Decoder s a) -> Either HelpersError (ByteString, a)
decodeCBOR ByteString
bs (forall a s. FromCBOR a => Decoder s a
fromCBOR :: Decoder s Update.Proposal)
      forall a b. b -> Either a b
Right Text
"Valid Byron update proposal."

    CBORObject
CBORVoteByron -> do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a.
ByteString
-> (forall s. Decoder s a) -> Either HelpersError (ByteString, a)
decodeCBOR ByteString
bs (forall a s. FromCBOR a => Decoder s a
fromCBOR :: Decoder s Update.Vote)
      forall a b. b -> Either a b
Right Text
"Valid Byron vote."

-- | Convert an Either to a Maybe and execute the supplied handler
-- in the Left case.
hushM :: forall e m a. Monad m => Either e a -> (e -> m ()) -> m (Maybe a)
hushM :: forall e (m :: * -> *) a.
Monad m =>
Either e a -> (e -> m ()) -> m (Maybe a)
hushM Either e a
r e -> m ()
f = case Either e a
r of
  Right a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
  Left e
e -> e -> m ()
f e
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing