{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ViewPatterns #-}

module PlutusLedgerApi.QuickCheck.Utils (
  SizedByteString (SizedByteString),
  unSizedByteString,
  AsWord64 (AsWord64),
  fromAsWord64,
) where

import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Coerce (coerce)
import Data.Proxy (Proxy (Proxy))
import Data.Word (Word64)
import GHC.TypeNats (KnownNat, Natural, natVal)
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  CoArbitrary,
  Function (function),
  functionMap,
  vectorOf,
 )
import Test.QuickCheck.Instances.ByteString ()

{- | Helper for 'ByteString's of a fixed length. We don't expose the
constructor, instead providing a read-only pattern, as well as an accessor
function, to ensure that the size invariant is maintained.

@since 1.0.0
-}
newtype SizedByteString (n :: Natural) = UnsafeSizedByteString ByteString
  deriving
    ( -- | @since 1.0.0
      SizedByteString n -> SizedByteString n -> Bool
(SizedByteString n -> SizedByteString n -> Bool)
-> (SizedByteString n -> SizedByteString n -> Bool)
-> Eq (SizedByteString n)
forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
== :: SizedByteString n -> SizedByteString n -> Bool
$c/= :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
/= :: SizedByteString n -> SizedByteString n -> Bool
Eq
    , -- | @since 1.0.0
      Eq (SizedByteString n)
Eq (SizedByteString n) =>
(SizedByteString n -> SizedByteString n -> Ordering)
-> (SizedByteString n -> SizedByteString n -> Bool)
-> (SizedByteString n -> SizedByteString n -> Bool)
-> (SizedByteString n -> SizedByteString n -> Bool)
-> (SizedByteString n -> SizedByteString n -> Bool)
-> (SizedByteString n -> SizedByteString n -> SizedByteString n)
-> (SizedByteString n -> SizedByteString n -> SizedByteString n)
-> Ord (SizedByteString n)
SizedByteString n -> SizedByteString n -> Bool
SizedByteString n -> SizedByteString n -> Ordering
SizedByteString n -> SizedByteString n -> SizedByteString n
forall (n :: Natural). Eq (SizedByteString n)
forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Ordering
forall (n :: Natural).
SizedByteString n -> SizedByteString n -> SizedByteString n
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 :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Ordering
compare :: SizedByteString n -> SizedByteString n -> Ordering
$c< :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
< :: SizedByteString n -> SizedByteString n -> Bool
$c<= :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
<= :: SizedByteString n -> SizedByteString n -> Bool
$c> :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
> :: SizedByteString n -> SizedByteString n -> Bool
$c>= :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> Bool
>= :: SizedByteString n -> SizedByteString n -> Bool
$cmax :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> SizedByteString n
max :: SizedByteString n -> SizedByteString n -> SizedByteString n
$cmin :: forall (n :: Natural).
SizedByteString n -> SizedByteString n -> SizedByteString n
min :: SizedByteString n -> SizedByteString n -> SizedByteString n
Ord
    )
    via ByteString
  deriving stock
    ( -- | @since 1.0.0
      Int -> SizedByteString n -> ShowS
[SizedByteString n] -> ShowS
SizedByteString n -> String
(Int -> SizedByteString n -> ShowS)
-> (SizedByteString n -> String)
-> ([SizedByteString n] -> ShowS)
-> Show (SizedByteString n)
forall (n :: Natural). Int -> SizedByteString n -> ShowS
forall (n :: Natural). [SizedByteString n] -> ShowS
forall (n :: Natural). SizedByteString n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (n :: Natural). Int -> SizedByteString n -> ShowS
showsPrec :: Int -> SizedByteString n -> ShowS
$cshow :: forall (n :: Natural). SizedByteString n -> String
show :: SizedByteString n -> String
$cshowList :: forall (n :: Natural). [SizedByteString n] -> ShowS
showList :: [SizedByteString n] -> ShowS
Show
    )

type role SizedByteString nominal

-- | @since 1.0.0
instance KnownNat n => Arbitrary (SizedByteString n) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (SizedByteString n)
arbitrary =
    ByteString -> SizedByteString n
