{-# OPTIONS_GHC -fno-warn-orphans #-}

module Hydra.Cardano.Api.Address where

import Hydra.Cardano.Api.Prelude

import Cardano.Binary (unsafeDeserialize')
import Cardano.Chain.Common qualified as Ledger
import Data.ByteString qualified as BS
import Test.QuickCheck (frequency, oneof, vector)

-- * Orphans

instance Arbitrary (Address ByronAddr) where
  arbitrary :: Gen (Address ByronAddr)
arbitrary = do
    Address
address <- AddrSpendingData -> AddrAttributes -> Address
Ledger.makeAddress (AddrSpendingData -> AddrAttributes -> Address)
-> Gen AddrSpendingData -> Gen (AddrAttributes -> Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AddrSpendingData
genSpendingData Gen (AddrAttributes -> Address)
-> Gen AddrAttributes -> Gen Address
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen AddrAttributes
genAttributes
    Address ByronAddr -> Gen (Address ByronAddr)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address ByronAddr -> Gen (Address ByronAddr))
-> Address ByronAddr -> Gen (Address ByronAddr)
forall a b. (a -> b) -> a -> b
$ Address -> Address ByronAddr
ByronAddress Address
address
   where
    genSpendingData :: Gen Ledger.AddrSpendingData
    genSpendingData :: Gen AddrSpendingData
genSpendingData =
      let keyLen :: Int
keyLen = Int
32
          chainCodeLen :: Int
chainCodeLen = Int
32
          majorType02 :: Word8
majorType02 = Word8
88
          cborPrefix :: Int -> ByteString
cborPrefix Int
n = [Word8] -> ByteString
BS.pack [Word8
majorType02, Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n]
       in [(Int, Gen AddrSpendingData)] -> Gen AddrSpendingData
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
            [
              ( Int
5
              , VerificationKey -> AddrSpendingData
Ledger.VerKeyASD
                  (VerificationKey -> AddrSpendingData)
-> (ByteString -> VerificationKey)
-> ByteString
-> AddrSpendingData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> VerificationKey
forall a. FromCBOR a => ByteString -> a
unsafeDeserialize'
                  (ByteString -> VerificationKey)
-> (ByteString -> ByteString) -> ByteString -> VerificationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ByteString
cborPrefix (Int
keyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
chainCodeLen) <>)
                  (ByteString -> AddrSpendingData)
-> Gen ByteString -> Gen AddrSpendingData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genBytes (Int
keyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
chainCodeLen)
              )
            ,
              ( Int
1
              , RedeemVerificationKey -> AddrSpendingData
Ledger.RedeemASD
                  (RedeemVerificationKey -> AddrSpendingData)
-> (ByteString -> RedeemVerificationKey)
-> ByteString
-> AddrSpendingData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RedeemVerificationKey
forall a. FromCBOR a => ByteString -> a
unsafeDeserialize'
                  (ByteString -> RedeemVerificationKey)
-> (ByteString -> ByteString)
-> ByteString
-> RedeemVerificationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ByteString
cborPrefix Int
keyLen <>)
                  (ByteString -> AddrSpendingData)
-> Gen ByteString -> Gen AddrSpendingData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genBytes Int
keyLen
              )
            ]

    genAttributes :: Gen Ledger.AddrAttributes
    genAttributes :: Gen AddrAttributes
genAttributes =
      let payloadLen :: Int
payloadLen = Int
32
       in Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes
Ledger.AddrAttributes
            (Maybe HDAddressPayload -> NetworkMagic -> AddrAttributes)
-> Gen (Maybe HDAddressPayload)
-> Gen (NetworkMagic -> AddrAttributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (Maybe HDAddressPayload)] -> Gen (Maybe HDAddressPayload)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
              [ Maybe HDAddressPayload -> Gen (Maybe HDAddressPayload)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe HDAddressPayload
forall a. Maybe a
Nothing
              , HDAddressPayload -> Maybe HDAddressPayload
forall a. a -> Maybe a
Just (HDAddressPayload -> Maybe HDAddressPayload)
-> (ByteString -> HDAddressPayload)
-> ByteString
-> Maybe HDAddressPayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HDAddressPayload
Ledger.HDAddressPayload (ByteString -> Maybe HDAddressPayload)
-> Gen ByteString -> Gen (Maybe HDAddressPayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genBytes Int
payloadLen
              ]
            Gen (NetworkMagic -> AddrAttributes)
-> Gen NetworkMagic -> Gen AddrAttributes
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NetworkMagic
genNetworkMagic

    genNetworkMagic :: Gen Ledger.NetworkMagic
    genNetworkMagic :: Gen NetworkMagic
genNetworkMagic =
      [Gen NetworkMagic] -> Gen NetworkMagic
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ NetworkMagic -> Gen NetworkMagic
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkMagic
Ledger.NetworkMainOrStage
        , Word32 -> NetworkMagic
Ledger.NetworkTestnet (Word32 -> NetworkMagic) -> Gen Word32 -> Gen NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
        ]

    genBytes :: Int -> Gen ByteString
    genBytes :: Int -> Gen ByteString
genBytes = ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack (Gen [Word8] -> Gen ByteString)
-> (Int -> Gen [Word8]) -> Int -> Gen ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector