{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusLedgerApi.V1.Orphans.Credential () where

import PlutusLedgerApi.QuickCheck.Utils (fromAsWord64)
import PlutusLedgerApi.V1 qualified as PLA
import PlutusLedgerApi.V1.Orphans.Crypto ()
import PlutusLedgerApi.V1.Orphans.Scripts ()
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  CoArbitrary (coarbitrary),
  Function (function),
  NonNegative (NonNegative),
  functionMap,
  oneof,
  variant,
 )

{- | As 'PLA.Credential' is just a wrapper around a hash with a tag, shrinking
this type doesn't make much sense. Therefore we don't do it.

@since 1.0.0
-}
instance Arbitrary PLA.Credential where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Credential
arbitrary =
    [Gen Credential] -> Gen Credential
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ PubKeyHash -> Credential
PLA.PubKeyCredential (PubKeyHash -> Credential) -> Gen PubKeyHash -> Gen Credential
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PubKeyHash
forall a. Arbitrary a => Gen a
arbitrary
      , ScriptHash -> Credential
PLA.ScriptCredential (ScriptHash -> Credential) -> Gen ScriptHash -> Gen Credential
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ScriptHash
forall a. Arbitrary a => Gen a
arbitrary
      ]

-- | @since 1.0.0
instance CoArbitrary PLA.Credential where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Credential -> Gen b -> Gen b
coarbitrary = \case
    PLA.PubKeyCredential PubKeyHash
pkh -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
0 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyHash -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. PubKeyHash -> Gen b -> Gen b
coarbitrary PubKeyHash
pkh
    PLA.ScriptCredential ScriptHash
sh -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
1 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. ScriptHash -> Gen b -> Gen b
coarbitrary ScriptHash
sh

-- | @since 1.0.0
instance Function PLA.Credential where
  {-# INLINEABLE function #-}
  function :: forall b. (Credential -> b) -> Credential :-> b
function = (Credential -> Either PubKeyHash ScriptHash)
-> (Either PubKeyHash ScriptHash -> Credential)
-> (Credential -> b)
-> Credential :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Credential -> Either PubKeyHash ScriptHash
into Either PubKeyHash ScriptHash -> Credential
outOf
    where
      into :: PLA.Credential -> Either PLA.PubKeyHash PLA.ScriptHash
      into :: Credential -> Either PubKeyHash ScriptHash
into = \case
        PLA.PubKeyCredential PubKeyHash
pkh -> PubKeyHash -> Either PubKeyHash ScriptHash
forall a b. a -> Either a b
Left PubKeyHash
pkh
        PLA.ScriptCredential ScriptHash
sh -> ScriptHash -> Either PubKeyHash ScriptHash
forall a b. b -> Either a b
Right ScriptHash
sh
      outOf :: Either PLA.PubKeyHash PLA.ScriptHash -> PLA.Credential
      outOf :: Either PubKeyHash ScriptHash -> Credential
outOf = \case
        Left PubKeyHash
pkh -> PubKeyHash -> Credential
PLA.PubKeyCredential PubKeyHash
pkh
        Right ScriptHash
sh -> ScriptHash -> Credential
PLA.ScriptCredential ScriptHash
sh

-- | @since 1.0.0
instance Arbitrary PLA.StakingCredential where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen StakingCredential
arbitrary =
    [Gen StakingCredential] -> Gen StakingCredential
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Credential -> StakingCredential
PLA.StakingHash (Credential -> StakingCredential)
-> Gen Credential -> Gen StakingCredential
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Credential
forall a. Arbitrary a => Gen a
arbitrary
      , Integer -> Integer -> Integer -> StakingCredential
PLA.StakingPtr (Integer -> Integer -> Integer -> StakingCredential)
-> (AsWord64 -> Integer)
-> AsWord64
-> Integer
-> Integer
-> StakingCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsWord64 -> Integer
fromAsWord64
          (AsWord64 -> Integer -> Integer -> StakingCredential)
-> Gen AsWord64 -> Gen (Integer -> Integer -> StakingCredential)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AsWord64
forall a. Arbitrary a => Gen a
arbitrary
          Gen (Integer -> Integer -> StakingCredential)
-> Gen Integer -> Gen (Integer -> StakingCredential)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (AsWord64 -> Integer
fromAsWord64 (AsWord64 -> Integer) -> Gen AsWord64 -> Gen Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AsWord64
forall a. Arbitrary a => Gen a
arbitrary)
          Gen (Integer -> StakingCredential)
-> Gen Integer -> Gen StakingCredential
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (AsWord64 -> Integer
fromAsWord64 (AsWord64 -> Integer) -> Gen AsWord64 -> Gen Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AsWord64
forall a. Arbitrary a => Gen a
arbitrary)
      ]
  {-# INLINEABLE shrink #-}
  shrink :: StakingCredential -> [StakingCredential]
shrink = \case
    -- Since Credentials don't shrink, we don't shrink this case
    PLA.StakingHash Credential
_ -> []
    PLA.StakingPtr Integer
i Integer
j Integer
k -> do
      NonNegative Integer
i' <- NonNegative Integer -> [NonNegative Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> NonNegative Integer
forall a. a -> NonNegative a
NonNegative Integer
i)
      NonNegative Integer
