{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.EraIndependent.Hash.Run
  ( runHashCmds
  )
where

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

import Cardano.CLI.EraIndependent.Hash.Command qualified as Cmd
import Cardano.CLI.EraIndependent.Hash.Internal.Common
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
  ( GenesisFile (..)
  )
import Cardano.CLI.Type.Error.HashCmdError
import Cardano.Crypto.Hash (hashToTextAsHex)
import Cardano.Crypto.Hash qualified as Crypto
import Cardano.Ledger.Hashes qualified as L
import Cardano.Prelude (ByteString)

import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as BS8
import Data.Function
import Data.Text.Encoding qualified as Text
import Data.Text.IO qualified as Text

runHashCmds
  :: ()
  => Cmd.HashCmds
  -> ExceptT HashCmdError IO ()
runHashCmds :: HashCmds -> ExceptT HashCmdError IO ()
runHashCmds = \case
  Cmd.HashAnchorDataCmd HashAnchorDataCmdArgs
args -> HashAnchorDataCmdArgs -> ExceptT HashCmdError IO ()
runHashAnchorDataCmd HashAnchorDataCmdArgs
args
  Cmd.HashScriptCmd HashScriptCmdArgs
args -> HashScriptCmdArgs -> ExceptT HashCmdError IO ()
runHashScriptCmd HashScriptCmdArgs
args
  Cmd.HashGenesisFile GenesisFile
args -> GenesisFile -> ExceptT HashCmdError IO ()
runHashGenesisFile GenesisFile
args

runHashAnchorDataCmd
  :: ()
  => Cmd.HashAnchorDataCmdArgs
  -> ExceptT HashCmdError IO ()
runHashAnchorDataCmd :: HashAnchorDataCmdArgs -> ExceptT HashCmdError IO ()
runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{AnchorDataHashSource
toHash :: AnchorDataHashSource
toHash :: HashAnchorDataCmdArgs -> AnchorDataHashSource
toHash, HashGoal (SafeHash AnchorData)
hashGoal :: HashGoal (SafeHash AnchorData)
hashGoal :: HashAnchorDataCmdArgs -> HashGoal (SafeHash AnchorData)
hashGoal} = do
  AnchorData
anchorData <-
    ByteString -> AnchorData
L.AnchorData (ByteString -> AnchorData)
-> ExceptT HashCmdError IO ByteString
-> ExceptT HashCmdError IO AnchorData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case AnchorDataHashSource
toHash of
      Cmd.AnchorDataHashSourceBinaryFile File ProposalBinary 'In
fp -> do
        let path :: FilePath
path = File ProposalBinary 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File ProposalBinary 'In
fp
        (IOException -> HashCmdError)
-> IO ByteString -> ExceptT HashCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> HashCmdError
HashReadFileError FilePath
path) (IO ByteString -> ExceptT HashCmdError IO ByteString)
-> IO ByteString -> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
path
      Cmd.AnchorDataHashSourceTextFile File ProposalText 'In
fp -> do
        let path :: FilePath
path = File ProposalText 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File ProposalText 'In
fp
        Text
text <- (IOException -> HashCmdError)
-> IO Text -> ExceptT HashCmdError IO Text
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FilePath -> IOException -> HashCmdError
HashReadFileError FilePath
path) (IO Text -> ExceptT HashCmdError IO Text)
-> IO Text -> ExceptT HashCmdError IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
Text.readFile FilePath
path
        ByteString -> ExceptT HashCmdError IO ByteString
forall a. a -> ExceptT HashCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT HashCmdError IO ByteString)
-> ByteString -> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
text
      Cmd.AnchorDataHashSourceText Text
text -> ByteString -> ExceptT HashCmdError IO ByteString
forall a. a -> ExceptT HashCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT HashCmdError IO ByteString)
-> ByteString -> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
text
      Cmd.AnchorDataHashSourceURL Url
urlText ->
        ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
fetchURLToHashCmdError (ExceptT FetchURLError IO ByteString
 -> ExceptT HashCmdError IO ByteString)
-> ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ SupportedSchemes -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL SupportedSchemes
allSchemes (Text -> ExceptT FetchURLError IO ByteString)
-> Text -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ Url -> Text
L.urlToText Url
urlText
  let hash :: SafeHash AnchorData
hash = AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
L.hashAnnotated AnchorData
anchorData
  case HashGoal (SafeHash AnchorData)
hashGoal of
    Cmd.CheckHash SafeHash AnchorData
expectedHash
      | SafeHash AnchorData
hash SafeHash AnchorData -> SafeHash AnchorData -> Bool
forall a. Eq a => a -> a -> Bool
/= SafeHash AnchorData
expectedHash ->
          HashCmdError -> ExceptT HashCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (HashCmdError -> ExceptT HashCmdError IO ())
-> HashCmdError -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$ SafeHash AnchorData -> SafeHash AnchorData -> HashCmdError
HashMismatchedHashError SafeHash AnchorData
expectedHash SafeHash AnchorData
hash
      | Bool
otherwise -> do
          IO () -> ExceptT HashCmdError IO ()
forall a. IO a -> ExceptT HashCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT HashCmdError IO ())
-> IO () -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
"Hashes match!"
    Cmd.HashToFile File () 'Out
