{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE TypeFamilies               #-}
{- HLINT ignore "Redundant <$>" -}

module Database.LSMTree.Extras.UTxO (
    UTxOKey (..)
  , UTxOValue (..)
  , zeroUTxOValue
  , UTxOBlob (..)
  ) where

import           Control.DeepSeq
import           Data.Bits
import qualified Data.ByteString as BS
import qualified Data.Primitive as P
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import           Data.WideWord.Word128
import           Data.WideWord.Word256
import           Data.Word
import           Database.LSMTree.Extras.Orphans
import           Database.LSMTree.Internal.Primitive
import qualified Database.LSMTree.Internal.RawBytes as RB
import           Database.LSMTree.Internal.Serialise ()
import           Database.LSMTree.Internal.Serialise.Class as Class
import           Database.LSMTree.Internal.Vector
import           GHC.Generics
import           System.Random
import           Test.QuickCheck hiding ((.&.))

{-------------------------------------------------------------------------------
  UTxO keys
-------------------------------------------------------------------------------}

-- | A model of a UTxO key (34 bytes) after @TxIn@: a 256-bit hash, 16-bit identifier
data UTxOKey = UTxOKey {
    UTxOKey -> Word256
txId :: !Word256 -- no unpack, since the @TxId@ field doesn't have it
  , UTxOKey -> Word16
txIx :: {-# UNPACK #-} !Word16
  }
  deriving stock (Int -> UTxOKey -> ShowS
[UTxOKey] -> ShowS
UTxOKey -> String
(Int -> UTxOKey -> ShowS)
-> (UTxOKey -> String) -> ([UTxOKey] -> ShowS) -> Show UTxOKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTxOKey -> ShowS
showsPrec :: Int -> UTxOKey -> ShowS
$cshow :: UTxOKey -> String
show :: UTxOKey -> String
$cshowList :: [UTxOKey] -> ShowS
showList :: [UTxOKey] -> ShowS
Show, UTxOKey -> UTxOKey -> Bool
(UTxOKey -> UTxOKey -> Bool)
-> (UTxOKey -> UTxOKey -> Bool) -> Eq UTxOKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTxOKey -> UTxOKey -> Bool
== :: UTxOKey -> UTxOKey -> Bool
$c/= :: UTxOKey -> UTxOKey -> Bool
/= :: UTxOKey -> UTxOKey -> Bool
Eq, Eq UTxOKey
Eq UTxOKey =>
(UTxOKey -> UTxOKey -> Ordering)
-> (UTxOKey -> UTxOKey -> Bool)
-> (UTxOKey -> UTxOKey -> Bool)
-> (UTxOKey -> UTxOKey -> Bool)
-> (UTxOKey -> UTxOKey -> Bool)
-> (UTxOKey -> UTxOKey -> UTxOKey)
-> (UTxOKey -> UTxOKey -> UTxOKey)
-> Ord UTxOKey
UTxOKey -> UTxOKey -> Bool
UTxOKey -> UTxOKey -> Ordering
UTxOKey -> UTxOKey -> UTxOKey
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 :: UTxOKey -> UTxOKey -> Ordering
compare :: UTxOKey -> UTxOKey -> Ordering
$c< :: UTxOKey -> UTxOKey -> Bool
< :: UTxOKey -> UTxOKey -> Bool
$c<= :: UTxOKey -> UTxOKey -> Bool
<= :: UTxOKey -> UTxOKey -> Bool
$c> :: UTxOKey -> UTxOKey -> Bool
> :: UTxOKey -> UTxOKey -> Bool
$c>= :: UTxOKey -> UTxOKey -> Bool
>= :: UTxOKey -> UTxOKey -> Bool
$cmax :: UTxOKey -> UTxOKey -> UTxOKey
max :: UTxOKey -> UTxOKey -> UTxOKey
$cmin :: UTxOKey -> UTxOKey -> UTxOKey
min :: UTxOKey -> UTxOKey -> UTxOKey
Ord, (forall x. UTxOKey -> Rep UTxOKey x)
-> (forall x. Rep UTxOKey x -> UTxOKey) -> Generic UTxOKey
forall x. Rep UTxOKey x -> UTxOKey
forall x. UTxOKey -> Rep UTxOKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UTxOKey -> Rep UTxOKey x
from :: forall x. UTxOKey -> Rep UTxOKey x
$cto :: forall x. Rep UTxOKey x -> UTxOKey
to :: forall x. Rep UTxOKey x -> UTxOKey
Generic)
  deriving anyclass ((forall g (m :: * -> *). StatefulGen g m => g -> m UTxOKey)
-> Uniform UTxOKey
forall a.
(forall g (m :: * -> *). StatefulGen g m => g -> m a) -> Uniform a
forall g (m :: * -> *). StatefulGen g m => g -> m UTxOKey
$cuniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m UTxOKey
uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m UTxOKey
Uniform, UTxOKey -> ()
(UTxOKey -> ()) -> NFData UTxOKey
forall a. (a -> ()) -> NFData a
$crnf :: UTxOKey -> ()
rnf :: UTxOKey -> ()
NFData)

-- TODO: reduce number of allocations, optimise (by using unsafe functions)
instance SerialiseKey UTxOKey where
  serialiseKey :: UTxOKey -> RawBytes
serialiseKey UTxOKey{Word256
txId :: UTxOKey -> Word256
txId :: Word256
txId, Word16
txIx :: UTxOKey -> Word16
txIx :: Word16
txIx} =
    Vector Word8 -> RawBytes
RB.RawBytes (Vector Word8 -> RawBytes) -> Vector Word8 -> RawBytes
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Word8
forall a. Prim a => Int -> Int -> ByteArray -> Vector a
mkPrimVector Int
0 Int
34 (ByteArray -> Vector Word8) -> ByteArray -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
P.runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newByteArray Int
34
      let !cut :: Word16
cut = Word256 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word256
txId Word256 -> Word256 -> Word256
forall a. Bits a => a -> a -> a
.&. (Word16 -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
0xffff :: Word16) Word256 -> Int -> Word256
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
192)) Word256 -> Int -> Word256
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
192)
      MutableByteArray (PrimState (ST s)) -> Int -> Word256 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0  (Word256 -> ST s ()) -> Word256 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word256 -> Word256
