{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Shelley.Serialisation.Golden.Address (tests) where

import qualified Cardano.Chain.Common as Byron
import Cardano.Crypto.Hash (HashAlgorithm (..), hashFromBytes, hashFromTextAsHex, sizeHash)
import Cardano.Crypto.Hash.Blake2b (Blake2b_224)
import Cardano.Ledger.Address
import Cardano.Ledger.BaseTypes (Network (..), mkCertIxPartial, mkTxIxPartial)
import Cardano.Ledger.Credential (
  Credential (..),
  Ptr (..),
  StakeReference (..),
 )
import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Ledger.Keys (
  KeyRole (..),
  pattern KeyHash,
 )
import Cardano.Ledger.Shelley.Scripts (pattern ScriptHash)
import Cardano.Ledger.Slot (SlotNo (..))
import qualified Data.Binary as B
import qualified Data.Binary.Put as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base16.Lazy as LB16
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import GHC.Exts (IsString)
import GHC.Stack (HasCallStack)
import Test.Tasty (TestTree)
import qualified Test.Tasty as T
import qualified Test.Tasty.HUnit as T

-- Crypto family as used in production Shelley
-- This should match that defined at https://github.com/input-output-hk/ouroboros-network/blob/master/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Protocol/Crypto.hs

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
T.testGroup
    TestName
"Address golden tests"
    [ TestTree
goldenTests_MockCrypto
    , TestTree
goldenTests_ShelleyCrypto
    ]

{------------------------------------------------------------------------------
-- Golden tests
------------------------------------------------------------------------------}

goldenTests_MockCrypto :: TestTree
goldenTests_MockCrypto :: TestTree
goldenTests_MockCrypto =
  TestName -> [TestTree] -> TestTree
T.testGroup
    TestName
"MockCrypto golden tests"
    [ forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden TestName
"keyHash" forall (kr :: KeyRole) c. Credential kr c -> Put
putCredential forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash forall s. IsString s => s
keyHashHex
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden TestName
"scriptHash" forall (kr :: KeyRole) c. Credential kr c -> Put
putCredential forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash forall s. IsString s => s
scriptHashHex
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden TestName
"ptr" Ptr -> Put
putPtr Ptr
ptr forall s. IsString s => s
ptrHex
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseKK"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash (forall c. StakeCredential c -> StakeReference c
StakeRefBase forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash))
        (ByteString
"00" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
keyHashHex forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
keyHashHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseSK"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash (forall c. StakeCredential c -> StakeReference c
StakeRefBase forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash))
        (ByteString
"10" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
scriptHashHex forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
keyHashHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseKS"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash (forall c. StakeCredential c -> StakeReference c
StakeRefBase forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash))
        (ByteString
"20" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
keyHashHex forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
scriptHashHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseSS"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash (forall c. StakeCredential c -> StakeReference c
StakeRefBase forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash))
        (ByteString
"30" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
scriptHashHex forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
scriptHashHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrPtrK"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash (forall c. Ptr -> StakeReference c
StakeRefPtr Ptr
ptr))
        (ByteString
"40" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
keyHashHex forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
ptrHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrPtrS"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash (forall c. Ptr -> StakeReference c
StakeRefPtr Ptr
ptr))
        (ByteString
"50" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
scriptHashHex forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
ptrHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrEnterpriseK"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash forall c. StakeReference c
StakeRefNull)
        (ByteString
"60" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
keyHashHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrEnterpriseS"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash forall c. StakeReference c
StakeRefNull)
        (ByteString
"70" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
scriptHashHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"rewardAcntK"
        forall c. RewardAcnt c -> Put
putRewardAccount
        (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash)
        (ByteString
"e0" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
keyHashHex)
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"rewardAcntS"
        forall c. RewardAcnt c -> Put
putRewardAccount
        (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash)
        (ByteString
"f0" forall a. Semigroup a => a -> a -> a
<> forall s. IsString s => s
scriptHashHex)
    ]
  where
    keyHashHex :: IsString s => s
    keyHashHex :: forall s. IsString s => s
