-- editorconfig-checker-disable-file
{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DerivingVia     #-}
{-# LANGUAGE TemplateHaskell #-}

{-# OPTIONS_GHC -Wno-orphans            #-}

module PlutusLedgerApi.V1.Bytes
    ( LedgerBytes (..)
    , fromHex
    , bytes
    , fromBytes
    , encodeByteString
    ) where

import Control.DeepSeq (NFData)
import Control.Exception
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Internal (c2w, w2c)
import Data.Either.Extras (unsafeFromEither)
import Data.String (IsString (..))
import Data.Text qualified as Text
import Data.Text.Encoding qualified as TE
import Data.Word (Word8)
import GHC.Generics (Generic)
import PlutusTx
import PlutusTx.Prelude qualified as P
import Prettyprinter.Extras (Pretty, PrettyShow (..))

{- | An error that is encountered when converting a `ByteString` to a `LedgerBytes`. -}
data LedgerBytesError =
    UnpairedDigit -- ^ Odd number of bytes.
    | NotHexit Char -- ^ Not a hex digit.
    deriving stock (Int -> LedgerBytesError -> ShowS
[LedgerBytesError] -> ShowS
LedgerBytesError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LedgerBytesError] -> ShowS
$cshowList :: [LedgerBytesError] -> ShowS
show :: LedgerBytesError -> String
$cshow :: LedgerBytesError -> String
showsPrec :: Int -> LedgerBytesError -> ShowS
$cshowsPrec :: Int -> LedgerBytesError -> ShowS
Show)
    deriving anyclass (Show LedgerBytesError
Typeable LedgerBytesError
SomeException -> Maybe LedgerBytesError
LedgerBytesError -> String
LedgerBytesError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: LedgerBytesError -> String
$cdisplayException :: LedgerBytesError -> String
fromException :: SomeException -> Maybe LedgerBytesError
$cfromException :: SomeException -> Maybe LedgerBytesError
toException :: LedgerBytesError -> SomeException
$ctoException :: LedgerBytesError -> SomeException
Exception)

{- | Convert a hex encoded `ByteString` to a `LedgerBytes`. May return an error (`LedgerBytesError`). -}
fromHex :: BS.ByteString -> Either LedgerBytesError LedgerBytes
fromHex :: ByteString -> Either LedgerBytesError LedgerBytes
fromHex = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinByteString -> LedgerBytes
LedgerBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
P.toBuiltin) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either LedgerBytesError ByteString
asBSLiteral
    where

    handleChar :: Word8 -> Either LedgerBytesError Word8
    handleChar :: Word8 -> Either LedgerBytesError Word8
handleChar Word8
x
        | Word8
x forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'0' Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'9' = forall a b. b -> Either a b
Right (Word8
x forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'0') -- hexits 0-9
        | Word8
x forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'a' Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'f' = forall a b. b -> Either a b
Right (Word8
x forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'a' forall a. Num a => a -> a -> a
+ Word8
10) -- hexits a-f
        | Word8
x forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'A' Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'F' = forall a b. b -> Either a b
Right (Word8
x forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'A' forall a. Num a => a -> a -> a
+ Word8
10) -- hexits A-F
        | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Char -> LedgerBytesError
NotHexit (Word8 -> Char
w2c Word8
x)

    -- turns a pair of bytes such as "a6" into a single Word8
    handlePair :: Word8 -> Word8 -> Either LedgerBytesError Word8
    handlePair :: Word8 -> Word8 -> Either LedgerBytesError Word8
handlePair Word8
c Word8
c' = do
      Word8
n <- Word8 -> Either LedgerBytesError Word8
handleChar Word8
c
      Word8
n' <- Word8 -> Either LedgerBytesError Word8
handleChar Word8
c'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Word8
16 forall a. Num a => a -> a -> a
* Word8
n) forall a. Num a => a -> a -> a
+ Word8
n'

    asBytes :: [Word8] -> Either LedgerBytesError [Word8]
    asBytes :: [Word8] -> Either LedgerBytesError [Word8]
asBytes []        = forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
    asBytes (Word8
c:Word8
c':[Word8]
cs) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Word8 -> Either LedgerBytesError Word8
handlePair Word8
c Word8
c' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Word8] -> Either LedgerBytesError [Word8]
asBytes [Word8]
cs
    asBytes [Word8]
_         = forall a b. a -> Either a b
Left LedgerBytesError
UnpairedDigit

    -- parses a bytestring such as @a6b4@ into an actual bytestring
    asBSLiteral :: BS.ByteString -> Either LedgerBytesError BS.ByteString
    asBSLiteral :: ByteString -> Either LedgerBytesError ByteString
asBSLiteral = ([Word8] -> Either LedgerBytesError [Word8])
-> ByteString -> Either LedgerBytesError ByteString
withBytes [Word8] -> Either LedgerBytesError [Word8]
asBytes
        where
          withBytes :: ([Word8] -> Either LedgerBytesError [Word8]) -> BS.ByteString -> Either LedgerBytesError BS.ByteString
          withBytes :: ([Word8] -> Either LedgerBytesError [Word8])
-> ByteString -> Either LedgerBytesError ByteString
withBytes [Word8] -> Either LedgerBytesError [Word8]
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Either LedgerBytesError [Word8]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack

