{-# OPTIONS_GHC -Wno-orphans #-}

-- Mirrors the equivalent V1 module in plutus-ledger-api
module Plutarch.LedgerApi.V1.Crypto (
  PPubKeyHash (..),
) where

import Data.ByteString (ByteString)
import GHC.Generics (Generic)
import Generics.SOP qualified as SOP
import Plutarch.Prelude
import PlutusLedgerApi.V1 qualified as Plutus
import PlutusTx.Builtins.Internal qualified as PlutusTx

-- | @since 2.0.0
newtype PPubKeyHash (s :: S) = PPubKeyHash (Term s PByteString)
  deriving stock
    ( -- | @since 2.0.0
      (forall x. PPubKeyHash s -> Rep (PPubKeyHash s) x)
-> (forall x. Rep (PPubKeyHash s) x -> PPubKeyHash s)
-> Generic (PPubKeyHash s)
forall x. Rep (PPubKeyHash s) x -> PPubKeyHash s
forall x. PPubKeyHash s -> Rep (PPubKeyHash s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PPubKeyHash s) x -> PPubKeyHash s
forall (s :: S) x. PPubKeyHash s -> Rep (PPubKeyHash s) x
$cfrom :: forall (s :: S) x. PPubKeyHash s -> Rep (PPubKeyHash s) x
from :: forall x. PPubKeyHash s -> Rep (PPubKeyHash s) x
$cto :: forall (s :: S) x. Rep (PPubKeyHash s) x -> PPubKeyHash s
to :: forall x. Rep (PPubKeyHash s) x -> PPubKeyHash s
Generic
    )
  deriving anyclass
    ( -- | @since 3.3.0
      All SListI (Code (PPubKeyHash s))
All SListI (Code (PPubKeyHash s)) =>
(PPubKeyHash s -> Rep (PPubKeyHash s))
-> (Rep (PPubKeyHash s) -> PPubKeyHash s)
-> Generic (PPubKeyHash s)
Rep (PPubKeyHash s) -> PPubKeyHash s
PPubKeyHash s -> Rep (PPubKeyHash s)
forall a.
All SListI (Code a) =>
(a -> Rep a) -> (Rep a -> a) -> Generic a
forall (s :: S). All SListI (Code (PPubKeyHash s))
forall (s :: S). Rep (PPubKeyHash s) -> PPubKeyHash s
forall (s :: S). PPubKeyHash s -> Rep (PPubKeyHash s)
$cfrom :: forall (s :: S). PPubKeyHash s -> Rep (PPubKeyHash s)
from :: PPubKeyHash s -> Rep (PPubKeyHash s)
$cto :: forall (s :: S). Rep (PPubKeyHash s) -> PPubKeyHash s
to :: Rep (PPubKeyHash s) -> PPubKeyHash s
SOP.Generic
    , -- | @since 2.0.0
      (forall (s :: S).
 Term s (PAsData PPubKeyHash) -> Term s PPubKeyHash)
-> (forall (s :: S). Term s PPubKeyHash -> Term s PData)
-> PIsData PPubKeyHash
forall (s :: S). Term s (PAsData PPubKeyHash) -> Term s PPubKeyHash
forall (s :: S). Term s PPubKeyHash -> Term s PData
forall (a :: S -> Type).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PPubKeyHash) -> Term s PPubKeyHash
pfromDataImpl :: forall (s :: S). Term s (PAsData PPubKeyHash) -> Term s PPubKeyHash
$cpdataImpl :: forall (s :: S). Term s PPubKeyHash -> Term s PData
pdataImpl :: forall (s :: S). Term s PPubKeyHash -> Term s PData
PIsData
    , -- | @since 2.0.0
      (forall (s :: S).
 Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool)
-> PEq PPubKeyHash
forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
forall (t :: S -> Type).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
$c#== :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
#== :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
PEq
    , -- | @since 2.0.0
      PEq PPubKeyHash
PEq PPubKeyHash =>
(forall (s :: S).
 Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool)
-> (forall (s :: S).
    Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool)
-> (forall (s :: S).
    Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PPubKeyHash)
-> (forall (s :: S).
    Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PPubKeyHash)
-> POrd PPubKeyHash
forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PPubKeyHash
forall (t :: S -> Type).
PEq t =>
(forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s t)
-> (forall (s :: S). Term s t -> Term s t -> Term s t)
-> POrd t
$c#<= :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
#<= :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
$c#< :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
#< :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
$cpmax :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PPubKeyHash
pmax :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PPubKeyHash
$cpmin :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PPubKeyHash
pmin :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PPubKeyHash
POrd
    , -- | @since 2.0.0
      (forall (s :: S). Bool -> Term s PPubKeyHash -> Term s PString)
-> PShow PPubKeyHash
forall (s :: S). Bool -> Term s PPubKeyHash -> Term s PString
forall (t :: S -> Type).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
$cpshow' :: forall (s :: S). Bool -> Term s PPubKeyHash -> Term s PString
pshow' :: forall (s :: S). Bool -> Term s PPubKeyHash -> Term s PString
PShow
    )
  deriving
    ( -- | @since 3.3.0
      (forall (s :: S). PPubKeyHash s -> Term s (PInner PPubKeyHash))
-> (forall (s :: S) (b :: S -> Type).
    Term s (PInner PPubKeyHash)
    -> (PPubKeyHash s -> Term s b) -> Term s b)
-> PlutusType PPubKeyHash
forall (s :: S). PPubKeyHash s -> Term s (PInner PPubKeyHash)
forall (s :: S) (b :: S -> Type).
Term s (PInner PPubKeyHash)
-> (PPubKeyHash s -> Term s b) -> Term s b
forall (a :: S -> Type).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: S -> Type).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
$cpcon' :: forall (s :: S). PPubKeyHash s -> Term s (PInner PPubKeyHash)
pcon' :: forall (s :: S). PPubKeyHash s -> Term s (PInner PPubKeyHash)
$cpmatch' :: forall (s :: S) (b :: S -> Type).
Term s (PInner PPubKeyHash)
-> (PPubKeyHash s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: S -> Type).
Term s (PInner PPubKeyHash)
-> (PPubKeyHash s -> Term s b) -> Term s b
PlutusType
    )
    via (DeriveNewtypePlutusType PPubKeyHash)