byteSwapWord256 Word256
txId
      MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
3  (Word16 -> ST s ()) -> Word16 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16
byteSwap16 Word16
txIx
      MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
16 (Word16 -> ST s ()) -> Word16 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16
byteSwap16 Word16
cut
      MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
ba
  deserialiseKey :: RawBytes -> UTxOKey
deserialiseKey (RawBytes (VP.Vector Int
off Int
len ByteArray
ba)) =
    String -> Int -> Int -> UTxOKey -> UTxOKey
forall a. String -> Int -> Int -> a -> a
requireBytesExactly String
"UTxOKey" Int
34 Int
len (UTxOKey -> UTxOKey) -> UTxOKey -> UTxOKey
forall a b. (a -> b) -> a -> b
$
      let !cut :: Word16
cut   = Word16 -> Word16
byteSwap16      (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Word16
indexWord8ArrayAsWord16  ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32)
          !txIx :: Word16
txIx  = Word16 -> Word16
byteSwap16      (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Word16
indexWord8ArrayAsWord16  ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
          !txId_ :: Word256
txId_ = Word256 -> Word256
byteSwapWord256 (Word256 -> Word256) -> Word256 -> Word256
forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Word256
indexWord8ArrayAsWord256 ByteArray
ba Int
off
          !txId :: Word256
txId  = (Word256
txId_ Word256 -> Word256 -> Word256
forall a. Bits a => a -> a -> a
.&. (Word256 -> Word256
forall a. Bits a => a -> a
complement (Word16 -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
0xffff :: Word16) Word256 -> Int -> Word256
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
192)))
                      Word256 -> Word256 -> Word256
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
cut Word256 -> Int -> Word256
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
192)
      in UTxOKey{Word256
txId :: Word256
txId :: Word256
txId, Word16
txIx :: Word16
txIx :: Word16
txIx}

