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

module Plutarch.ByteString (
  PByteString,
  phexByteStr,
  pbyteStr,
  pconsBS,
  psliceBS,
  plengthBS,
  pindexBS,
) where

import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Char (toLower)
import Data.Word (Word8)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Plutarch.Bool (PEq, POrd, PPartialOrd, (#<), (#<=), (#==))
import Plutarch.Integer (PInteger)
import Plutarch.Internal (Term, (#), (:-->))
import Plutarch.Internal.Newtype (PlutusTypeNewtype)
import Plutarch.Internal.Other (POpaque)
import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType)
import Plutarch.Lift (
  DerivePConstantDirect (DerivePConstantDirect),
  PConstantDecl,
  PLifted,
  PUnsafeLiftDecl,
  pconstant,
 )
import Plutarch.Unsafe (punsafeBuiltin)
import PlutusCore qualified as PLC

-- | Plutus 'BuiltinByteString'
newtype PByteString s = PByteString (Term s POpaque)
  deriving stock (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
$cto :: forall (s :: S) x. Rep (PByteString s) x -> PByteString s
$cfrom :: forall (s :: S) x. PByteString s -> Rep (PByteString s) x
Generic)
  deriving anyclass (forall (s :: S). PByteString s -> Term s (PInner PByteString)
forall (s :: S) (b :: PType).
Term s (PInner PByteString)
-> (PByteString 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 PByteString)
-> (PByteString s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PByteString)
-> (PByteString s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PByteString s -> Term s (PInner PByteString)
$cpcon' :: forall (s :: S). PByteString s -> Term s (PInner PByteString)
PlutusType)

instance DerivePlutusType PByteString where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PByteString where type PLifted PByteString = ByteString
deriving via (DerivePConstantDirect ByteString PByteString) instance PConstantDecl ByteString

instance PEq PByteString where
  Term s PByteString
x #== :: forall (s :: S).
Term s PByteString -> Term s PByteString -> Term s PBool
#== Term s PByteString
y = forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.EqualsByteString forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
y

instance PPartialOrd PByteString where
  Term s PByteString
x #<= :: forall (s :: S).
Term s PByteString -> Term s PByteString -> Term s PBool
#<= Term s PByteString
y = forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.LessThanEqualsByteString forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
y
  Term s PByteString
x #< :: forall (s :: S).
Term s PByteString -> Term s PByteString -> Term s PBool
#< Term s PByteString
y = forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.LessThanByteString forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
y

instance POrd PByteString

instance Semigroup (Term s PByteString) where
  Term s PByteString
x <> :: Term s PByteString -> Term s PByteString -> Term s PByteString
<> Term s PByteString
y = forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.AppendByteString forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
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 = forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant ByteString
BS.empty

-- | Interpret a hex string as a PByteString.
phexByteStr :: HasCallStack => String -> Term s PByteString
phexByteStr :: forall (s :: S). HasCallStack => String -> Term s PByteString
phexByteStr = forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
f
  where
    f :: String -> [Word8]
f String
"" = []
    f [Item String
_] = forall a. HasCallStack => String -> a
error String
"UnevenLength"
    f (Char
x : Char
y : String
rest) = (HasCallStack => Char -> Word8
hexDigitToWord8 Char
x forall a. Num a => a -> a -> a
* Word8
16 forall a. Num a => a -> a -> a
+ HasCallStack => Char -> Word8
hexDigitToWord8 Char
y) forall a. a -> [a] -> [a]
: String -> [Word8]
f String
rest

{-# DEPRECATED pbyteStr "Use `pconstant` instead." #-}

-- | Construct a PByteString term from a Haskell bytestring.
pbyteStr :: ByteString -> Term s PByteString
pbyteStr :: forall (s :: S). ByteString -> Term s PByteString
pbyteStr = forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant

-----------------------------------------------------------
-- The following functions should be import qualified. --
-----------------------------------------------------------

-- | Prepend a byte, represented by a non negative 'PInteger', to a 'PBytestring'.
pconsBS :: Term s (PInteger :--> PByteString :--> PByteString)
pconsBS :: forall (s :: S).
Term s (PInteger :--> (PByteString :--> PByteString))
pconsBS = forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.ConsByteString

{- | 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 = 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 = forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.LengthOfByteString

-- | 'PByteString' indexing function.
pindexBS :: Term s (PByteString :--> PInteger :--> PInteger)
pindexBS :: forall (s :: S). Term s (PByteString :--> (PInteger :--> PInteger))
pindexBS = forall (s :: S) (a :: PType). DefaultFun -> Term s a
punsafeBuiltin DefaultFun
PLC.IndexByteString

hexDigitToWord8 :: HasCallStack => Char -> Word8
hexDigitToWord8 :: HasCallStack => Char -> Word8
hexDigitToWord8 = Char -> Word8
f 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 = forall a. HasCallStack => String -> a
error (String
"InvalidHexDigit " forall a. Semigroup a => a -> a -> a
<> [Char
c])