{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-specialize #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-}
-- Plutus core version to compile to. In babbage era, that is Cardano protocol
-- version 7 and 8, only plutus-core version 1.0.0 is available.
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.0.0 #-}

-- | An experimental validator which simply hashes a bytestring stored in the
-- datum using one of three supported algorithms.
module Hydra.Contract.Hash where

import PlutusTx.Prelude

import Hydra.Prelude qualified as Haskell

import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV2))
import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator)
import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode)
import PlutusLedgerApi.V2 (
  Datum (Datum),
  Redeemer (Redeemer),
  ScriptContext,
  ScriptHash,
 )
import PlutusTx (CompiledCode)
import PlutusTx qualified
import PlutusTx.Builtins (equalsByteString)
import PlutusTx.IsData.Class (ToData (..))

data HashAlgorithm
  = Base
  | SHA2
  | SHA3
  | Blake2b
  deriving stock (Int -> HashAlgorithm -> ShowS
[HashAlgorithm] -> ShowS
HashAlgorithm -> String
(Int -> HashAlgorithm -> ShowS)
-> (HashAlgorithm -> String)
-> ([HashAlgorithm] -> ShowS)
-> Show HashAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashAlgorithm -> ShowS
showsPrec :: Int -> HashAlgorithm -> ShowS
$cshow :: HashAlgorithm -> String
show :: HashAlgorithm -> String
$cshowList :: [HashAlgorithm] -> ShowS
showList :: [HashAlgorithm] -> ShowS
Haskell.Show, (forall x. HashAlgorithm -> Rep HashAlgorithm x)
-> (forall x. Rep HashAlgorithm x -> HashAlgorithm)
-> Generic HashAlgorithm
forall x. Rep HashAlgorithm x -> HashAlgorithm
forall x. HashAlgorithm -> Rep HashAlgorithm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HashAlgorithm -> Rep HashAlgorithm x
from :: forall x. HashAlgorithm -> Rep HashAlgorithm x
$cto :: forall x. Rep HashAlgorithm x -> HashAlgorithm
to :: forall x. Rep HashAlgorithm x -> HashAlgorithm
Haskell.Generic, Int -> HashAlgorithm
HashAlgorithm -> Int
HashAlgorithm -> [HashAlgorithm]
HashAlgorithm -> HashAlgorithm
HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
HashAlgorithm -> HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
(HashAlgorithm -> HashAlgorithm)
-> (HashAlgorithm -> HashAlgorithm)
-> (Int -> HashAlgorithm)
-> (HashAlgorithm -> Int)
-> (HashAlgorithm -> [HashAlgorithm])
-> (HashAlgorithm -> HashAlgorithm -> [HashAlgorithm])
-> (HashAlgorithm -> HashAlgorithm -> [HashAlgorithm])
-> (HashAlgorithm
    -> HashAlgorithm -> HashAlgorithm -> [HashAlgorithm])
-> Enum HashAlgorithm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: HashAlgorithm -> HashAlgorithm
succ :: HashAlgorithm -> HashAlgorithm
$cpred :: HashAlgorithm -> HashAlgorithm
pred :: HashAlgorithm -> HashAlgorithm
$ctoEnum :: Int -> HashAlgorithm
toEnum :: Int -> HashAlgorithm
$cfromEnum :: HashAlgorithm -> Int
fromEnum :: HashAlgorithm -> Int
$cenumFrom :: HashAlgorithm -> [HashAlgorithm]
enumFrom :: HashAlgorithm -> [HashAlgorithm]
$cenumFromThen :: HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
enumFromThen :: HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
$cenumFromTo :: HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
enumFromTo :: HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
$cenumFromThenTo :: HashAlgorithm -> HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
enumFromThenTo :: HashAlgorithm -> HashAlgorithm -> HashAlgorithm -> [HashAlgorithm]
Haskell.Enum, HashAlgorithm
HashAlgorithm -> HashAlgorithm -> Bounded HashAlgorithm
forall a. a -> a -> Bounded a
$cminBound :: HashAlgorithm
minBound :: HashAlgorithm
$cmaxBound :: HashAlgorithm
maxBound :: HashAlgorithm
Haskell.Bounded)

PlutusTx.unstableMakeIsData ''HashAlgorithm

instance Haskell.Arbitrary HashAlgorithm where
  arbitrary :: Gen HashAlgorithm
arbitrary = Gen HashAlgorithm
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
Haskell.genericArbitrary

type DatumType = BuiltinByteString
type RedeemerType = HashAlgorithm

validator :: DatumType -> RedeemerType -> ScriptContext -> Bool
validator :: DatumType -> HashAlgorithm -> ScriptContext -> Bool
validator DatumType
bytes HashAlgorithm
algorithm ScriptContext
_ctx =
  case HashAlgorithm
algorithm of
    HashAlgorithm
Base -> DatumType -> DatumType -> Bool
equalsByteString DatumType
bytes DatumType
bytes
    HashAlgorithm
SHA2 -> Bool -> Bool
not (Bool -> Bool) -> (DatumType -> Bool) -> DatumType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumType -> DatumType -> Bool
equalsByteString DatumType
bytes (DatumType -> Bool) -> DatumType -> Bool
forall a b. (a -> b) -> a -> b
$ DatumType -> DatumType
sha2_256 DatumType
bytes
    HashAlgorithm
SHA3 -> Bool -> Bool
not (Bool -> Bool) -> (DatumType -> Bool) -> DatumType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumType -> DatumType -> Bool
equalsByteString DatumType
bytes (DatumType -> Bool) -> DatumType -> Bool
forall a b. (a -> b) -> a -> b
$ DatumType -> DatumType
sha3_256 DatumType
bytes
    HashAlgorithm
Blake2b -> Bool -> Bool
not (Bool -> Bool) -> (DatumType -> Bool) -> DatumType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumType -> DatumType -> Bool
equalsByteString DatumType
bytes (DatumType -> Bool) -> DatumType -> Bool
forall a b. (a -> b) -> a -> b
$ DatumType -> DatumType
blake2b_256 DatumType
bytes

compiledValidator :: CompiledCode ValidatorType
compiledValidator :: CompiledCode ValidatorType
compiledValidator =
  $$(PlutusTx.compile [||wrap validator||])
 where
  wrap :: (DatumType -> HashAlgorithm -> ScriptContext -> Bool)
-> ValidatorType
wrap = forall datum redeemer context.
(UnsafeFromData datum, UnsafeFromData redeemer,
 UnsafeFromData context) =>
(datum -> redeemer -> context -> Bool) -> ValidatorType
wrapValidator @DatumType @RedeemerType

validatorScript :: SerialisedScript
validatorScript :: SerialisedScript
validatorScript = CompiledCode ValidatorType -> SerialisedScript
forall a. CompiledCode a -> SerialisedScript
serialiseCompiledCode CompiledCode ValidatorType
compiledValidator

validatorHash :: ScriptHash
validatorHash :: ScriptHash
validatorHash = PlutusScriptVersion PlutusScriptV2
-> SerialisedScript -> ScriptHash
forall lang.
PlutusScriptVersion lang -> SerialisedScript -> ScriptHash
scriptValidatorHash PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 SerialisedScript
validatorScript

datum :: DatumType -> Datum
datum :: DatumType -> Datum
datum DatumType
a = BuiltinData -> Datum
Datum (DatumType -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData DatumType
a)

redeemer :: RedeemerType -> Redeemer
redeemer :: HashAlgorithm -> Redeemer
redeemer HashAlgorithm
a = BuiltinData -> Redeemer
Redeemer (HashAlgorithm -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData HashAlgorithm
a)