{-# 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

-- | Plutus 'BuiltinByteString'
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)

{- | A Plutarch-level representation of bytes.

= Note =

This type is intentionally quite restrictive, as it's not really meant to be
computed with. Instead, it ensures certain operations' type safety while also
allowing more sensible signatures. If you want to do anything with 'PByte's,
we recommend converting them to 'PInteger's first.

@since WIP
-}
newtype PByte (s :: S) = PByte (Term s POpaque)
  deriving stock
    ( -- | @since WIP
      (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

{- | Type designating whether a conversion should be most-significant-first or
most-significant-last. See
[CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121#representation)
for more details on this.

@since WIP
-}
newtype PEndianness (s :: S) = PEndianness (Term s PBool)
  deriving stock
    ( -- | @since WIP
      (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
    )

{- | Indicates the conversion should be most-significant-first.

@since WIP
-}
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

{- | Indicates the conversion should be most-significant-last.

@since WIP
-}
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

{- | Indicates that padding semantics should be used.

@since WIP
-}
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

{- | Indicates that truncation semantics should be used.

@since WIP
-}
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

{- | Type designating whether logical operations should use padding or
truncation semantics. See
[CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#padding-versus-truncation-semantics)
for more details on this.

@since WIP
-}
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)

{- | Perform the logical AND of two 'PByteString's, as per
[CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicaland).
The 'PLogicOpSemantics' argument specifies what should be done if the lengths
of the two 'PByteString' arguments do not match.

@since WIP
-}
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

{- | Perform the logical OR of two 'PByteString's, as per
[CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalor).
The 'PLogicOpSemantics' argument specifies what should be done if the lengths
of the two 'PByteString' arguments do not match.

@since WIP
-}
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

{- | Perform the logical XOR of two 'PByteString's, as per
[CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalxor).
The 'PLogicOpSemantics' argument specifies what should be done if the lengths
of the two 'PByteString' arguments do not match.

@since WIP
-}
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

{- | Perform the logical complement of a 'PByteString', as per
[CIP-122](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0122#bitwiselogicalcomplement).

@since WIP
-}
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

{- | Given a desired length and a 'PByte', construct a 'PByteString' of the
specified length (0 if negative) consisting entirely of that 'PByte'.

@since WIP
-}
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

{- | Prepend a 'PByte' to a 'PByteString.

@since WIP
-}
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

{- | Convert a 'PByte' into its corresponding 'PInteger'.

@since WIP
-}
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

{- | Try to convert a 'PInteger' into its corresponding 'PByte'. This operation
unchecked: use with care.

@since WIP
-}
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

{- | Slice a 'PByteString' with given start index and slice length.

>>> (pslice # 2 # 3 phexByteStr "4102afde5b2a") #== phexByteStr "afde5b"
-}
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

-- | Find the length of a 'PByteString'.
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

{- | Given a valid index into a 'PByteString', returns the 'PByte' at that
index. Will crash if given an out-of-bounds index.

@since WIP
-}
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

-- | Interpret a hex string as a PByteString.
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

{- | Convert a 'PByteString' into a 'PInteger', as per
[CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121#builtinbytestringtointeger).

@since WIP
-}
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

{- | Converts a 'PInteger' into a 'PByteString', given a desired endianness and
target length. For more details, see [CIP-121](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0121#builtinintegertobytestring).

= Note

This conversion is unsafe. It will fail if any of the following occur:

1. The size is negative.
2. The size is too large (currently if over 8196 bytes).
3. The size won't fit the integer to convert.
-}
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

-- Helpers

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])