newtype LedgerBytes = LedgerBytes { LedgerBytes -> BuiltinByteString
getLedgerBytes :: P.BuiltinByteString }
    deriving stock (LedgerBytes -> LedgerBytes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LedgerBytes -> LedgerBytes -> Bool
$c/= :: LedgerBytes -> LedgerBytes -> Bool
== :: LedgerBytes -> LedgerBytes -> Bool
$c== :: LedgerBytes -> LedgerBytes -> Bool
Eq, Eq LedgerBytes
LedgerBytes -> LedgerBytes -> Bool
LedgerBytes -> LedgerBytes -> Ordering
LedgerBytes -> LedgerBytes -> LedgerBytes
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 :: LedgerBytes -> LedgerBytes -> LedgerBytes
$cmin :: LedgerBytes -> LedgerBytes -> LedgerBytes
max :: LedgerBytes -> LedgerBytes -> LedgerBytes
$cmax :: LedgerBytes -> LedgerBytes -> LedgerBytes
>= :: LedgerBytes -> LedgerBytes -> Bool
$c>= :: LedgerBytes -> LedgerBytes -> Bool
> :: LedgerBytes -> LedgerBytes -> Bool
$c> :: LedgerBytes -> LedgerBytes -> Bool
<= :: LedgerBytes -> LedgerBytes -> Bool
$c<= :: LedgerBytes -> LedgerBytes -> Bool
< :: LedgerBytes -> LedgerBytes -> Bool
$c< :: LedgerBytes -> LedgerBytes -> Bool
compare :: LedgerBytes -> LedgerBytes -> Ordering
$ccompare :: LedgerBytes -> LedgerBytes -> Ordering
Ord, forall x. Rep LedgerBytes x -> LedgerBytes
forall x. LedgerBytes -> Rep LedgerBytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LedgerBytes x -> LedgerBytes
$cfrom :: forall x. LedgerBytes -> Rep LedgerBytes x
Generic)
    deriving newtype (LedgerBytes -> LedgerBytes -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: LedgerBytes -> LedgerBytes -> Bool
$c== :: LedgerBytes -> LedgerBytes -> Bool
P.Eq, Eq LedgerBytes
LedgerBytes -> LedgerBytes -> Bool
LedgerBytes -> LedgerBytes -> Ordering
LedgerBytes -> LedgerBytes -> LedgerBytes
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 :: LedgerBytes -> LedgerBytes -> LedgerBytes
$cmin :: LedgerBytes -> LedgerBytes -> LedgerBytes
max :: LedgerBytes -> LedgerBytes -> LedgerBytes
$cmax :: LedgerBytes -> LedgerBytes -> LedgerBytes
>= :: LedgerBytes -> LedgerBytes -> Bool
$c>= :: LedgerBytes -> LedgerBytes -> Bool
> :: LedgerBytes -> LedgerBytes -> Bool
$c> :: LedgerBytes -> LedgerBytes -> Bool
<= :: LedgerBytes -> LedgerBytes -> Bool
$c<= :: LedgerBytes -> LedgerBytes -> Bool
< :: LedgerBytes -> LedgerBytes -> Bool
$c< :: LedgerBytes -> LedgerBytes -> Bool
compare :: LedgerBytes -> LedgerBytes -> Ordering
$ccompare :: LedgerBytes -> LedgerBytes -> Ordering
P.Ord, LedgerBytes -> BuiltinData
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: LedgerBytes -> BuiltinData
$ctoBuiltinData :: LedgerBytes -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe LedgerBytes
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe LedgerBytes
$cfromBuiltinData :: BuiltinData -> Maybe LedgerBytes
PlutusTx.FromData, BuiltinData -> LedgerBytes
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> LedgerBytes
$cunsafeFromBuiltinData :: BuiltinData -> LedgerBytes
PlutusTx.UnsafeFromData)
    deriving anyclass (LedgerBytes -> ()
forall a. (a -> ()) -> NFData a
rnf :: LedgerBytes -> ()
$crnf :: LedgerBytes -> ()
NFData)
    deriving forall ann. [LedgerBytes] -> Doc ann
forall ann. LedgerBytes -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [LedgerBytes] -> Doc ann
$cprettyList :: forall ann. [LedgerBytes] -> Doc ann
pretty :: forall ann. LedgerBytes -> Doc ann
$cpretty :: forall ann. LedgerBytes -> Doc ann
Pretty via (PrettyShow LedgerBytes)

bytes :: LedgerBytes -> BS.ByteString
bytes :: LedgerBytes -> ByteString
bytes = forall arep a. FromBuiltin arep a => arep -> a
P.fromBuiltin forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> BuiltinByteString
getLedgerBytes

fromBytes :: BS.ByteString -> LedgerBytes
fromBytes :: ByteString -> LedgerBytes
fromBytes = BuiltinByteString -> LedgerBytes
LedgerBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a arep. ToBuiltin a arep => a -> arep
P.toBuiltin

{- | The `IsString` instance of `LedgerBytes` could throw an exception of `LedgerBytesError`. -}
instance IsString LedgerBytes where
    fromString :: String -> LedgerBytes
fromString = forall e a. Exception e => Either e a -> a
unsafeFromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either LedgerBytesError LedgerBytes
fromHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

{- | The `Show` instance of `LedgerBytes` is its base16/hex encoded bytestring,
decoded with UTF-8, unpacked to `String`. -}
instance Show LedgerBytes where
    show :: LedgerBytes -> String
show = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> ByteString
bytes

{- | Encode a ByteString value in base16 (i.e. hexadecimal), then
decode with UTF-8 to a `Text`. -}
encodeByteString :: BS.ByteString -> Text.Text
encodeByteString :: ByteString -> Text
encodeByteString = ByteString -> Text
TE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode

makeLift ''LedgerBytes