outFile -> Maybe (File () 'Out)
-> SafeHash AnchorData -> ExceptT HashCmdError IO ()
forall i.
Maybe (File () 'Out) -> SafeHash i -> ExceptT HashCmdError IO ()
writeHash (File () 'Out -> Maybe (File () 'Out)
forall a. a -> Maybe a
Just File () 'Out
outFile) SafeHash AnchorData
hash
    HashGoal (SafeHash AnchorData)
Cmd.HashToStdout -> Maybe (File () 'Out)
-> SafeHash AnchorData -> ExceptT HashCmdError IO ()
forall i.
Maybe (File () 'Out) -> SafeHash i -> ExceptT HashCmdError IO ()
writeHash Maybe (File () 'Out)
forall a. Maybe a
Nothing SafeHash AnchorData
hash
 where
  writeHash :: Maybe (File () Out) -> L.SafeHash i -> ExceptT HashCmdError IO ()
  writeHash :: forall i.
Maybe (File () 'Out) -> SafeHash i -> ExceptT HashCmdError IO ()
writeHash Maybe (File () 'Out)
mOutFile SafeHash i
hash = do
    (FileError () -> HashCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> HashCmdError
HashWriteFileError (ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
        Maybe (File () 'Out) -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out) -> Text -> m (Either (FileError e) ())
writeTextOutput Maybe (File () 'Out)
mOutFile Text
text
   where
    text :: Text
text = Hash Blake2b_256 i -> Text
forall h a. Hash h a -> Text
hashToTextAsHex (Hash Blake2b_256 i -> Text)
-> (SafeHash i -> Hash Blake2b_256 i) -> SafeHash i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash i -> Hash Blake2b_256 i
forall i. SafeHash i -> Hash Blake2b_256 i
L.extractHash (SafeHash i -> Text) -> SafeHash i -> Text
forall a b. (a -> b) -> a -> b
$ SafeHash i
hash

  fetchURLToHashCmdError
    :: ExceptT FetchURLError IO BS8.ByteString -> ExceptT HashCmdError IO BS8.ByteString
  fetchURLToHashCmdError :: ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
fetchURLToHashCmdError = (FetchURLError -> HashCmdError)
-> ExceptT FetchURLError IO ByteString
-> ExceptT HashCmdError IO ByteString
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT FetchURLError -> HashCmdError
HashFetchURLError

runHashScriptCmd
  :: ()
  => Cmd.HashScriptCmdArgs
  -> ExceptT HashCmdError IO ()
runHashScriptCmd :: HashScriptCmdArgs -> ExceptT HashCmdError IO ()
runHashScriptCmd Cmd.HashScriptCmdArgs{toHash :: HashScriptCmdArgs -> ScriptFile
Cmd.toHash = File FilePath
toHash, Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: HashScriptCmdArgs -> Maybe (File () 'Out)
mOutFile} = do
  ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <-
    FilePath
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
FilePath -> t m ScriptInAnyLang
readFileScriptInAnyLang FilePath
toHash
      ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
    -> ExceptT HashCmdError IO ScriptInAnyLang)
-> ExceptT HashCmdError IO ScriptInAnyLang
forall a b. a -> (a -> b) -> b
& (FileError ScriptDecodeError -> HashCmdError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT HashCmdError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (FilePath -> FileError ScriptDecodeError -> HashCmdError
HashReadScriptError FilePath
toHash)
  (FileError () -> HashCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> HashCmdError
HashWriteFileError
    (ExceptT (FileError ()) IO () -> ExceptT HashCmdError IO ())
-> (ScriptHash -> ExceptT (FileError ()) IO ())
-> ScriptHash
-> ExceptT HashCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
    (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> (ScriptHash -> IO (Either (FileError ()) ()))
-> ScriptHash
-> ExceptT (FileError ()) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (File () 'Out) -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out) -> Text -> m (Either (FileError e) ())
writeTextOutput Maybe (File () 'Out)
mOutFile
    (Text -> IO (Either (FileError ()) ()))
-> (ScriptHash -> Text)
-> ScriptHash
-> IO (Either (FileError ()) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText
    (ScriptHash -> ExceptT HashCmdError IO ())
-> ScriptHash -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script

runHashGenesisFile :: GenesisFile -> ExceptT HashCmdError IO ()
runHashGenesisFile :: GenesisFile -> ExceptT HashCmdError IO ()
runHashGenesisFile (GenesisFile FilePath
fpath) = do
  ByteString
content <-
    (IOException -> HashCmdError)
-> IO ByteString -> ExceptT HashCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> HashCmdError
HashGenesisCmdGenesisFileError (FileError () -> HashCmdError)
-> (IOException -> FileError ()) -> IOException -> HashCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOException -> FileError ()
forall e. FilePath -> IOException -> FileError e
FileIOError FilePath
fpath) (IO ByteString -> ExceptT HashCmdError IO ByteString)
-> IO ByteString -> ExceptT HashCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ByteString
BS.readFile FilePath
fpath
  let gh :: Crypto.Hash Crypto.Blake2b_256 ByteString
      gh :: Hash Blake2b_256 ByteString
gh = (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
content
  IO () -> ExceptT HashCmdError IO ()
forall a. IO a -> ExceptT HashCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT HashCmdError IO ())
-> IO () -> ExceptT HashCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Hash Blake2b_256 ByteString -> Text
forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash Blake2b_256 ByteString
gh)