{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# OPTIONS_GHC -Wno-orphans            #-}

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

import Control.DeepSeq (NFData)
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 qualified as PlutusTx
import PlutusTx.Lift
import PlutusTx.Prelude qualified as P
import Prettyprinter.Extras (Pretty, PrettyShow (..))

fromHex :: BS.ByteString -> Either String LedgerBytes
fromHex :: ByteString -> Either String LedgerBytes
fromHex = (ByteString -> LedgerBytes)
-> Either String ByteString -> Either String LedgerBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinByteString -> LedgerBytes
LedgerBytes (BuiltinByteString -> LedgerBytes)
-> (ByteString -> BuiltinByteString) -> ByteString -> LedgerBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
P.toBuiltin) (Either String ByteString -> Either String LedgerBytes)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String LedgerBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
asBSLiteral
    where

    handleChar :: Word8 -> Either String Word8
    handleChar :: Word8 -> Either String Word8
handleChar Word8
x
        | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'0' Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'9' = Word8 -> Either String Word8
forall a b. b -> Either a b
Right (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'0') -- hexits 0-9
        | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'a' Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'f' = Word8 -> Either String Word8
forall a b. b -> Either a b
Right (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'a' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
10) -- hexits a-f
        | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'A' Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'F' = Word8 -> Either String Word8
forall a b. b -> Either a b
Right (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Char -> Word8
c2w Char
'A' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
10) -- hexits A-F
        | Bool
otherwise = String -> Either String Word8
forall a b. a -> Either a b
Left (String
"not a hexit: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show (Word8 -> Char
w2c Word8
x) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"")

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

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

    -- parses a bytestring such as @a6b4@ into an actual bytestring
    asBSLiteral :: BS.ByteString -> Either String BS.ByteString
    asBSLiteral :: ByteString -> Either String ByteString
asBSLiteral = ([Word8] -> Either String [Word8])
-> ByteString -> Either String ByteString
withBytes [Word8] -> Either String [Word8]
asBytes
        where
          withBytes :: ([Word8] -> Either String [Word8]) -> BS.ByteString -> Either String BS.ByteString
          withBytes :: ([Word8] -> Either String [Word8])
-> ByteString -> Either String ByteString
withBytes [Word8] -> Either String [Word8]
f = ([Word8] -> ByteString)
-> Either String [Word8] -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack (Either String [Word8] -> Either String ByteString)
-> (ByteString -> Either String [Word8])
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Either String [Word8]
f ([Word8] -> Either String [Word8])
-> (ByteString -> [Word8]) -> ByteString -> Either String [Word8]
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
(LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> Bool) -> Eq LedgerBytes
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
Eq LedgerBytes
-> (LedgerBytes -> LedgerBytes -> Ordering)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> LedgerBytes)
-> (LedgerBytes -> LedgerBytes -> LedgerBytes)
-> Ord 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
$cp1Ord :: Eq LedgerBytes
Ord, (forall x. LedgerBytes -> Rep LedgerBytes x)
-> (forall x. Rep LedgerBytes x -> LedgerBytes)
-> Generic LedgerBytes
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
(LedgerBytes -> LedgerBytes -> Bool) -> Eq LedgerBytes
forall a. (a -> a -> Bool) -> Eq a
== :: LedgerBytes -> LedgerBytes -> Bool
$c== :: LedgerBytes -> LedgerBytes -> Bool
P.Eq, Eq LedgerBytes
Eq LedgerBytes
-> (LedgerBytes -> LedgerBytes -> Ordering)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> Bool)
-> (LedgerBytes -> LedgerBytes -> LedgerBytes)
-> (LedgerBytes -> LedgerBytes -> LedgerBytes)
-> Ord 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
$cp1Ord :: Eq LedgerBytes
P.Ord, LedgerBytes -> BuiltinData
(LedgerBytes -> BuiltinData) -> ToData LedgerBytes
forall a. (a -> BuiltinData) -> ToData a
toBuiltinData :: LedgerBytes -> BuiltinData
$ctoBuiltinData :: LedgerBytes -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe LedgerBytes
(BuiltinData -> Maybe LedgerBytes) -> FromData LedgerBytes
forall a. (BuiltinData -> Maybe a) -> FromData a
fromBuiltinData :: BuiltinData -> Maybe LedgerBytes
$cfromBuiltinData :: BuiltinData -> Maybe LedgerBytes
PlutusTx.FromData, BuiltinData -> LedgerBytes
(BuiltinData -> LedgerBytes) -> UnsafeFromData LedgerBytes
forall a. (BuiltinData -> a) -> UnsafeFromData a
unsafeFromBuiltinData :: BuiltinData -> LedgerBytes
$cunsafeFromBuiltinData :: BuiltinData -> LedgerBytes
PlutusTx.UnsafeFromData)
    deriving anyclass (LedgerBytes -> ()
(LedgerBytes -> ()) -> NFData LedgerBytes
forall a. (a -> ()) -> NFData a
rnf :: LedgerBytes -> ()
$crnf :: LedgerBytes -> ()
NFData)
    deriving [LedgerBytes] -> Doc ann
LedgerBytes -> Doc ann
(forall ann. LedgerBytes -> Doc ann)
-> (forall ann. [LedgerBytes] -> Doc ann) -> Pretty LedgerBytes
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 :: [LedgerBytes] -> Doc ann
$cprettyList :: forall ann. [LedgerBytes] -> Doc ann
pretty :: LedgerBytes -> Doc ann
$cpretty :: forall ann. LedgerBytes -> Doc ann
Pretty via (PrettyShow LedgerBytes)

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

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

instance IsString LedgerBytes where
    fromString :: String -> LedgerBytes
fromString = Either String LedgerBytes -> LedgerBytes
forall a. Either String a -> a
unsafeFromEither (Either String LedgerBytes -> LedgerBytes)
-> (String -> Either String LedgerBytes) -> String -> LedgerBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String LedgerBytes
fromHex (ByteString -> Either String LedgerBytes)
-> (String -> ByteString) -> String -> Either String LedgerBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString

instance Show LedgerBytes where
    show :: LedgerBytes -> String
show = Text -> String
Text.unpack (Text -> String) -> (LedgerBytes -> Text) -> LedgerBytes -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeByteString (ByteString -> Text)
-> (LedgerBytes -> ByteString) -> LedgerBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> ByteString
bytes

encodeByteString :: BS.ByteString -> Text.Text
encodeByteString :: ByteString -> Text
encodeByteString = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode

makeLift ''LedgerBytes