content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DerivingStrategies #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TypeApplications #-}
  
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# OPTIONS_GHC -fno-warn-deprecations #-}
  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
  
  module Cardano.Codec.CborSpec
      ( spec
      ) where
  
  import Prelude
  
  import Cardano.Address.Derivation
      ( Depth (..), GenMasterKey (..), XPrv )
  import Cardano.Address.Style.Byron
      ( Byron (..) )
  import Cardano.Codec.Cbor
      ( decodeAddressDerivationPath
      , decodeAddressPayload
      , decodeAllAttributes
      , decodeDerivationPathAttr
      , deserialiseCbor
      , encodeAttributes
      , encodeDerivationPathAttr
      , toLazyByteString
      , unsafeDeserialiseCbor
      )
  import Cardano.Mnemonic
      ( mkSomeMnemonic )
  import Data.ByteArray
      ( ByteArrayAccess, ScrubbedBytes )
  import Data.ByteString
      ( ByteString )
  import Data.Text
      ( Text )
  import Data.Word
      ( Word32 )
  import Test.Arbitrary
      ( unsafeFromHex )
  import Test.Hspec
      ( Expectation, Spec, describe, it, shouldBe )
  import Test.QuickCheck
      ( Arbitrary (..), Property, conjoin, property, vector, (===), (==>) )
  
  import qualified Data.ByteArray as BA
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Lazy as BL
  
  {- HLINT ignore "Use head" -}
  
  spec :: Spec
  spec = do
      describe "decodeAddress <-> encodeAddress roundtrip" $ do
          it "DerivationPath roundtrip" (property prop_derivationPathRoundTrip)
  
      describe "Golden Tests for Byron Addresses w/ random scheme (Mainnet)" $ do
          it "decodeDerivationPath - mainnet - initial account" $
              decodeDerivationPathTest DecodeDerivationPath
                  { mnem =
                      arbitraryMnemonic
                  , addr =
                      "82d818584283581ca08bcb9e5e8cd30d5aea6d434c46abd8604fe4907d\
                      \56b9730ca28ce5a101581e581c22e25f2464ec7295b556d86d0ec33bc1\
                      \a681e7656da92dbc0582f5e4001a3abe2aa5"
                  , accIndex =
                      2147483648
                  , addrIndex =
                      2147483648
                  }
  
          it "decodeDerivationPath - mainnet - another account" $
              decodeDerivationPathTest DecodeDerivationPath
                  { mnem =
                      arbitraryMnemonic
                  , addr =
                      "82d818584283581cb039e80866203e82fc834b8e6a355b83ec6f8fd199\
                      \66078a40e6d6b2a101581e581c22e27fb12d08728073cd416dfbfcb8dc\
                      \0e760335d1d60f65e8740034001a4bce4d1a"
                  , accIndex =
                      2694138340
                  , addrIndex =
                      2512821145
                  }
  
      describe "Golden Tests for Byron Addresses w/ random scheme (Testnet)" $ do
          it "decodeDerivationPath - testnet - initial account" $
              decodeDerivationPathTest DecodeDerivationPath
                  { mnem =
                      arbitraryMnemonic
                  , addr =
                      "82d818584983581ca03d42af673855aabcef3059e21c37235ae706072d\
                      \38150dcefae9c6a201581e581c22e25f2464ec7295b556d86d0ec33bc1\
                      \a681e7656da92dbc0582f5e402451a4170cb17001a39a0b7b5"
                  , accIndex =
                      2147483648
                  , addrIndex =
                      2147483648
                  }
  
          it "decodeDerivationPath - testnet - another account" $
              decodeDerivationPathTest DecodeDerivationPath
                  { mnem =
                      arbitraryMnemonic
                  , addr =
                      "82d818584983581c267b40902921c3afd73926a83a23ca08ae9626a64a\
                      \4b5616d14d6709a201581e581c22e219c90fb572d565134f6daeab650d\
                      \c871d130430afe594116f1ae02451a4170cb17001aee75f28a"
                  , accIndex =
                      3337448281
                  , addrIndex =
                      3234874775
                  }
  
  {-------------------------------------------------------------------------------
                      Golden tests for Address derivation path
  -------------------------------------------------------------------------------}
  
  data DecodeDerivationPath = DecodeDerivationPath
      { mnem :: [Text]
      , addr :: ByteString
      , accIndex :: Word32
      , addrIndex :: Word32
      } deriving (Show, Eq)
  
  -- An aribtrary mnemonic sentence for the tests
  arbitraryMnemonic :: [Text]
  arbitraryMnemonic =
      [ "price", "whip", "bottom", "execute", "resist", "library"
      , "entire", "purse", "assist", "clock", "still", "noble" ]
  
  decodeDerivationPathTest :: DecodeDerivationPath -> Expectation
  decodeDerivationPathTest DecodeDerivationPath{..} =
      decoded `shouldBe` Right (Just (accIndex, addrIndex))
    where
      payload = unsafeDeserialiseCbor decodeAddressPayload $
          BL.fromStrict (unsafeFromHex addr)
      decoded = deserialiseCbor (decodeAddressDerivationPath pwd) payload
      Right mw = mkSomeMnemonic @'[12] mnem
      key = genMasterKeyFromMnemonic mw () :: Byron 'RootK XPrv
      pwd = payloadPassphrase key
  
  {-------------------------------------------------------------------------------
                             Derivation Path Roundtrip
  -------------------------------------------------------------------------------}
  
  prop_derivationPathRoundTrip
      :: Passphrase
      -> Passphrase
      -> Word32
      -> Word32
      -> Property
  prop_derivationPathRoundTrip (Passphrase pwd) (Passphrase pwd') acctIx addrIx =
      let
          encoded = toLazyByteString $ encodeAttributes
              [ encodeDerivationPathAttr pwd acctIx addrIx ]
          decoded = unsafeDeserialiseCbor
                  (decodeAllAttributes >>=  decodeDerivationPathAttr pwd)
                  encoded
          decoded' = unsafeDeserialiseCbor
                  (decodeAllAttributes >>=  decodeDerivationPathAttr pwd')
                  encoded
      in
          conjoin
              [ decoded === Just (acctIx, addrIx)
              , pwd /= pwd' ==> decoded' === Nothing
              ]
  
  {-------------------------------------------------------------------------------
                               Arbitrary Instances
  -------------------------------------------------------------------------------}
  
  newtype Passphrase = Passphrase ScrubbedBytes
      deriving stock (Eq, Show)
      deriving newtype (ByteArrayAccess)
  
  instance Arbitrary Passphrase where
      arbitrary = do
          bytes <- BS.pack <$> vector 32
          return $ Passphrase $ BA.convert bytes
  