{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.Commands.Hash
  ( HashCmds (..)
  , HashGoal (..)
  , HashAnchorDataCmdArgs (..)
  , HashScriptCmdArgs (..)
  , AnchorDataHashSource (..)
  , renderHashCmds
  )
where

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

import           Cardano.CLI.Types.Common

import           Data.Text (Text)

data HashCmds
  = HashAnchorDataCmd !HashAnchorDataCmdArgs
  | HashScriptCmd !HashScriptCmdArgs

data HashGoal hash
  = -- | The hash is written to stdout
    HashToStdout
  | -- | The hash to check against
    CheckHash !hash
  | -- | The output file to which the hash is written
    HashToFile !(File () Out)
  deriving Int -> HashGoal hash -> ShowS
[HashGoal hash] -> ShowS
HashGoal hash -> String
(Int -> HashGoal hash -> ShowS)
-> (HashGoal hash -> String)
-> ([HashGoal hash] -> ShowS)
-> Show (HashGoal hash)
forall hash. Show hash => Int -> HashGoal hash -> ShowS
forall hash. Show hash => [HashGoal hash] -> ShowS
forall hash. Show hash => HashGoal hash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall hash. Show hash => Int -> HashGoal hash -> ShowS
showsPrec :: Int -> HashGoal hash -> ShowS
$cshow :: forall hash. Show hash => HashGoal hash -> String
show :: HashGoal hash -> String
$cshowList :: forall hash. Show hash => [HashGoal hash] -> ShowS
showList :: [HashGoal hash] -> ShowS
Show

data HashAnchorDataCmdArgs
  = HashAnchorDataCmdArgs
  { HashAnchorDataCmdArgs -> AnchorDataHashSource
toHash :: !AnchorDataHashSource
  , HashAnchorDataCmdArgs
-> HashGoal (SafeHash StandardCrypto AnchorData)
hashGoal :: !(HashGoal (L.SafeHash L.StandardCrypto L.AnchorData))
  }
  deriving Int -> HashAnchorDataCmdArgs -> ShowS
[HashAnchorDataCmdArgs] -> ShowS
HashAnchorDataCmdArgs -> String
(Int -> HashAnchorDataCmdArgs -> ShowS)
-> (HashAnchorDataCmdArgs -> String)
-> ([HashAnchorDataCmdArgs] -> ShowS)
-> Show HashAnchorDataCmdArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashAnchorDataCmdArgs -> ShowS
showsPrec :: Int -> HashAnchorDataCmdArgs -> ShowS
$cshow :: HashAnchorDataCmdArgs -> String
show :: HashAnchorDataCmdArgs -> String
$cshowList :: [HashAnchorDataCmdArgs] -> ShowS
showList :: [HashAnchorDataCmdArgs] -> ShowS
Show

data AnchorDataHashSource
  = AnchorDataHashSourceBinaryFile (File ProposalBinary In)
  | AnchorDataHashSourceTextFile (File ProposalText In)
  | AnchorDataHashSourceText Text
  | AnchorDataHashSourceURL L.Url
  deriving Int -> AnchorDataHashSource -> ShowS
[AnchorDataHashSource] -> ShowS
AnchorDataHashSource -> String
(Int -> AnchorDataHashSource -> ShowS)
-> (AnchorDataHashSource -> String)
-> ([AnchorDataHashSource] -> ShowS)
-> Show AnchorDataHashSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnchorDataHashSource -> ShowS
showsPrec :: Int -> AnchorDataHashSource -> ShowS
$cshow :: AnchorDataHashSource -> String
show :: AnchorDataHashSource -> String
$cshowList :: [AnchorDataHashSource] -> ShowS
showList :: [AnchorDataHashSource] -> ShowS
Show

data HashScriptCmdArgs
  = HashScriptCmdArgs
  { HashScriptCmdArgs -> ScriptFile
toHash :: !ScriptFile
  , HashScriptCmdArgs -> Maybe (File () 'Out)
mOutFile :: !(Maybe (File () Out))
  -- ^ The output file to which the hash is written
  }
  deriving Int -> HashScriptCmdArgs -> ShowS
[HashScriptCmdArgs] -> ShowS
HashScriptCmdArgs -> String
(Int -> HashScriptCmdArgs -> ShowS)
-> (HashScriptCmdArgs -> String)
-> ([HashScriptCmdArgs] -> ShowS)
-> Show HashScriptCmdArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashScriptCmdArgs -> ShowS
showsPrec :: Int -> HashScriptCmdArgs -> ShowS
$cshow :: HashScriptCmdArgs -> String
show :: HashScriptCmdArgs -> String
$cshowList :: [HashScriptCmdArgs] -> ShowS
showList :: [HashScriptCmdArgs] -> ShowS
Show

renderHashCmds :: HashCmds -> Text
renderHashCmds :: HashCmds -> Text
renderHashCmds = \case
  HashAnchorDataCmd{} -> Text
"hash anchor-data"
  HashScriptCmd{} -> Text
"hash script"