{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
module Plutarch.Builtin.ByteString (
PByteString (..),
PByte (..),
PLogicOpSemantics (..),
PEndianness (..),
ppadding,
ptruncation,
pmostSignificantFirst,
pmostSignificantLast,
pandBS,
porBS,
pxorBS,
pcomplementBS,
preplicateBS,
pconsBS,
pbyteToInteger,
pintegerToByte,
psliceBS,
plengthBS,
pindexBS,
phexByteStr,
pbyteStringToInteger,
pintegerToByteString,
) where
import Data.ByteString qualified as BS
import Data.Char (toLower)
import Data.Word (Word8)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Plutarch.Builtin.Bool (PBool, pfalse, ptrue)
import Plutarch.Builtin.Integer (PInteger)
import Plutarch.Builtin.Opaque (POpaque)
import {-# SOURCE #-} Plutarch.Internal.PLam (plam)
import Plutarch.Internal.Term (
S,
Term,
phoistAcyclic,
punsafeBuiltin,
punsafeCoerce,
punsafeConstantInternal,
(#),
(:-->),
)
import PlutusCore qualified as PLC
newtype PByteString s = PByteString (Term s POpaque)
deriving stock ((forall x. PByteString s -> Rep (PByteString s) x)
-> (forall x. Rep (PByteString s) x -> PByteString s)
-> Generic (PByteString s)
forall x. Rep (PByteString s) x -> PByteString s
forall x. PByteString s -> Rep (PByteString s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PByteString s) x -> PByteString s
forall (s :: S) x. PByteString s -> Rep (PByteString s) x
$cfrom :: forall (s :: S) x. PByteString s -> Rep (PByteString s) x
from :: forall x. PByteString s -> Rep (PByteString s) x
$cto :: forall (s :: S) x. Rep (PByteString s) x -> PByteString s
to :: forall x. Rep (PByteString s) x -> PByteString s
Generic)
newtype PByte (s :: S) = PByte (Term s POpaque)
deriving stock
(
(forall x. PByte s -> Rep (PByte s) x)
-> (forall x. Rep (PByte s) x -> PByte s) -> Generic (PByte s)
forall x. Rep (PByte s) x -> PByte s
forall x. PByte s -> Rep (PByte s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PByte s) x -> PByte s
forall (s :: S) x. PByte s -> Rep (PByte s) x
$cfrom :: forall (s :: S) x. PByte s -> Rep (PByte s) x
from :: forall x. PByte s -> Rep (PByte s) x
$cto :: forall (s :: S) x. Rep (PByte s) x -> PByte s
to :: forall x. Rep (PByte s) x -> PByte s
Generic
)
instance Semigroup (Term s PByteString) where
Term s PByteString
x <> :: Term s PByteString -> Term s PByteString -> Term s PByteString
<> Term s PByteString
y = DefaultFun
-> Term s (PByteString :--> (PByteString :--> PByteString))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.AppendByteString Term s (PByteString :--> (PByteString :--> PByteString))
-> Term s PByteString -> Term s (PByteString :--> PByteString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
x Term s (PByteString :--> PByteString)
-> Term s PByteString -> Term s PByteString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
y
instance Monoid (Term s PByteString) where
mempty :: Term s PByteString
mempty = Some @Type (ValueOf DefaultUni) -> Term s PByteString
forall (s :: S) (a :: PType).
Some @Type (ValueOf DefaultUni) -> Term s a
punsafeConstantInternal (Some @Type (ValueOf DefaultUni) -> Term s PByteString)
-> Some @Type (ValueOf DefaultUni) -> Term s PByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Some @Type (ValueOf DefaultUni)
forall a (uni :: Type -> Type).
Contains @Type uni a =>
a -> Some @Type (ValueOf uni)
PLC.someValue ByteString
BS.empty
newtype PEndianness (s :: S) = PEndianness (Term s PBool)
deriving stock
(
(forall x. PEndianness s -> Rep (PEndianness s) x)
-> (forall x. Rep (PEndianness s) x -> PEndianness s)
-> Generic (PEndianness s)
forall x. Rep (PEndianness s) x -> PEndianness s
forall x. PEndianness s -> Rep (PEndianness s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PEndianness s) x -> PEndianness s
forall (s :: S) x. PEndianness s -> Rep (PEndianness s) x
$cfrom :: forall (s :: S) x. PEndianness s -> Rep (PEndianness s) x
from :: forall x. PEndianness s -> Rep (PEndianness s) x
$cto :: forall (s :: S) x. Rep (PEndianness s) x -> PEndianness s
to :: forall x. Rep (PEndianness s) x -> PEndianness s
Generic
)
pmostSignificantFirst :: forall (s :: S). Term s PEndianness
pmostSignificantFirst :: forall (s :: S). Term s PEndianness
pmostSignificantFirst = Term s PBool -> Term s PEndianness
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce Term s PBool
forall (s :: S). Term s PBool
ptrue
pmostSignificantLast :: forall (s :: S). Term s PEndianness
pmostSignificantLast :: forall (s :: S). Term s PEndianness
pmostSignificantLast = Term s PBool -> Term s PEndianness
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce Term s PBool
forall (s :: S). Term s PBool
pfalse
ppadding :: forall (s :: S). Term s PLogicOpSemantics
ppadding :: forall (s :: S). Term s PLogicOpSemantics
ppadding = Term s PBool -> Term s PLogicOpSemantics
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce Term s PBool
forall (s :: S). Term s PBool
ptrue
ptruncation :: forall (s :: S). Term s PLogicOpSemantics
ptruncation :: forall (s :: S). Term s PLogicOpSemantics
ptruncation = Term s PBool -> Term s PLogicOpSemantics
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce Term s PBool
forall (s :: S). Term s PBool
pfalse
newtype PLogicOpSemantics (s :: S) = PLogicOpSemantics (Term s PBool)
deriving stock ((forall x. PLogicOpSemantics s -> Rep (PLogicOpSemantics s) x)
-> (forall x. Rep (PLogicOpSemantics s) x -> PLogicOpSemantics s)
-> Generic (PLogicOpSemantics s)
forall x. Rep (PLogicOpSemantics s) x -> PLogicOpSemantics s
forall x. PLogicOpSemantics s -> Rep (PLogicOpSemantics s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x.
Rep (PLogicOpSemantics s) x -> PLogicOpSemantics s
forall (s :: S) x.
PLogicOpSemantics s -> Rep (PLogicOpSemantics s) x
$cfrom :: forall (s :: S) x.
PLogicOpSemantics s -> Rep (PLogicOpSemantics s) x
from :: forall x. PLogicOpSemantics s -> Rep (PLogicOpSemantics s) x
$cto :: forall (s :: S) x.
Rep (PLogicOpSemantics s) x -> PLogicOpSemantics s
to :: forall x. Rep (PLogicOpSemantics s) x -> PLogicOpSemantics s
Generic)
pandBS ::
forall (s :: S).
Term s (PLogicOpSemantics :--> PByteString :--> PByteString :--> PByteString)
pandBS :: forall (s :: S).
Term
s
(PLogicOpSemantics
:--> (PByteString :--> (PByteString :--> PByteString)))
pandBS = DefaultFun
-> Term
s
(PLogicOpSemantics
:--> (PByteString :--> (PByteString :--> PByteString)))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.AndByteString
porBS ::
forall (s :: S).
Term s (PLogicOpSemantics :--> PByteString :--> PByteString :--> PByteString)
porBS :: forall (s :: S).
Term
s
(PLogicOpSemantics
:--> (PByteString :--> (PByteString :--> PByteString)))
porBS = DefaultFun
-> Term
s
(PLogicOpSemantics
:--> (PByteString :--> (PByteString :--> PByteString)))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.OrByteString
pxorBS ::
forall (s :: S).
Term s (PLogicOpSemantics :--> PByteString :--> PByteString :--> PByteString)
pxorBS :: forall (s :: S).
Term
s
(PLogicOpSemantics
:--> (PByteString :--> (PByteString :--> PByteString)))
pxorBS = DefaultFun
-> Term
s
(PLogicOpSemantics
:--> (PByteString :--> (PByteString :--> PByteString)))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.XorByteString
pcomplementBS ::
forall (s :: S).
Term s (PByteString :--> PByteString)
pcomplementBS :: forall (s :: S). Term s (PByteString :--> PByteString)
pcomplementBS = DefaultFun -> Term s (PByteString :--> PByteString)
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.ComplementByteString
preplicateBS :: forall (s :: S). Term s (PInteger :--> PByte :--> PByteString)
preplicateBS :: forall (s :: S). Term s (PInteger :--> (PByte :--> PByteString))
preplicateBS = DefaultFun -> Term s (PInteger :--> (PByte :--> PByteString))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.ReplicateByte
pconsBS :: Term s (PByte :--> PByteString :--> PByteString)
pconsBS :: forall (s :: S). Term s (PByte :--> (PByteString :--> PByteString))
pconsBS = DefaultFun -> Term s (PByte :--> (PByteString :--> PByteString))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.ConsByteString
pbyteToInteger :: Term s (PByte :--> PInteger)
pbyteToInteger :: forall (s :: S). Term s (PByte :--> PInteger)
pbyteToInteger = (forall (s :: S). Term s (PByte :--> PInteger))
-> Term s (PByte :--> PInteger)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PByte :--> PInteger))
-> Term s (PByte :--> PInteger))
-> (forall (s :: S). Term s (PByte :--> PInteger))
-> Term s (PByte :--> PInteger)
forall a b. (a -> b) -> a -> b
$ (Term s PByte -> Term s PInteger) -> Term s (PByte :--> PInteger)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PInteger) -> Term s (c :--> PInteger)
plam Term s PByte -> Term s PInteger
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce
pintegerToByte :: Term s (PInteger :--> PByte)
pintegerToByte :: forall (s :: S). Term s (PInteger :--> PByte)
pintegerToByte = (forall (s :: S). Term s (PInteger :--> PByte))
-> Term s (PInteger :--> PByte)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PInteger :--> PByte))
-> Term s (PInteger :--> PByte))
-> (forall (s :: S). Term s (PInteger :--> PByte))
-> Term s (PInteger :--> PByte)
forall a b. (a -> b) -> a -> b
$ (Term s PInteger -> Term s PByte) -> Term s (PInteger :--> PByte)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PByte) -> Term s (c :--> PByte)
plam Term s PInteger -> Term s PByte
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce
psliceBS :: Term s (PInteger :--> PInteger :--> PByteString :--> PByteString)
psliceBS :: forall (s :: S).
Term
s (PInteger :--> (PInteger :--> (PByteString :--> PByteString)))
psliceBS = DefaultFun
-> Term
s (PInteger :--> (PInteger :--> (PByteString :--> PByteString)))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.SliceByteString
plengthBS :: Term s (PByteString :--> PInteger)
plengthBS :: forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS = DefaultFun -> Term s (PByteString :--> PInteger)
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.LengthOfByteString
pindexBS :: Term s (PByteString :--> PInteger :--> PByte)
pindexBS :: forall (s :: S). Term s (PByteString :--> (PInteger :--> PByte))
pindexBS = DefaultFun -> Term s (PByteString :--> (PInteger :--> PByte))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.IndexByteString
phexByteStr :: HasCallStack => String -> Term s PByteString
phexByteStr :: forall (s :: S). HasCallStack => String -> Term s PByteString
phexByteStr = Some @Type (ValueOf DefaultUni) -> Term s PByteString
forall (s :: S) (a :: PType).
Some @Type (ValueOf DefaultUni) -> Term s a
punsafeConstantInternal (Some @Type (ValueOf DefaultUni) -> Term s PByteString)
-> (String -> Some @Type (ValueOf DefaultUni))
-> String
-> Term s PByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Some @Type (ValueOf DefaultUni)
forall a (uni :: Type -> Type).
Contains @Type uni a =>
a -> Some @Type (ValueOf uni)
PLC.someValue (ByteString -> Some @Type (ValueOf DefaultUni))
-> (String -> ByteString)
-> String
-> Some @Type (ValueOf DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
f
where
f :: String -> [Word8]
f String
"" = []
f [Item String
_] = String -> [Word8]
forall a. HasCallStack => String -> a
error String
"UnevenLength"
f (Char
x : Char
y : String
rest) = (HasCallStack => Char -> Word8
Char -> Word8
hexDigitToWord8 Char
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ HasCallStack => Char -> Word8
Char -> Word8
hexDigitToWord8 Char
y) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: String -> [Word8]
f String
rest
pbyteStringToInteger ::
forall (s :: S).
Term s (PEndianness :--> PByteString :--> PInteger)
pbyteStringToInteger :: forall (s :: S).
Term s (PEndianness :--> (PByteString :--> PInteger))
pbyteStringToInteger = DefaultFun -> Term s (PEndianness :--> (PByteString :--> PInteger))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.ByteStringToInteger
pintegerToByteString ::
forall (s :: S).
Term s (PEndianness :--> PInteger :--> PInteger :--> PByteString)
pintegerToByteString :: forall (s :: S).
Term
s (PEndianness :--> (PInteger :--> (PInteger :--> PByteString)))
pintegerToByteString = DefaultFun
-> Term
s (PEndianness :--> (PInteger :--> (PInteger :--> PByteString)))
forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.IntegerToByteString
hexDigitToWord8 :: HasCallStack => Char -> Word8
hexDigitToWord8 :: HasCallStack => Char -> Word8
hexDigitToWord8 = Char -> Word8
f (Char -> Word8) -> (Char -> Char) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower
where
f :: Char -> Word8
f :: Char -> Word8
f Char
'0' = Word8
0
f Char
'1' = Word8
1
f Char
'2' = Word8
2
f Char
'3' = Word8
3
f Char
'4' = Word8
4
f Char
'5' = Word8
5
f Char
'6' = Word8
6
f Char
'7' = Word8
7
f Char
'8' = Word8
8
f Char
'9' = Word8
9
f Char
'a' = Word8
10
f Char
'b' = Word8
11
f Char
'c' = Word8
12
f Char
'd' = Word8
13
f Char
'e' = Word8
14
f Char
'f' = Word8
15
f Char
c = String -> Word8
forall a. HasCallStack => String -> a
error (String
"InvalidHexDigit " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
Item String
c])