{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Api.V1.Crypto (
  PPubKeyHash (PPubKeyHash),
  PubKey (PubKey, getPubKey),
  pubKeyHash,
) where

import PlutusLedgerApi.V1 qualified as Plutus

import Data.Coerce (coerce)
import Plutarch.Api.Internal.Hashing (hashLedgerBytes)
import Plutarch.Lift (
  DerivePConstantViaBuiltin (DerivePConstantViaBuiltin),
  PConstantDecl,
  PLifted,
  PUnsafeLiftDecl,
 )
import Plutarch.Prelude
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import Plutarch.Unsafe (punsafeCoerce)

newtype PPubKeyHash (s :: S) = PPubKeyHash (Term s PByteString)
  deriving stock (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
$cto :: forall (s :: S) x. Rep (PPubKeyHash s) x -> PPubKeyHash s
$cfrom :: forall (s :: S) x. PPubKeyHash s -> Rep (PPubKeyHash s) x
Generic)
  deriving anyclass (forall (s :: S). PPubKeyHash s -> Term s (PInner PPubKeyHash)
forall (s :: S) (b :: PType).
Term s (PInner PPubKeyHash)
-> (PPubKeyHash s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PPubKeyHash)
-> (PPubKeyHash s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PPubKeyHash)
-> (PPubKeyHash s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PPubKeyHash s -> Term s (PInner PPubKeyHash)
$cpcon' :: forall (s :: S). PPubKeyHash s -> Term s (PInner PPubKeyHash)
PlutusType, forall (s :: S). Term s (PAsData PPubKeyHash) -> Term s PPubKeyHash
forall (s :: S). Term s PPubKeyHash -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PPubKeyHash -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PPubKeyHash -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PPubKeyHash) -> Term s PPubKeyHash
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PPubKeyHash) -> Term s PPubKeyHash
PIsData, forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: 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
PEq, PEq PPubKeyHash
forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
forall (t :: PType).
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)
-> PPartialOrd t
#< :: 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
$c#<= :: forall (s :: S).
Term s PPubKeyHash -> Term s PPubKeyHash -> Term s PBool
PPartialOrd, PPartialOrd PPubKeyHash
forall (t :: PType). PPartialOrd t -> POrd t
POrd, forall (s :: S). Bool -> Term s PPubKeyHash -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PPubKeyHash -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PPubKeyHash -> Term s PString
PShow)
instance DerivePlutusType PPubKeyHash where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PPubKeyHash where type PLifted PPubKeyHash = Plutus.PubKeyHash
deriving via
  (DerivePConstantViaBuiltin Plutus.PubKeyHash PPubKeyHash PByteString)
  instance
    PConstantDecl Plutus.PubKeyHash

instance PTryFrom PData (PAsData PPubKeyHash) where
  type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PPubKeyHash),
     Reduce (PTryFromExcess PData (PAsData PPubKeyHash) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = forall (r :: PType) (s :: S) a.
TermCont @r s a -> (a -> Term s r) -> Term s r
runTermCont forall a b. (a -> b) -> a -> b
$ do
    Term s PByteString
unwrapped <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PByteString) Term s PData
opq forall a b. (a, b) -> b
snd
    forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f ->
      forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
unwrapped forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
28) (() -> Term s r
f ()) (forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"ptryFrom(PPubKeyHash): must be 28 bytes long")
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s PData
opq, forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PByteString -> PPubKeyHash s
PPubKeyHash forall a b. (a -> b) -> a -> b
$ Term s PByteString
unwrapped)

newtype PubKey = PubKey {PubKey -> LedgerBytes
getPubKey :: Plutus.LedgerBytes}
  deriving stock (PubKey -> PubKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubKey -> PubKey -> Bool
$c/= :: PubKey -> PubKey -> Bool
== :: PubKey -> PubKey -> Bool
$c== :: PubKey -> PubKey -> Bool
Eq, Eq PubKey
PubKey -> PubKey -> Bool
PubKey -> PubKey -> Ordering
PubKey -> PubKey -> PubKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PubKey -> PubKey -> PubKey
$cmin :: PubKey -> PubKey -> PubKey
max :: PubKey -> PubKey -> PubKey
$cmax :: PubKey -> PubKey -> PubKey
>= :: PubKey -> PubKey -> Bool
$c>= :: PubKey -> PubKey -> Bool
> :: PubKey -> PubKey -> Bool
$c> :: PubKey -> PubKey -> Bool
<= :: PubKey -> PubKey -> Bool
$c<= :: PubKey -> PubKey -> Bool
< :: PubKey -> PubKey -> Bool
$c< :: PubKey -> PubKey -> Bool
compare :: PubKey -> PubKey -> Ordering
$ccompare :: PubKey -> PubKey -> Ordering
Ord, Int -> PubKey -> ShowS
[PubKey] -> ShowS
PubKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PubKey] -> ShowS
$cshowList :: [PubKey] -> ShowS
show :: PubKey -> String
$cshow :: PubKey -> String
showsPrec :: Int -> PubKey -> ShowS
$cshowsPrec :: Int -> PubKey -> ShowS
Show)

newtype Flip f a b = Flip (f b a) deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
$cto :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
$cfrom :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
Generic)

pubKeyHash :: PubKey -> Plutus.PubKeyHash
pubKeyHash :: PubKey -> PubKeyHash
pubKeyHash = coerce :: forall a b. Coercible @Type a b => a -> b
coerce LedgerBytes -> BuiltinByteString
hashLedgerBytes