keyHashHex = s
"01020304a1a2a3a4a5a6a7a8a9b0b1b2b3b4b5b6b7b8b9c0c1c2c3c4"
    keyHash :: Credential kh StandardCrypto
    keyHash :: forall (kh :: KeyRole). Credential kh StandardCrypto
keyHash =
      forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
KeyHash
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => TestName -> a
error TestName
"Unable to decode")
        forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Text -> Maybe (Hash h a)
hashFromTextAsHex forall s. IsString s => s
keyHashHex
    scriptHashHex :: IsString s => s
    scriptHashHex :: forall s. IsString s => s
scriptHashHex = s
"05060708b5b6b7b8d5d6d7d8d9e0e1e2e3e4e5e6e7e8e9f0f1f2f3f4"
    scriptHash :: Credential kh StandardCrypto
    scriptHash :: forall (kh :: KeyRole). Credential kh StandardCrypto
scriptHash =
      forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
ScriptHash
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => TestName -> a
error TestName
"Unable to decode")
        forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Text -> Maybe (Hash h a)
hashFromTextAsHex forall s. IsString s => s
scriptHashHex
    ptrHex :: IsString s => s
    ptrHex :: forall s. IsString s => s
ptrHex = s
"81000203"
    ptr :: Ptr
    ptr :: Ptr
ptr = SlotNo -> TxIx -> CertIx -> Ptr
Ptr (Word64 -> SlotNo
SlotNo Word64
128) (HasCallStack => Integer -> TxIx
mkTxIxPartial Integer
2) (HasCallStack => Integer -> CertIx
mkCertIxPartial Integer
3)

goldenTests_ShelleyCrypto :: TestTree
goldenTests_ShelleyCrypto :: TestTree
goldenTests_ShelleyCrypto =
  TestName -> [TestTree] -> TestTree
T.testGroup
    TestName
"ShelleyCrypto golden tests"
    [ forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrEnterpriseK for network id = 0"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet Credential 'Payment StandardCrypto
paymentKey forall c. StakeReference c
StakeRefNull)
        ByteString
"608a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseKK for network id = 0"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet Credential 'Payment StandardCrypto
paymentKey (forall c. StakeCredential c -> StakeReference c
StakeRefBase Credential 'Staking StandardCrypto
stakeKey))
        ByteString
"008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrPtrK for network id = 0"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Testnet Credential 'Payment StandardCrypto
paymentKey (forall c. Ptr -> StakeReference c
StakeRefPtr Ptr
ptr))
        ByteString
"408a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d481000203"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrEnterpriseK for network id = 1"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Mainnet Credential 'Payment StandardCrypto
paymentKey forall c. StakeReference c
StakeRefNull)
        ByteString
"618a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseKK for network id = 1"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Mainnet Credential 'Payment StandardCrypto
paymentKey (forall c. StakeCredential c -> StakeReference c
StakeRefBase Credential 'Staking StandardCrypto
stakeKey))
        ByteString
"018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrPtrK for network id = 1"
        forall c. Addr c -> Put
putAddr
        (forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
Mainnet Credential 'Payment StandardCrypto
paymentKey (forall c. Ptr -> StakeReference c
StakeRefPtr Ptr
ptr))
        ByteString
"418a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d481000203"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"rewardAcntK"
        forall c. RewardAcnt c -> Put
putRewardAccount
        (forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet Credential 'Staking StandardCrypto
stakeKey)
        ByteString
"e008b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"bootstrapAddr for network id = 1"
        forall c. Addr c -> Put
