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

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

import           Cardano.Prelude

import           Codec.CBOR.Pretty (prettyHexEnc)
import           Codec.CBOR.Read (DeserialiseFailure, deserialiseFromBytes)
import           Codec.CBOR.Term (decodeTerm, encodeTerm)
import           Control.Monad.Trans.Except.Extra (handleIOExceptT, left)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as Text

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

import qualified System.Directory as IO

data HelpersError
  = CBORPrettyPrintError !DeserialiseFailure
  | CBORDecodingError !DeserialiseFailure
  | IOError' !FilePath !IOException
  | OutputMustNotAlreadyExist FilePath
  | ReadCBORFileFailure !FilePath !Text
  deriving Int -> HelpersError -> ShowS
[HelpersError] -> ShowS
HelpersError -> String
(Int -> HelpersError -> ShowS)
-> (HelpersError -> String)
-> ([HelpersError] -> ShowS)
-> Show HelpersError
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: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp
    ReadCBORFileFailure String
fp Text
err' -> Text
"CBOR read failure at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Text
err')
    CBORPrettyPrintError DeserialiseFailure
err' -> Text
"Error with CBOR decoding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (DeserialiseFailure -> String
forall a b. (Show a, ConvertText String b) => a -> b
show DeserialiseFailure
err')
    CBORDecodingError DeserialiseFailure
err' -> Text
"Error with CBOR decoding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (DeserialiseFailure -> String
forall a b. (Show a, ConvertText String b) => a -> b
show DeserialiseFailure
err')
    IOError' String
fp IOException
ioE -> Text
"Error at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (IOException -> String
forall a b. (Show a, ConvertText String b) => a -> b
show IOException
ioE)

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

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

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

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

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

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

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

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

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

textShow :: Show a => a -> Text
textShow :: a -> Text
textShow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a b. (Show a, ConvertText String b) => a -> b
show

-- | 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 :: 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 -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
  Left e
e -> e -> m ()
f e
e m () -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing