{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module PlutusLedgerApi.V1.Bytes
( LedgerBytes (..)
, LedgerBytesError (..)
, fromHex
, bytes
, fromBytes
, encodeByteString
) where
import Control.DeepSeq (NFData)
import Control.Exception (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.Function ((&))
import Data.String (IsString (..))
import Data.Text qualified as Text
import Data.Text.Encoding qualified as TE
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import PlutusTx (FromData, ToData, UnsafeFromData, makeLift)
import PlutusTx.Blueprint (HasBlueprintDefinition, HasBlueprintSchema (..), SchemaInfo (title),
withSchemaInfo)
import PlutusTx.Prelude qualified as P
import Prettyprinter.Extras (Pretty, PrettyShow (..))
data LedgerBytesError =
UnpairedDigit
| NotHexit !Char
deriving stock (Int -> LedgerBytesError -> ShowS
[LedgerBytesError] -> ShowS
LedgerBytesError -> String
(Int -> LedgerBytesError -> ShowS)
-> (LedgerBytesError -> String)
-> ([LedgerBytesError] -> ShowS)
-> Show LedgerBytesError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerBytesError -> ShowS
showsPrec :: Int -> LedgerBytesError -> ShowS
$cshow :: LedgerBytesError -> String
show :: LedgerBytesError -> String
$cshowList :: [LedgerBytesError] -> ShowS
showList :: [LedgerBytesError] -> ShowS
Show)
deriving anyclass (Show LedgerBytesError
Typeable LedgerBytesError
(Typeable LedgerBytesError, Show LedgerBytesError) =>
(LedgerBytesError -> SomeException)
-> (SomeException -> Maybe LedgerBytesError)
-> (LedgerBytesError -> String)
-> Exception LedgerBytesError
SomeException -> Maybe LedgerBytesError
LedgerBytesError -> String
LedgerBytesError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: LedgerBytesError -> SomeException
toException :: LedgerBytesError -> SomeException
$cfromException :: SomeException -> Maybe LedgerBytesError
fromException :: SomeException -> Maybe LedgerBytesError
$cdisplayException :: LedgerBytesError -> String
displayException :: LedgerBytesError -> String
Exception)
fromHex :: BS.ByteString -> Either LedgerBytesError LedgerBytes
fromHex :: ByteString -> Either LedgerBytesError LedgerBytes
fromHex = (ByteString -> LedgerBytes)
-> Either LedgerBytesError ByteString
-> Either LedgerBytesError LedgerBytes
forall a b.
(a -> b) -> Either LedgerBytesError a -> Either LedgerBytesError b
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
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
P.toBuiltin) (Either LedgerBytesError ByteString
-> Either LedgerBytesError LedgerBytes)
-> (ByteString -> Either LedgerBytesError ByteString)
-> ByteString
-> Either LedgerBytesError LedgerBytes
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 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 LedgerBytesError 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')
| 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 LedgerBytesError 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)
| 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 LedgerBytesError 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)
| Bool
otherwise = LedgerBytesError -> Either LedgerBytesError Word8
forall a b. a -> Either a b
Left (LedgerBytesError -> Either LedgerBytesError Word8)
-> LedgerBytesError -> Either LedgerBytesError Word8
forall a b. (a -> b) -> a -> b
$ Char -> LedgerBytesError
NotHexit (Word8 -> Char
w2c Word8
x)
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'
Word8 -> Either LedgerBytesError Word8
forall a. a -> Either LedgerBytesError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Either LedgerBytesError Word8)
-> Word8 -> Either LedgerBytesError 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 LedgerBytesError [Word8]
asBytes :: [Word8] -> Either LedgerBytesError [Word8]
asBytes [] = [Word8] -> Either LedgerBytesError [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 LedgerBytesError Word8
-> Either LedgerBytesError ([Word8] -> [Word8])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> Word8 -> Either LedgerBytesError Word8
handlePair Word8
c Word8
c' Either LedgerBytesError ([Word8] -> [Word8])
-> Either LedgerBytesError [Word8]
-> Either LedgerBytesError [Word8]
forall a b.
Either LedgerBytesError (a -> b)
-> Either LedgerBytesError a -> Either LedgerBytesError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Word8] -> Either LedgerBytesError [Word8]
asBytes [Word8]
cs
asBytes [Word8]
_ = LedgerBytesError -> Either LedgerBytesError [Word8]
forall a b. a -> Either a b
Left LedgerBytesError
UnpairedDigit
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 = ([Word8] -> ByteString)
-> Either LedgerBytesError [Word8]
-> Either LedgerBytesError ByteString
forall a b.
(a -> b) -> Either LedgerBytesError a -> Either LedgerBytesError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack (Either LedgerBytesError [Word8]
-> Either LedgerBytesError ByteString)
-> (ByteString -> Either LedgerBytesError [Word8])
-> ByteString
-> Either LedgerBytesError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Either LedgerBytesError [Word8]
f ([Word8] -> Either LedgerBytesError [Word8])
-> (ByteString -> [Word8])
-> ByteString
-> Either LedgerBytesError [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
$c== :: LedgerBytes -> LedgerBytes -> Bool
== :: LedgerBytes -> LedgerBytes -> Bool
$c/= :: LedgerBytes -> LedgerBytes -> Bool
/= :: 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
$ccompare :: LedgerBytes -> LedgerBytes -> Ordering
compare :: LedgerBytes -> LedgerBytes -> Ordering
$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
>= :: LedgerBytes -> LedgerBytes -> Bool
$cmax :: LedgerBytes -> LedgerBytes -> LedgerBytes
max :: LedgerBytes -> LedgerBytes -> LedgerBytes
$cmin :: LedgerBytes -> LedgerBytes -> LedgerBytes
min :: LedgerBytes -> LedgerBytes -> 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
$cfrom :: forall x. LedgerBytes -> Rep LedgerBytes x
from :: forall x. LedgerBytes -> Rep LedgerBytes x
$cto :: forall x. Rep LedgerBytes x -> LedgerBytes
to :: forall x. Rep LedgerBytes x -> LedgerBytes
Generic, Typeable)
deriving newtype (LedgerBytes -> LedgerBytes -> Bool
(LedgerBytes -> LedgerBytes -> Bool) -> Eq LedgerBytes
forall a. (a -> a -> Bool) -> Eq a
$c== :: LedgerBytes -> LedgerBytes -> Bool
== :: 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
$ccompare :: LedgerBytes -> LedgerBytes -> Ordering
compare :: LedgerBytes -> LedgerBytes -> Ordering
$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
>= :: LedgerBytes -> LedgerBytes -> Bool
$cmax :: LedgerBytes -> LedgerBytes -> LedgerBytes
max :: LedgerBytes -> LedgerBytes -> LedgerBytes
$cmin :: LedgerBytes -> LedgerBytes -> LedgerBytes
min :: LedgerBytes -> LedgerBytes -> LedgerBytes
P.Ord, LedgerBytes -> BuiltinData
(LedgerBytes -> BuiltinData) -> ToData LedgerBytes
forall a. (a -> BuiltinData) -> ToData a
$ctoBuiltinData :: LedgerBytes -> BuiltinData
toBuiltinData :: LedgerBytes -> BuiltinData
PlutusTx.ToData, BuiltinData -> Maybe LedgerBytes
(BuiltinData -> Maybe LedgerBytes) -> FromData LedgerBytes
forall a. (BuiltinData -> Maybe a) -> FromData a
$cfromBuiltinData :: BuiltinData -> Maybe LedgerBytes
fromBuiltinData :: BuiltinData -> Maybe LedgerBytes
PlutusTx.FromData, BuiltinData -> LedgerBytes
(BuiltinData -> LedgerBytes) -> UnsafeFromData LedgerBytes
forall a. (BuiltinData -> a) -> UnsafeFromData a
$cunsafeFromBuiltinData :: BuiltinData -> LedgerBytes
unsafeFromBuiltinData :: BuiltinData -> LedgerBytes
PlutusTx.UnsafeFromData)
deriving anyclass (LedgerBytes -> ()
(LedgerBytes -> ()) -> NFData LedgerBytes
forall a. (a -> ()) -> NFData a
$crnf :: LedgerBytes -> ()
rnf :: LedgerBytes -> ()
NFData, DefinitionId
DefinitionId -> HasBlueprintDefinition LedgerBytes
forall t. DefinitionId -> HasBlueprintDefinition t
$cdefinitionId :: DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)
deriving (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
$cpretty :: forall ann. LedgerBytes -> Doc ann
pretty :: forall ann. LedgerBytes -> Doc ann
$cprettyList :: forall ann. [LedgerBytes] -> Doc ann
prettyList :: forall ann. [LedgerBytes] -> Doc ann
Pretty via (PrettyShow LedgerBytes)
instance HasBlueprintSchema LedgerBytes referencedTypes where
{-# INLINEABLE schema #-}
schema :: Schema referencedTypes
schema =
forall t (referencedTypes :: [*]).
HasBlueprintSchema t referencedTypes =>
Schema referencedTypes
schema @P.BuiltinByteString
Schema referencedTypes
-> (Schema referencedTypes -> Schema referencedTypes)
-> Schema referencedTypes
forall a b. a -> (a -> b) -> b
& (SchemaInfo -> SchemaInfo)
-> Schema referencedTypes -> Schema referencedTypes
forall (referencedTypes :: [*]).
(SchemaInfo -> SchemaInfo)
-> Schema referencedTypes -> Schema referencedTypes
withSchemaInfo \SchemaInfo
info -> SchemaInfo
info{title = Just "LedgerBytes"}
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
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
P.toBuiltin
bytes :: LedgerBytes -> BS.ByteString
bytes :: LedgerBytes -> ByteString
bytes = BuiltinByteString -> ByteString
BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
P.fromBuiltin (BuiltinByteString -> ByteString)
-> (LedgerBytes -> BuiltinByteString) -> LedgerBytes -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> BuiltinByteString
getLedgerBytes
instance IsString LedgerBytes where
fromString :: String -> LedgerBytes
fromString = Either LedgerBytesError LedgerBytes -> LedgerBytes
forall e a. Exception e => Either e a -> a
unsafeFromEither (Either LedgerBytesError LedgerBytes -> LedgerBytes)
-> (String -> Either LedgerBytesError LedgerBytes)
-> String
-> LedgerBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either LedgerBytesError LedgerBytes
fromHex (ByteString -> Either LedgerBytesError LedgerBytes)
-> (String -> ByteString)
-> String
-> Either LedgerBytesError 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)