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

import Codec.Serialise
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as JSON
import Data.Aeson.Extras qualified as JSON
import Data.ByteString qualified as BS
import Data.ByteString.Internal (c2w, w2c)
import Data.Either.Extras (unsafeFromEither)
import Data.String (IsString (..))
import Data.Text qualified as Text
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

-- | 'Bultins.SizedByteString 32' with various useful JSON and
--   servant instances for the Playground, and a convenient bridge
--   type for PureScript.
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 (Decoder s LedgerBytes
Decoder s [LedgerBytes]
[LedgerBytes] -> Encoding
LedgerBytes -> Encoding
(LedgerBytes -> Encoding)
-> (forall s. Decoder s LedgerBytes)
-> ([LedgerBytes] -> Encoding)
-> (forall s. Decoder s [LedgerBytes])
-> Serialise LedgerBytes
forall s. Decoder s [LedgerBytes]
forall s. Decoder s LedgerBytes
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [LedgerBytes]
$cdecodeList :: forall s. Decoder s [LedgerBytes]
encodeList :: [LedgerBytes] -> Encoding
$cencodeList :: [LedgerBytes] -> Encoding
decode :: Decoder s LedgerBytes
$cdecode :: forall s. Decoder s LedgerBytes
encode :: LedgerBytes -> Encoding
$cencode :: LedgerBytes -> Encoding
Serialise, 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 (ToJSONKeyFunction [LedgerBytes]
ToJSONKeyFunction LedgerBytes
ToJSONKeyFunction LedgerBytes
-> ToJSONKeyFunction [LedgerBytes] -> ToJSONKey LedgerBytes
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [LedgerBytes]
$ctoJSONKeyList :: ToJSONKeyFunction [LedgerBytes]
toJSONKey :: ToJSONKeyFunction LedgerBytes
$ctoJSONKey :: ToJSONKeyFunction LedgerBytes
JSON.ToJSONKey, FromJSONKeyFunction [LedgerBytes]
FromJSONKeyFunction LedgerBytes
FromJSONKeyFunction LedgerBytes
-> FromJSONKeyFunction [LedgerBytes] -> FromJSONKey LedgerBytes
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [LedgerBytes]
$cfromJSONKeyList :: FromJSONKeyFunction [LedgerBytes]
fromJSONKey :: FromJSONKeyFunction LedgerBytes
$cfromJSONKey :: FromJSONKeyFunction LedgerBytes
JSON.FromJSONKey, 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
JSON.encodeByteString (ByteString -> Text)
-> (LedgerBytes -> ByteString) -> LedgerBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> ByteString
bytes

instance ToJSON LedgerBytes where
    toJSON :: LedgerBytes -> Value
toJSON = Text -> Value
JSON.String (Text -> Value) -> (LedgerBytes -> Text) -> LedgerBytes -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
JSON.encodeByteString (ByteString -> Text)
-> (LedgerBytes -> ByteString) -> LedgerBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerBytes -> ByteString
bytes

instance FromJSON LedgerBytes where
    parseJSON :: Value -> Parser LedgerBytes
parseJSON Value
v = ByteString -> LedgerBytes
fromBytes (ByteString -> LedgerBytes)
-> Parser ByteString -> Parser LedgerBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ByteString
JSON.decodeByteString Value
v

makeLift ''LedgerBytes