j' <- NonNegative Integer -> [NonNegative Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> NonNegative Integer
forall a. a -> NonNegative a
NonNegative Integer
j)
      NonNegative Integer
k' <- NonNegative Integer -> [NonNegative Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> NonNegative Integer
forall a. a -> NonNegative a
NonNegative Integer
k)
      StakingCredential -> [StakingCredential]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (StakingCredential -> [StakingCredential])
-> (Integer -> StakingCredential) -> Integer -> [StakingCredential]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer -> StakingCredential
PLA.StakingPtr Integer
i' Integer
j' (Integer -> [StakingCredential]) -> Integer -> [StakingCredential]
forall a b. (a -> b) -> a -> b
$ Integer
k'

-- | @since 1.0.0
instance CoArbitrary PLA.StakingCredential where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. StakingCredential -> Gen b -> Gen b
coarbitrary = \case
    PLA.StakingHash Credential
cred -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
0 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Credential -> Gen b -> Gen b
coarbitrary Credential
cred
    PLA.StakingPtr Integer
i Integer
j Integer
k ->
      Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
1 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
i (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
j (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
k

-- | @since 1.0.0
instance Function PLA.StakingCredential where
  {-# INLINEABLE function #-}
  function :: forall b. (StakingCredential -> b) -> StakingCredential :-> b
function = (StakingCredential
 -> Either Credential (Integer, Integer, Integer))
-> (Either Credential (Integer, Integer, Integer)
    -> StakingCredential)
-> (StakingCredential -> b)
-> StakingCredential :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap StakingCredential -> Either Credential (Integer, Integer, Integer)
into Either Credential (Integer, Integer, Integer) -> StakingCredential
outOf
    where
      into :: PLA.StakingCredential -> Either PLA.Credential (Integer, Integer, Integer)
      into :: StakingCredential -> Either Credential (Integer, Integer, Integer)
into = \case
        PLA.StakingHash Credential
cred -> Credential -> Either Credential (Integer, Integer, Integer)
forall a b. a -> Either a b
Left Credential
cred
        PLA.StakingPtr Integer
i Integer
j Integer
k -> (Integer, Integer, Integer)
-> Either Credential (Integer, Integer, Integer)
forall a b. b -> Either a b
Right (Integer
i, Integer
j, Integer
k)
      outOf :: Either PLA.Credential (Integer, Integer, Integer) -> PLA.StakingCredential
      outOf :: Either Credential (Integer, Integer, Integer) -> StakingCredential
outOf = \case
        Left Credential
cred -> Credential -> StakingCredential
PLA.StakingHash Credential
cred
        Right (Integer
i, Integer
j, Integer
k) -> Integer -> Integer -> Integer -> StakingCredential
PLA.StakingPtr Integer
i Integer
j Integer
k