instance Arbitrary UTxOKey where
  arbitrary :: Gen UTxOKey
arbitrary = Word256 -> Word16 -> UTxOKey
UTxOKey (Word256 -> Word16 -> UTxOKey)
-> Gen Word256 -> Gen (Word16 -> UTxOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word256
forall a. Arbitrary a => Gen a
arbitrary Gen (Word16 -> UTxOKey) -> Gen Word16 -> Gen UTxOKey
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word16
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: UTxOKey -> [UTxOKey]
shrink (UTxOKey Word256
a Word16
b) = [ Word256 -> Word16 -> UTxOKey
UTxOKey Word256
a' Word16
b' | (Word256
a', Word16
b') <- (Word256, Word16) -> [(Word256, Word16)]
forall a. Arbitrary a => a -> [a]
shrink (Word256
a, Word16
b) ]

newtype instance VUM.MVector s UTxOKey = MV_UTxOKey (VU.MVector s (Word256, Word16))
newtype instance VU.Vector     UTxOKey = V_UTxOKey  (VU.Vector    (Word256, Word16))

instance VU.IsoUnbox UTxOKey (Word256, Word16) where
  toURepr :: UTxOKey -> (Word256, Word16)
toURepr (UTxOKey Word256
a Word16
b) = (Word256
a, Word16
b)
  fromURepr :: (Word256, Word16) -> UTxOKey
fromURepr (Word256
a, Word16
b) = Word256 -> Word16 -> UTxOKey
UTxOKey Word256
a Word16
b
  {-# INLINE toURepr #-}
  {-# INLINE fromURepr #-}

deriving via VU.As UTxOKey (Word256, Word16) instance VGM.MVector VU.MVector UTxOKey
deriving via VU.As UTxOKey (Word256, Word16) instance VG.Vector   VU.Vector  UTxOKey

instance VUM.Unbox UTxOKey

{-------------------------------------------------------------------------------
  UTxO values
-------------------------------------------------------------------------------}

-- | A model of a UTxO value (60 bytes)
data UTxOValue = UTxOValue {
    UTxOValue -> Word256
utxoValue256 :: !Word256
  , UTxOValue -> Word128
utxoValue128 :: !Word128
  , UTxOValue -> Word64
utxoValue64  :: !Word64
  , UTxOValue -> Word32
utxoValue32  :: !Word32
  }
  deriving stock (Int -> UTxOValue -> ShowS
[UTxOValue] -> ShowS
UTxOValue -> String
(Int -> UTxOValue -> ShowS)
-> (UTxOValue -> String)
-> ([UTxOValue] -> ShowS)
-> Show UTxOValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTxOValue -> ShowS
showsPrec :: Int -> UTxOValue -> ShowS
$cshow :: UTxOValue -> String
show :: UTxOValue -> String
$cshowList :: [UTxOValue] -> ShowS
showList :: [UTxOValue] -> ShowS
Show, UTxOValue -> UTxOValue -> Bool
(UTxOValue -> UTxOValue -> Bool)
-> (UTxOValue -> UTxOValue -> Bool) -> Eq UTxOValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTxOValue -> UTxOValue -> Bool
== :: UTxOValue -> UTxOValue -> Bool
$c/= :: UTxOValue -> UTxOValue -> Bool
/= :: UTxOValue -> UTxOValue -> Bool
Eq, Eq UTxOValue
Eq UTxOValue =>
(UTxOValue -> UTxOValue -> Ordering)
-> (UTxOValue -> UTxOValue -> Bool)
-> (UTxOValue -> UTxOValue -> Bool)
-> (UTxOValue -> UTxOValue -> Bool)
-> (UTxOValue -> UTxOValue -> Bool)
-> (UTxOValue -> UTxOValue -> UTxOValue)
-> (UTxOValue -> UTxOValue -> UTxOValue)
-> Ord UTxOValue
UTxOValue -> UTxOValue -> Bool
UTxOValue -> UTxOValue -> Ordering
UTxOValue -> UTxOValue -> UTxOValue
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 :: UTxOValue -> UTxOValue -> Ordering
compare :: UTxOValue -> UTxOValue -> Ordering
$c< :: UTxOValue -> UTxOValue -> Bool
< :: UTxOValue -> UTxOValue -> Bool
$c<= :: UTxOValue -> UTxOValue -> Bool
<= :: UTxOValue -> UTxOValue -> Bool
$c> :: UTxOValue -> UTxOValue -> Bool
> :: UTxOValue -> UTxOValue -> Bool
$c>= :: UTxOValue -> UTxOValue -> Bool
>= :: UTxOValue -> UTxOValue -> Bool
$cmax :: UTxOValue -> UTxOValue -> UTxOValue
max :: UTxOValue -> UTxOValue -> UTxOValue
$cmin :: UTxOValue -> UTxOValue -> UTxOValue
min :: UTxOValue -> UTxOValue -> UTxOValue
Ord, (forall x. UTxOValue -> Rep UTxOValue x)
-> (forall x. Rep UTxOValue x -> UTxOValue) -> Generic UTxOValue
forall x. Rep UTxOValue x -> UTxOValue
forall x. UTxOValue -> Rep UTxOValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UTxOValue -> Rep UTxOValue x
from :: forall x. UTxOValue -> Rep UTxOValue x
$cto :: forall x. Rep UTxOValue x -> UTxOValue
to :: forall x. Rep UTxOValue x -> UTxOValue
Generic)
  deriving anyclass ((forall g (m :: * -> *). StatefulGen g m => g -> m UTxOValue)
-> Uniform UTxOValue
forall a.
(forall g (m :: * -> *). StatefulGen g m => g -> m a) -> Uniform a
forall g (m :: * -> *). StatefulGen g m => g -> m UTxOValue
$cuniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m UTxOValue
uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m UTxOValue
Uniform, UTxOValue -> ()
(UTxOValue -> ()) -> NFData UTxOValue
forall a. (a -> ()) -> NFData a
$crnf :: UTxOValue -> ()
rnf :: UTxOValue -> ()
NFData)

instance SerialiseValue UTxOValue where
  serialiseValue :: UTxOValue -> RawBytes
serialiseValue (UTxOValue {Word256
utxoValue256 :: UTxOValue -> Word256
utxoValue256 :: Word256
utxoValue256, Word128
utxoValue128 :: UTxOValue -> Word128
utxoValue128 :: Word128
utxoValue128, Word64
utxoValue64 :: UTxOValue -> Word64
utxoValue64 :: Word64
utxoValue64, Word32
utxoValue32 :: UTxOValue -> Word32
utxoValue32 :: Word32
utxoValue32}) =
    Vector Word8 -> RawBytes
RB.RawBytes (Vector Word8 -> RawBytes) -> Vector Word8 -> RawBytes
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Word8
forall a. Prim a => Int -> Int -> ByteArray -> Vector a
mkPrimVector Int
0 Int
60 (ByteArray -> Vector Word8) -> ByteArray -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
P.runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newByteArray Int
60
      MutableByteArray (PrimState (ST s)) -> Int -> Word256 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0 Word256
utxoValue256
      MutableByteArray (PrimState (ST s)) -> Int -> Word128 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
2 Word128
utxoValue128
      MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
6 Word64
utxoValue64
      MutableByteArray (PrimState (ST s)) -> Int -> Word32 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
14 Word32
utxoValue32
      MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
ba
  deserialiseValue :: RawBytes -> UTxOValue
deserialiseValue (RawBytes (VP.Vector Int
off Int
len ByteArray
ba)) =
    String -> Int -> Int -> UTxOValue -> UTxOValue
forall a. String -> Int -> Int -> a -> a
requireBytesExactly String
"UTxOValue" Int
60 Int
len (UTxOValue -> UTxOValue) -> UTxOValue -> UTxOValue
forall a b. (a -> b) -> a -> b
$
      Word256 -> Word128 -> Word64 -> Word32 -> UTxOValue
UTxOValue (ByteArray -> Int -> Word256
indexWord8ArrayAsWord256 ByteArray
ba Int
off)
                (ByteArray -> Int -> Word128
indexWord8ArrayAsWord128 ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32))
                (ByteArray -> Int -> Word64
indexWord8ArrayAsWord64  ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48))
                (ByteArray -> Int -> Word32
indexWord8ArrayAsWord32  ByteArray
ba (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
56))

instance Arbitrary UTxOValue where
  arbitrary :: Gen UTxOValue
arbitrary = Word256 -> Word128 -> Word64 -> Word32 -> UTxOValue
UTxOValue (Word256 -> Word128 -> Word64 -> Word32 -> UTxOValue)
-> Gen Word256 -> Gen (Word128 -> Word64 -> Word32 -> UTxOValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word256
forall a. Arbitrary a => Gen a
arbitrary Gen (Word128 -> Word64 -> Word32 -> UTxOValue)
-> Gen Word128 -> Gen (Word64 -> Word32 -> UTxOValue)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word128
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> Word32 -> UTxOValue)
-> Gen Word64 -> Gen (Word32 -> UTxOValue)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (Word32 -> UTxOValue) -> Gen Word32 -> Gen UTxOValue
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: UTxOValue -> [UTxOValue]
shrink (UTxOValue Word256
a Word128
b Word64
c Word32
d) = [ Word256 -> Word128 -> Word64 -> Word32 -> UTxOValue
UTxOValue Word256
a' Word128
b' Word64
c' Word32
d'
                               | (Word256
a', Word128
b', Word64
c', Word32
d') <- (Word256, Word128, Word64, Word32)
-> [(Word256, Word128, Word64, Word32)]
forall a. Arbitrary a => a -> [a]
shrink (Word256
a, Word128
b, Word64
c, Word32
d) ]

newtype instance VUM.MVector s UTxOValue = MV_UTxOValue (VU.MVector s (Word256, Word128, Word64, Word32))
newtype instance VU.Vector     UTxOValue = V_UTxOValue  (VU.Vector    (Word256, Word128, Word64, Word32))

instance VU.IsoUnbox UTxOValue (Word256, Word128, Word64, Word32) where
  toURepr :: UTxOValue -> (Word256, Word128, Word64, Word32)
toURepr (UTxOValue Word256
a Word128
b Word64
c Word32
d) = (Word256
a, Word128
b, Word64
c, Word32
d)
  fromURepr :: (Word256, Word128, Word64, Word32) -> UTxOValue
fromURepr (Word256
a, Word128
b, Word64
c, Word32
d) = Word256 -> Word128 -> Word64 -> Word32 -> UTxOValue
UTxOValue Word256
a Word128
b Word64
c Word32
d
  {-# INLINE toURepr #-}
  {-# INLINE fromURepr #-}

deriving via VU.As UTxOValue (Word256, Word128, Word64, Word32) instance VGM.MVector VU.MVector UTxOValue
deriving via VU.As UTxOValue (Word256, Word128, Word64, Word32) instance VG.Vector   VU.Vector  UTxOValue

instance VUM.Unbox UTxOValue

zeroUTxOValue :: UTxOValue
zeroUTxOValue :: UTxOValue
zeroUTxOValue = Word256 -> Word128 -> Word64 -> Word32 -> UTxOValue
UTxOValue Word256
0 Word128
0 Word64
0 Word32
0

{-------------------------------------------------------------------------------
  UTxO blobs
-------------------------------------------------------------------------------}

-- | A blob of arbitrary size
newtype UTxOBlob = UTxOBlob BS.ByteString
  deriving stock (Int -> UTxOBlob -> ShowS
[UTxOBlob] -> ShowS
UTxOBlob -> String
(Int -> UTxOBlob -> ShowS)
-> (UTxOBlob -> String) -> ([UTxOBlob] -> ShowS) -> Show UTxOBlob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTxOBlob -> ShowS
showsPrec :: Int -> UTxOBlob -> ShowS
$cshow :: UTxOBlob -> String
show :: UTxOBlob -> String
$cshowList :: [UTxOBlob] -> ShowS
showList :: [UTxOBlob] -> ShowS
Show, UTxOBlob -> UTxOBlob -> Bool
(UTxOBlob -> UTxOBlob -> Bool)
-> (UTxOBlob -> UTxOBlob -> Bool) -> Eq UTxOBlob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTxOBlob -> UTxOBlob -> Bool
== :: UTxOBlob -> UTxOBlob -> Bool
$c/= :: UTxOBlob -> UTxOBlob -> Bool
/= :: UTxOBlob -> UTxOBlob -> Bool
Eq, Eq UTxOBlob
Eq UTxOBlob =>
(UTxOBlob -> UTxOBlob -> Ordering)
-> (UTxOBlob -> UTxOBlob -> Bool)
-> (UTxOBlob -> UTxOBlob -> Bool)
-> (UTxOBlob -> UTxOBlob -> Bool)
-> (UTxOBlob -> UTxOBlob -> Bool)
-> (UTxOBlob -> UTxOBlob -> UTxOBlob)
-> (UTxOBlob -> UTxOBlob -> UTxOBlob)
-> Ord UTxOBlob
UTxOBlob -> UTxOBlob -> Bool
UTxOBlob -> UTxOBlob -> Ordering
UTxOBlob -> UTxOBlob -> UTxOBlob
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 :: UTxOBlob -> UTxOBlob -> Ordering
compare :: UTxOBlob -> UTxOBlob -> Ordering
$c< :: UTxOBlob -> UTxOBlob -> Bool
< :: UTxOBlob -> UTxOBlob -> Bool
$c<= :: UTxOBlob -> UTxOBlob -> Bool
<= :: UTxOBlob -> UTxOBlob -> Bool
$c> :: UTxOBlob -> UTxOBlob -> Bool
> :: UTxOBlob -> UTxOBlob -> Bool
$c>= :: UTxOBlob -> UTxOBlob -> Bool
>= :: UTxOBlob -> UTxOBlob -> Bool
$cmax :: UTxOBlob -> UTxOBlob -> UTxOBlob
max :: UTxOBlob -> UTxOBlob -> UTxOBlob
$cmin :: UTxOBlob -> UTxOBlob -> UTxOBlob
min :: UTxOBlob -> UTxOBlob -> UTxOBlob
Ord, (forall x. UTxOBlob -> Rep UTxOBlob x)
-> (forall x. Rep UTxOBlob x -> UTxOBlob) -> Generic UTxOBlob
forall x. Rep UTxOBlob x -> UTxOBlob
forall x. UTxOBlob -> Rep UTxOBlob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UTxOBlob -> Rep UTxOBlob x
from :: forall x. UTxOBlob -> Rep UTxOBlob x
$cto :: forall x. Rep UTxOBlob x -> UTxOBlob
to :: forall x. Rep UTxOBlob x -> UTxOBlob
Generic)
  deriving anyclass UTxOBlob -> ()
(UTxOBlob -> ()) -> NFData UTxOBlob
forall a. (a -> ()) -> NFData a
$crnf :: UTxOBlob -> ()
rnf :: UTxOBlob -> ()
NFData

instance SerialiseValue UTxOBlob where
  serialiseValue :: UTxOBlob -> RawBytes
serialiseValue (UTxOBlob ByteString
bs) = ByteString -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
Class.serialiseValue ByteString
bs
  deserialiseValue :: RawBytes -> UTxOBlob
deserialiseValue = String -> RawBytes -> UTxOBlob
forall a. HasCallStack => String -> a
error String
"deserialiseValue: UTxOBlob"