putAddr
        ( forall c. BootstrapAddress c -> Addr c
AddrBootstrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Address -> BootstrapAddress c
BootstrapAddress forall a b. (a -> b) -> a -> b
$
            Byron.Address
              { addrRoot :: AddressHash Address'
Byron.addrRoot = forall a. Read a => TestName -> a
read TestName
"4bf3c2ee56bfef278d65f7388c46efa12a1069698e474f77adf0cf6a"
              , addrAttributes :: Attributes AddrAttributes
Byron.addrAttributes =
                  Byron.Attributes
                    { attrData :: AddrAttributes
Byron.attrData =
                        Byron.AddrAttributes
                          { aaVKDerivationPath :: Maybe HDAddressPayload
Byron.aaVKDerivationPath = forall a. Maybe a
Nothing
                          , aaNetworkMagic :: NetworkMagic
Byron.aaNetworkMagic = NetworkMagic
Byron.NetworkMainOrStage
                          }
                    , attrRemain :: UnparsedFields
Byron.attrRemain = Map Word8 ByteString -> UnparsedFields
Byron.UnparsedFields forall a. Monoid a => a
mempty
                    }
              , addrType :: AddrType
Byron.addrType = AddrType
Byron.ATVerKey
              }
        )
        ByteString
"82d818582183581c4bf3c2ee56bfef278d65f7388c46efa12a1069698e474f77adf0cf6aa0001ab4aad9a5"
    ]
  where
    paymentKey :: Credential 'Payment StandardCrypto
    paymentKey :: Credential 'Payment StandardCrypto
paymentKey = forall (kh :: KeyRole). ByteString -> Credential kh StandardCrypto
keyBlake2b224 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode ByteString
"1a2a3a4a5a6a7a8a"
    stakeKey :: Credential 'Staking StandardCrypto
    stakeKey :: Credential 'Staking StandardCrypto
stakeKey = forall (kh :: KeyRole). ByteString -> Credential kh StandardCrypto
keyBlake2b224 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode ByteString
"1c2c3c4c5c6c7c8c"
    ptr :: Ptr
    ptr :: Ptr
ptr = SlotNo -> TxIx -> CertIx -> Ptr
Ptr (Word64 -> SlotNo
SlotNo Word64
128) (HasCallStack => Integer -> TxIx
mkTxIxPartial Integer
2) (HasCallStack => Integer -> CertIx
mkCertIxPartial Integer
3)
    -- 32-byte verification key is expected, vk, ie., public key without chain code.
    -- The verification key undergoes Blake2b_224 hashing
    -- and should be 28-byte in the aftermath
    keyBlake2b224 :: BS.ByteString -> Credential kh StandardCrypto
    keyBlake2b224 :: forall (kh :: KeyRole). ByteString -> Credential kh StandardCrypto
keyBlake2b224 ByteString
vk =
      forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
KeyHash
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => TestName -> a
error TestName
"Supplied bytes are of unexpected length")
        forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
hk
      where
        hash :: ByteString -> ByteString
hash = forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
digest (forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_224)
        vk' :: ByteString
vk' = HasCallStack => Int -> ByteString -> ByteString
invariantSize Int
32 ByteString
vk
        hk :: ByteString
hk =
          HasCallStack => Int -> ByteString -> ByteString
invariantSize
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_224))
            (ByteString -> ByteString
hash ByteString
vk')
    invariantSize :: HasCallStack => Int -> BS.ByteString -> BS.ByteString
    invariantSize :: HasCallStack => Int -> ByteString -> ByteString
invariantSize Int
expectedLength ByteString
bytes
      | ByteString -> Int
BS.length ByteString
bytes forall a. Eq a => a -> a -> Bool
== Int
expectedLength = ByteString
bytes
      | Bool
otherwise =
          forall a. HasCallStack => TestName -> a
error forall a b. (a -> b) -> a -> b
$
            TestName
"length was "
              forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show (ByteString -> Int
BS.length ByteString
bytes)
              forall a. [a] -> [a] -> [a]
++ TestName
", but expected to be "
              forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show Int
expectedLength

golden :: HasCallStack => String -> (a -> B.Put) -> a -> LBS.ByteString -> TestTree
golden :: forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden TestName
name a -> Put
put a
value ByteString
expected =
  TestName -> Assertion -> TestTree
T.testCase TestName
name forall a b. (a -> b) -> a -> b
$
    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
T.assertEqual TestName
name ByteString
expected (ByteString -> ByteString
LB16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
B.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
put forall a b. (a -> b) -> a -> b
$ a
value)