-- | @since 3.3.0
instance PLiftable PPubKeyHash where
  type AsHaskell PPubKeyHash = Plutus.PubKeyHash
  type PlutusRepr PPubKeyHash = ByteString
  {-# INLINEABLE haskToRepr #-}
  haskToRepr :: AsHaskell PPubKeyHash -> PlutusRepr PPubKeyHash
haskToRepr (Plutus.PubKeyHash (PlutusTx.BuiltinByteString ByteString
str)) = ByteString
PlutusRepr PPubKeyHash
str
  {-# INLINEABLE reprToHask #-}
  reprToHask :: PlutusRepr PPubKeyHash -> Either LiftError (AsHaskell PPubKeyHash)
reprToHask = PubKeyHash -> Either LiftError PubKeyHash
forall a b. b -> Either a b
Right (PubKeyHash -> Either LiftError PubKeyHash)
-> (ByteString -> PubKeyHash)
-> ByteString
-> Either LiftError PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> PubKeyHash
Plutus.PubKeyHash (BuiltinByteString -> PubKeyHash)
-> (ByteString -> BuiltinByteString) -> ByteString -> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
PlutusTx.BuiltinByteString
  {-# INLINEABLE reprToPlut #-}
  reprToPlut :: forall (s :: S). PlutusRepr PPubKeyHash -> PLifted s PPubKeyHash
reprToPlut = PlutusRepr PPubKeyHash -> PLifted s PPubKeyHash
forall (a :: S -> Type) (s :: S).
(PLiftable a, Includes DefaultUni (PlutusRepr a)) =>
PlutusRepr a -> PLifted s a
reprToPlutUni
  {-# INLINEABLE plutToRepr #-}
  plutToRepr :: (forall (s :: S). PLifted s PPubKeyHash)
-> Either LiftError (PlutusRepr PPubKeyHash)
plutToRepr = (forall (s :: S). PLifted s PPubKeyHash)
-> Either LiftError (PlutusRepr PPubKeyHash)
forall (a :: S -> Type).
(PLiftable a, Includes DefaultUni (PlutusRepr a)) =>
(forall (s :: S). PLifted s a) -> Either LiftError (PlutusRepr a)
plutToReprUni