{-# 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 (..), SlotNo32 (..), StakeReference (..))
import Cardano.Ledger.Shelley.Core
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). Credential kr -> Put
putCredential forall (kh :: KeyRole). Credential kh
keyHash forall s. IsString s => s
keyHashHex
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden TestName
"scriptHash" forall (kr :: KeyRole). Credential kr -> Put
putCredential forall (kh :: KeyRole). Credential kh
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
keyHash (StakeCredential -> StakeReference
StakeRefBase forall (kh :: KeyRole). Credential kh
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
scriptHash (StakeCredential -> StakeReference
StakeRefBase forall (kh :: KeyRole). Credential kh
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
keyHash (StakeCredential -> StakeReference
StakeRefBase forall (kh :: KeyRole). Credential kh
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
scriptHash (StakeCredential -> StakeReference
StakeRefBase forall (kh :: KeyRole). Credential kh
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
keyHash (Ptr -> StakeReference
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
scriptHash (Ptr -> StakeReference
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
keyHash StakeReference
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet forall (kh :: KeyRole). Credential kh
scriptHash StakeReference
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"
        RewardAccount -> Put
putRewardAccount
        (Network -> StakeCredential -> RewardAccount
RewardAccount Network
Testnet forall (kh :: KeyRole). Credential kh
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"
        RewardAccount -> Put
putRewardAccount
        (Network -> StakeCredential -> RewardAccount
RewardAccount Network
Testnet forall (kh :: KeyRole). Credential kh
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
    keyHash :: forall (kh :: KeyRole). Credential kh
keyHash =
      forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
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
    scriptHash :: forall (kh :: KeyRole). Credential kh
scriptHash =
      forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
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 = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
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"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet PaymentCredential
paymentKey StakeReference
StakeRefNull)
        ByteString
"608a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseKK for network id = 0"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet PaymentCredential
paymentKey (StakeCredential -> StakeReference
StakeRefBase StakeCredential
stakeKey))
        ByteString
"008a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrPtrK for network id = 0"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet PaymentCredential
paymentKey (Ptr -> StakeReference
StakeRefPtr Ptr
ptr))
        ByteString
"408a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d481000203"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrEnterpriseK for network id = 1"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Mainnet PaymentCredential
paymentKey StakeReference
StakeRefNull)
        ByteString
"618a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrBaseKK for network id = 1"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Mainnet PaymentCredential
paymentKey (StakeCredential -> StakeReference
StakeRefBase StakeCredential
stakeKey))
        ByteString
"018a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d408b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"addrPtrK for network id = 1"
        Addr -> Put
putAddr
        (Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Mainnet PaymentCredential
paymentKey (Ptr -> StakeReference
StakeRefPtr Ptr
ptr))
        ByteString
"418a4d111f71a79169c50bcbc27e1e20b6e13e87ff8f33edc3cab419d481000203"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"rewardAcntK"
        RewardAccount -> Put
putRewardAccount
        (Network -> StakeCredential -> RewardAccount
RewardAccount Network
Testnet StakeCredential
stakeKey)
        ByteString
"e008b2d658668c2e341ee5bda4477b63c5aca7ec7ae4e3d196163556a4"
    , forall a.
HasCallStack =>
TestName -> (a -> Put) -> a -> ByteString -> TestTree
golden
        TestName
"bootstrapAddr for network id = 1"
        Addr -> Put
putAddr
        ( BootstrapAddress -> Addr
AddrBootstrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> BootstrapAddress
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
    paymentKey :: PaymentCredential
paymentKey = forall (kh :: KeyRole). ByteString -> Credential kh
keyBlake2b224 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode ByteString
"1a2a3a4a5a6a7a8a"
    stakeKey :: Credential 'Staking
    stakeKey :: StakeCredential
stakeKey = forall (kh :: KeyRole). ByteString -> Credential kh
keyBlake2b224 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode ByteString
"1c2c3c4c5c6c7c8c"
    ptr :: Ptr
    ptr :: Ptr
ptr = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
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
    keyBlake2b224 :: forall (kh :: KeyRole). ByteString -> Credential kh
keyBlake2b224 ByteString
vk =
      forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
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)