forall (n :: Natural). ByteString -> SizedByteString n
UnsafeSizedByteString (ByteString -> SizedByteString n)
-> ([Word8] -> ByteString) -> [Word8] -> SizedByteString n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> SizedByteString n)
-> Gen [Word8] -> Gen (SizedByteString n)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      let !len :: Int
len = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> (Proxy n -> Natural) -> Proxy n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy n -> Natural
forall (n :: Natural) (proxy :: Natural -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy n -> Int) -> Proxy n -> Int
forall a b. (a -> b) -> a -> b
$ forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n
      Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
  {-# INLINEABLE shrink #-}
  shrink :: SizedByteString n -> [SizedByteString n]
shrink =
    ([Word8] -> SizedByteString n) -> [[Word8]] -> [SizedByteString n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> SizedByteString n
forall (n :: Natural). ByteString -> SizedByteString n
UnsafeSizedByteString (ByteString -> SizedByteString n)
-> ([Word8] -> ByteString) -> [Word8] -> SizedByteString n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack)
      ([[Word8]] -> [SizedByteString n])
-> (SizedByteString n -> [[Word8]])
-> SizedByteString n
-> [SizedByteString n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [Word8]) -> [Word8] -> [[Word8]]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Word8 -> [Word8]
forall a. Arbitrary a => a -> [a]
shrink
      ([Word8] -> [[Word8]])
-> (SizedByteString n -> [Word8]) -> SizedByteString n -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
      (ByteString -> [Word8])
-> (SizedByteString n -> ByteString)
-> SizedByteString n
-> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteString n -> ByteString
forall (n :: Natural). SizedByteString n -> ByteString
unSizedByteString

-- | @since 1.0.0
deriving via ByteString instance CoArbitrary (SizedByteString n)

-- | @since 1.0.0
instance Function (SizedByteString n) where
  {-# INLINEABLE function #-}
  function :: forall b. (SizedByteString n -> b) -> SizedByteString n :-> b
function = (SizedByteString n -> ByteString)
-> (ByteString -> SizedByteString n)
-> (SizedByteString n -> b)
-> SizedByteString n :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap SizedByteString n -> ByteString
forall a b. Coercible a b => a -> b
coerce ByteString -> SizedByteString n
forall (n :: Natural). ByteString -> SizedByteString n
UnsafeSizedByteString

{- | Read-only pattern for accessing the underlying 'ByteString'. Use it just
like you would use a data constructor in a pattern match.

@since 1.0.0
-}
pattern SizedByteString :: forall (n :: Natural). ByteString -> SizedByteString n
pattern $mSizedByteString :: forall {r} {n :: Natural}.
SizedByteString n -> (ByteString -> r) -> ((# #) -> r) -> r
SizedByteString bs <- UnsafeSizedByteString bs

{-# COMPLETE SizedByteString #-}

{- | Get the underlying 'ByteString'. It is guaranteed to have the length
specified in its type.

@since 1.0.0
-}
unSizedByteString ::
  forall (n :: Natural).
  SizedByteString n ->
  ByteString
unSizedByteString :: forall (n :: Natural). SizedByteString n -> ByteString
unSizedByteString = SizedByteString n -> ByteString
forall a b. Coercible a b => a -> b
coerce

{- | Plutus' ledger API often has to \'fake\' 'Word64' using the much larger
'Integer' type. This helper is designed to generate 'Integer's that fit into
'Word64'.

We don't expose the constructor directly; instead, we provide a read-only
pattern and an accessor function.

@since 1.0.0
-}
newtype AsWord64 = UnsafeAsWord64 Word64
  deriving
    ( -- | @since 1.0.0
      AsWord64 -> AsWord64 -> Bool
(AsWord64 -> AsWord64 -> Bool)
-> (AsWord64 -> AsWord64 -> Bool) -> Eq AsWord64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AsWord64 -> AsWord64 -> Bool
== :: AsWord64 -> AsWord64 -> Bool
$c/= :: AsWord64 -> AsWord64 -> Bool
/= :: AsWord64 -> AsWord64 -> Bool
Eq
    , -- | @since 1.0.0
      Eq AsWord64
Eq AsWord64 =>
(AsWord64 -> AsWord64 -> Ordering)
-> (AsWord64 -> AsWord64 -> Bool)
-> (AsWord64 -> AsWord64 -> Bool)
-> (AsWord64 -> AsWord64 -> Bool)
-> (AsWord64 -> AsWord64 -> Bool)
-> (AsWord64 -> AsWord64 -> AsWord64)
-> (AsWord64 -> AsWord64 -> AsWord64)
-> Ord AsWord64
AsWord64 -> AsWord64 -> Bool
AsWord64 -> AsWord64 -> Ordering
AsWord64 -> AsWord64 -> AsWord64
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 :: AsWord64 -> AsWord64 -> Ordering
compare :: AsWord64 -> AsWord64 -> Ordering
$c< :: AsWord64 -> AsWord64 -> Bool
< :: AsWord64 -> AsWord64 -> Bool
$c<= :: AsWord64 -> AsWord64 -> Bool
<= :: AsWord64 -> AsWord64 -> Bool
$c> :: AsWord64 -> AsWord64 -> Bool
> :: AsWord64 -> AsWord64 -> Bool
$c>= :: AsWord64 -> AsWord64 -> Bool
>= :: AsWord64 -> AsWord64 -> Bool
$cmax :: AsWord64 -> AsWord64 -> AsWord64
max :: AsWord64 -> AsWord64 -> AsWord64
$cmin :: AsWord64 -> AsWord64 -> AsWord64
min :: AsWord64 -> AsWord64 -> AsWord64
Ord
    , -- | @since 1.0.0
      Gen AsWord64
Gen AsWord64 -> (AsWord64 -> [AsWord64]) -> Arbitrary AsWord64
AsWord64 -> [AsWord64]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen AsWord64
arbitrary :: Gen AsWord64
$cshrink :: AsWord64 -> [AsWord64]
shrink :: AsWord64 -> [AsWord64]
Arbitrary
    , -- | @since 1.0.0
      (forall b. AsWord64 -> Gen b -> Gen b) -> CoArbitrary AsWord64
forall b. AsWord64 -> Gen b -> Gen b
forall a. (forall b. a -> Gen b -> Gen b) -> CoArbitrary a
$ccoarbitrary :: forall b. AsWord64 -> Gen b -> Gen b
coarbitrary :: forall b. AsWord64 -> Gen b -> Gen b
CoArbitrary
    )
    via Word64
  deriving stock
    ( -- | @since 1.0.0
      Int -> AsWord64 -> ShowS
[AsWord64] -> ShowS
AsWord64 -> String
(Int -> AsWord64 -> ShowS)
-> (AsWord64 -> String) -> ([AsWord64] -> ShowS) -> Show AsWord64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AsWord64 -> ShowS
showsPrec :: Int -> AsWord64 -> ShowS
$cshow :: AsWord64 -> String
show :: AsWord64 -> String
$cshowList :: [AsWord64] -> ShowS
showList :: [AsWord64] -> ShowS
Show
    )

-- | @since 1.0.0
instance Function AsWord64 where
  {-# INLINEABLE function #-}
  function :: forall b. (AsWord64 -> b) -> AsWord64 :-> b
function = (AsWord64 -> Word64)
-> (Word64 -> AsWord64) -> (AsWord64 -> b) -> AsWord64 :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap AsWord64 -> Word64
forall a b. Coercible a b => a -> b
coerce Word64 -> AsWord64
UnsafeAsWord64

{- | Read-only pattern for accessing the underlying 'Integer'. Use it just like
you would use a data constructor in a pattern match.

@since 1.0.0
-}
pattern AsWord64 :: Integer -> AsWord64
pattern $mAsWord64 :: forall {r}. AsWord64 -> (Integer -> r) -> ((# #) -> r) -> r
AsWord64 i <- (fromAsWord64 -> i)

-- | @since 1.0.0
fromAsWord64 :: AsWord64 -> Integer
fromAsWord64 :: AsWord64 -> Integer
fromAsWord64 = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> (AsWord64 -> Word64) -> AsWord64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @Word64