{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_HADDOCK prune #-}

-- |
-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect
-- License: Apache-2.0

module Cardano.Address.Style.Byron
    ( -- $overview

      -- * Byron
      Byron
    , DerivationPath
    , payloadPassphrase
    , derivationPath
    , getKey

      -- * Key Derivation
      -- $keyDerivation
    , genMasterKeyFromXPrv
    , genMasterKeyFromMnemonic
    , deriveAccountPrivateKey
    , deriveAddressPrivateKey

      -- * Addresses
      -- $addresses
    , AddressInfo (..)
    , eitherInspectAddress
    , inspectAddress
    , inspectByronAddress
    , paymentAddress
    , ErrInspectAddress (..)
    , prettyErrInspectAddress

      -- * Network Discrimination
    , byronMainnet
    , byronStaging
    , byronTestnet
    , byronPreprod
    , byronPreview

      -- * Unsafe
    , liftXPrv
    , liftXPub

      -- Internals
    , minSeedLengthBytes
    ) where

import Prelude

import Cardano.Address
    ( Address
    , AddressDiscrimination (..)
    , HasNetworkDiscriminant (..)
    , NetworkTag (..)
    , unAddress
    , unsafeMkAddress
    )
import Cardano.Address.Derivation
    ( Depth (..)
    , DerivationScheme (DerivationScheme1)
    , DerivationType (..)
    , Index (..)
    , XPrv
    , XPub
    , deriveXPrv
    , generate
    , toXPub
    , xpubToBytes
    )
import Cardano.Address.Internal
    ( DeserialiseFailure, WithErrorMessage (..) )
import Cardano.Mnemonic
    ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy )
import Codec.Binary.Encoding
    ( AbstractEncoding (..), encode )
import Control.DeepSeq
    ( NFData )
import Control.Exception
    ( Exception, displayException )
import Control.Exception.Base
    ( assert )
import Control.Monad.Catch
    ( MonadThrow, throwM )
import Crypto.Hash
    ( hash )
import Crypto.Hash.Algorithms
    ( Blake2b_256, SHA512 (..) )
import Data.Aeson
    ( ToJSON (..), (.=) )
import Data.Bifunctor
    ( bimap, first )
import Data.ByteArray
    ( ScrubbedBytes )
import Data.ByteString
    ( ByteString )
import Data.Kind
    ( Type )
import Data.List
    ( find )
import Data.Word
    ( Word32, Word8 )
import GHC.Generics
    ( Generic )

import qualified Cardano.Address as Internal
import qualified Cardano.Address.Derivation as Internal
import qualified Cardano.Codec.Cbor as CBOR
import qualified Codec.CBOR.Decoding as CBOR
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import qualified Data.Aeson as Json
import qualified Data.ByteArray as BA
import qualified Data.Text.Encoding as T

-- $overview
--
-- This module provides an implementation of:
--
-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Byron master keys from mnemonic sentences
-- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical derivation of parent to child keys
-- - 'Cardano.Address.PaymentAddress': for constructing addresses from a public key
--
-- We call 'Byron' addresses the old address type used by Daedalus in the early
-- days of Cardano. Using this type of addresses and underlying key scheme is
-- now considered __deprecated__ because of some security implications.
--
-- The internals of the 'Byron' does not matter for the reader, but basically
-- contains what is necessary to perform key derivation and generate addresses
-- from a 'Byron' type.
--
-- Byron uses WholeDomain (meaning Soft+Hardened) for account key and payment key derivation.
-- It should use Hardened for account and Soft for payment as design,
-- but due to the error made prior 2019 in cardano-sl
-- implementation WholeDomain was adopted to handle all the keys. Nevertheless,
-- it was recommended and enforced to use Hardened for account derivation and Soft for payment
-- key derivation from 2019 onwards. To sum up both account index and payment index can assume
-- values from 0 to 4294967295 (ie. 0xFFFFFFFF)

-- == Deprecation Notice
--
-- Unless you have good reason to do so (like writing backward-compatible code
-- with an existing piece), any new implementation __should use__ the
-- 'Cardano.Address.Style.Icarus.Icarus' style for key and addresses.


-- | Material for deriving HD random scheme keys, which can be used for making
-- addresses.
--
-- @since 1.0.0
data Byron (depth :: Depth) key = Byron
    { getKey :: key
    -- ^ The raw private or public key.
    --
    -- @since 1.0.0
    , derivationPath :: DerivationPath depth
    -- ^ The address derivation indices for the level of this key.
    --
    -- @since 1.0.0
    , payloadPassphrase :: ScrubbedBytes
    -- ^ Used for encryption of the derivation path payload within an address.
    --
    -- @since 1.0.0
    } deriving stock (Generic)
{-# DEPRECATED Byron "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
{-# DEPRECATED getKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
{-# DEPRECATED derivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
{-# DEPRECATED payloadPassphrase "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

instance (NFData key, NFData (DerivationPath depth)) => NFData (Byron depth key)
deriving instance (Show key, Show (DerivationPath depth)) => Show (Byron depth key)
deriving instance (Eq key, Eq (DerivationPath depth)) => Eq (Byron depth key)
deriving instance (Functor (Byron depth))

-- | The hierarchical derivation indices for a given level/depth.
--
-- @since 1.0.0
type family DerivationPath (depth :: Depth) :: Type where
    -- The root key is generated from the seed.
    DerivationPath 'RootK =
        ()
    -- The account key is generated from the root key and account index.
    DerivationPath 'AccountK =
        Index 'WholeDomain 'AccountK
    -- The address key is generated from the account key and address index.
    DerivationPath 'PaymentK =
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'PaymentK)
{-# DEPRECATED DerivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

--
-- Key Derivation
--
-- === Generating a root key from 'SomeMnemonic'
-- > :set -XOverloadedStrings
-- > :set -XTypeApplications
-- > :set -XDataKinds
-- > :set -XFlexibleContexts
-- > import Cardano.Mnemonic ( mkSomeMnemonic )
-- > import Cardano.Address ( base58 )
-- > import Cardano.Address.Derivation ( toXPub )
-- > import qualified Cardano.Address.Style.Byron as Byron
-- >
-- > let (Right mw) = mkSomeMnemonic @'[12] ["moon","fox","ostrich","quick","cactus","raven","wasp","intact","first","ring","crumble","error"]
-- > let rootK = Byron.genMasterKeyFromMnemonic mw :: Byron 'RootK XPrv
--
-- === Deriving child keys
-- === Both accIx and addIx assume values from 0 to 4294967295 (ie. 0xFFFFFFFF)
-- === In case of account one can get this bound via
-- === let accIxMin = minBound @(Index 'WholeDomain 'AccountK)
-- === let accIxMax = maxBound @(Index 'WholeDomain 'AccountK)
-- > let Just accIx = wholeDomainIndex 0x80000000
-- > let acctK = Byron.deriveAccountPrivateKey rootK accIx
-- >
-- > let Just addIx = wholeDomainIndex 0x80000014
-- > let addrK = Byron.deriveAddressPrivateKey acctK addIx
-- >
-- > base58 $ Byron.paymentAddress Byron.byronMainnet (toXPub <$> addrK)
-- > "DdzFFzCqrhsq3KjLtT51mESbZ4RepiHPzLqEhamexVFTJpGbCXmh7qSxnHvaL88QmtVTD1E1sjx8Z1ZNDhYmcBV38ZjDST9kYVxSkhcw"

instance Internal.GenMasterKey Byron where
    type SecondFactor Byron = ()

    genMasterKeyFromXPrv xprv =
        liftXPrv (toXPub xprv) () xprv
    genMasterKeyFromMnemonic (SomeMnemonic mw) () =
        liftXPrv (toXPub xprv) () xprv
      where
        xprv = generate (hashSeed seedValidated)
        seed  = entropyToBytes $ mnemonicToEntropy mw
        seedValidated = assert
            (BA.length seed >= minSeedLengthBytes && BA.length seed <= 255)
            seed

instance Internal.HardDerivation Byron where
    type AddressIndexDerivationType Byron = 'WholeDomain
    type AccountIndexDerivationType Byron = 'WholeDomain
    type WithRole Byron = ()

    deriveAccountPrivateKey rootXPrv accIx = Byron
        { getKey = deriveXPrv DerivationScheme1 (getKey rootXPrv) accIx
        , derivationPath = accIx
        , payloadPassphrase = payloadPassphrase rootXPrv
        }

    deriveAddressPrivateKey accXPrv () addrIx = Byron
        { getKey = deriveXPrv DerivationScheme1 (getKey accXPrv) addrIx
        , derivationPath = (derivationPath accXPrv, addrIx)
        , payloadPassphrase = payloadPassphrase accXPrv
        }

-- | Generate a root key from a corresponding mnemonic.
--
-- @since 1.0.0
genMasterKeyFromMnemonic
    :: SomeMnemonic
        -- ^ Some valid mnemonic sentence.
    -> Byron 'RootK XPrv
genMasterKeyFromMnemonic =
    flip Internal.genMasterKeyFromMnemonic ()
{-# DEPRECATED genMasterKeyFromMnemonic "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- | Generate a root key from a corresponding root 'XPrv'
--
-- @since 1.0.0
genMasterKeyFromXPrv
    :: XPrv
    -> Byron 'RootK XPrv
genMasterKeyFromXPrv =
    Internal.genMasterKeyFromXPrv
{-# DEPRECATED genMasterKeyFromXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives an account private key from the given root private key.
--
-- @since 1.0.0
deriveAccountPrivateKey
    :: Byron 'RootK XPrv
    -> Index 'WholeDomain 'AccountK
    -> Byron 'AccountK XPrv
deriveAccountPrivateKey =
    Internal.deriveAccountPrivateKey
{-# DEPRECATED deriveAccountPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives an address private key from the given account private key.
--
-- @since 1.0.0
deriveAddressPrivateKey
    :: Byron 'AccountK XPrv
    -> Index 'WholeDomain 'PaymentK
    -> Byron 'PaymentK XPrv
deriveAddressPrivateKey acctK =
    Internal.deriveAddressPrivateKey acctK ()
{-# DEPRECATED deriveAddressPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

--
-- Addresses
--
-- $addresses
-- === Generating a 'PaymentAddress'
--
-- | Possible errors from inspecting a Byron address
--
-- @since 3.0.0
data ErrInspectAddress
    = MissingExpectedDerivationPath
    | DeserialiseError DeserialiseFailure
    | FailedToDecryptPath
    deriving (Generic, Show, Eq)
    deriving ToJSON via WithErrorMessage ErrInspectAddress

instance Exception ErrInspectAddress where
  displayException = prettyErrInspectAddress

-- | Pretty-print an 'ErrInspectAddress'
--
-- @since 3.0.0
prettyErrInspectAddress :: ErrInspectAddress -> String
prettyErrInspectAddress = \case
    MissingExpectedDerivationPath ->
        "Missing expected derivation path"
    DeserialiseError e ->
        displayException e
    FailedToDecryptPath ->
        "Failed to decrypt derivation path"

-- Determines whether an 'Address' is a Byron address.
--
-- Returns a JSON object with information about the address, or throws
-- 'ErrInspectAddress' if the address isn't a byron address.
--
-- @since 2.0.0
inspectByronAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
inspectByronAddress = inspectAddress
{-# DEPRECATED inspectByronAddress "use qualified 'inspectAddress' instead." #-}

-- | Determines whether an 'Address' is a Byron address.
--
-- Returns a JSON object with information about the address, or throws
-- 'ErrInspectAddress' if the address isn't a byron address.
--
-- @since 3.0.0
inspectAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
inspectAddress mRootPub addr = either throwM (pure . toJSON) $
    eitherInspectAddress mRootPub addr

-- | Determines whether an 'Address' is a Byron address.
--
-- Returns either details about the 'Address', or 'ErrInspectAddress' if it's
-- not a valid address.
--
-- @since 3.4.0
eitherInspectAddress :: Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo
eitherInspectAddress mRootPub addr = do
    payload <- first DeserialiseError $
        CBOR.deserialiseCbor CBOR.decodeAddressPayload bytes

    (root, attrs) <- first DeserialiseError $
        CBOR.deserialiseCbor decodePayload payload

    path <- do
        attr <- maybe (Left MissingExpectedDerivationPath) Right $
            find ((== 1) . fst) attrs
        case mRootPub of
            Nothing -> Right $ EncryptedDerivationPath $ snd attr
            Just rootPub -> decryptPath attr rootPub

    ntwrk <- bimap DeserialiseError (fmap NetworkTag) $
        CBOR.deserialiseCbor CBOR.decodeProtocolMagicAttr payload

    pure AddressInfo
        { infoAddressRoot = root
        , infoPayload = path
        , infoNetworkTag = ntwrk
        }
  where
    bytes :: ByteString
    bytes = unAddress addr

    decodePayload :: forall s. CBOR.Decoder s (ByteString, [(Word8, ByteString)])
    decodePayload = do
        _ <- CBOR.decodeListLenCanonicalOf 3
        root <- CBOR.decodeBytes
        (root,) <$> CBOR.decodeAllAttributes

    decryptPath :: (Word8, ByteString) -> XPub -> Either ErrInspectAddress PayloadInfo
    decryptPath attr rootPub = do
        let pwd = hdPassphrase rootPub
        path <- first (const FailedToDecryptPath) $
            CBOR.deserialiseCbor (CBOR.decodeDerivationPathAttr pwd [attr]) mempty
        case path of
            Nothing -> Left FailedToDecryptPath
            Just (accountIndex, addressIndex) -> Right PayloadDerivationPath{..}

-- | The result of 'eitherInspectAddress' for Byron addresses.
--
-- @since 3.4.0
data AddressInfo = AddressInfo
    { infoAddressRoot :: !ByteString
    , infoPayload :: !PayloadInfo
    , infoNetworkTag :: !(Maybe NetworkTag)
    } deriving (Generic, Show, Eq)

-- | The derivation path in a Byron address payload.
--
-- @since 3.4.0
data PayloadInfo
    = PayloadDerivationPath
        { accountIndex :: !Word32
        , addressIndex :: !Word32
        }
    | EncryptedDerivationPath
        { encryptedDerivationPath :: !ByteString
        }
    deriving (Generic, Show, Eq)

instance ToJSON AddressInfo where
    toJSON AddressInfo{..} = Json.object
        [ "address_root"    .= T.decodeUtf8 (encode EBase16 infoAddressRoot)
        , "derivation_path" .= infoPayload
        , "network_tag"     .= maybe Json.Null toJSON infoNetworkTag
        , "address_type"    .= toJSON @Word8 8
        ]

instance ToJSON PayloadInfo where
    toJSON PayloadDerivationPath{..} = Json.object
        [ "account_index" .= prettyIndex accountIndex
        , "address_index" .= prettyIndex addressIndex
        ]
      where
        prettyIndex :: Word32 -> String
        prettyIndex ix
            | ix >= firstHardened = show (ix - firstHardened) <> "H"
            | otherwise = show ix
          where
            firstHardened = 0x80000000
    toJSON EncryptedDerivationPath{..} = Json.String $
        T.decodeUtf8 $ encode EBase16 encryptedDerivationPath

instance Internal.PaymentAddress Byron where
    paymentAddress discrimination k = unsafeMkAddress
        $ CBOR.toStrictByteString
        $ CBOR.encodeAddress (getKey k) attrs
      where
        (acctIx, addrIx) = bimap indexToWord32 indexToWord32 $ derivationPath k
        pwd = payloadPassphrase k
        NetworkTag magic = networkTag @Byron discrimination
        attrs = case addressDiscrimination @Byron discrimination of
            RequiresNetworkTag ->
                [ CBOR.encodeDerivationPathAttr pwd acctIx addrIx
                , CBOR.encodeProtocolMagicAttr magic
                ]
            RequiresNoTag ->
                [ CBOR.encodeDerivationPathAttr pwd acctIx addrIx
                ]

-- Re-export from 'Cardano.Address' to have it documented specialized in Haddock.
--
-- | Convert a public key to a payment 'Address' valid for the given
-- network discrimination.
--
-- @since 1.0.0
paymentAddress
    :: NetworkDiscriminant Byron
    -> Byron 'PaymentK XPub
    -> Address
paymentAddress =
    Internal.paymentAddress

--
-- Network Discrimination
--

instance HasNetworkDiscriminant Byron where
    type NetworkDiscriminant Byron = (AddressDiscrimination, NetworkTag)
    addressDiscrimination = fst
    networkTag = snd

-- | 'NetworkDiscriminant' for Cardano MainNet & Byron
--
-- @since 2.0.0
byronMainnet :: NetworkDiscriminant Byron
byronMainnet = (RequiresNoTag, NetworkTag 764824073)

-- | 'NetworkDiscriminant' for Cardano Staging & Byron
--
-- @since 2.0.0
byronStaging :: NetworkDiscriminant Byron
byronStaging = (RequiresNetworkTag, NetworkTag 633343913)

-- | 'NetworkDiscriminant' for Cardano Testnet & Byron
--
-- @since 2.0.0
byronTestnet :: NetworkDiscriminant Byron
byronTestnet = (RequiresNetworkTag, NetworkTag 1097911063)

-- | 'NetworkDiscriminant' for Cardano Preview & Byron
--
-- @since 3.13.0
byronPreview :: NetworkDiscriminant Byron
byronPreview = (RequiresNetworkTag, NetworkTag 2)

-- | 'NetworkDiscriminant' for Cardano Preprod & Byron
--
-- @since 3.13.0
byronPreprod :: NetworkDiscriminant Byron
byronPreprod = (RequiresNetworkTag, NetworkTag 1)

--
-- Unsafe
--

-- | Backdoor for generating a new key from a raw 'XPrv'.
--
-- Note that the @depth@ is left open so that the caller gets to decide what type
-- of key this is. This is mostly for testing, in practice, seeds are used to
-- represent root keys, and one should 'genMasterKeyFromXPrv'
--
-- The first argument is a type-family 'DerivationPath' and its type depends on
-- the 'depth' of the key.
--
-- __examples:__
--
-- >>> liftXPrv rootPrv () prv
-- _ :: Byron RootK XPrv
--
-- >>> liftXPrv rootPrv minBound prv
-- _ :: Byron AccountK XPrv
--
-- >>> liftXPrv rootPrv (minBound, minBound) prv
-- _ :: Byron PaymentK XPrv
--
-- @since 2.0.0
liftXPrv
    :: XPub -- ^ A root public key
    -> DerivationPath depth
    -> XPrv
    -> Byron depth XPrv
liftXPrv rootPub derivationPath getKey = Byron
    { getKey
    , derivationPath
    , payloadPassphrase = hdPassphrase rootPub
    }
{-# DEPRECATED liftXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- | Backdoor for generating a new key from a raw 'XPub'.
--
-- Note that the @depth@ is left open so that the caller gets to decide what type
-- of key this is. This is mostly for testing, in practice, seeds are used to
-- represent root keys, and one should 'genMasterKeyFromXPrv'
--
-- see also 'liftXPrv'
--
-- @since 2.0.0
liftXPub
    :: XPub -- ^ A root public key
    -> DerivationPath depth
    -> XPub
    -> Byron depth XPub
liftXPub rootPub derivationPath getKey = Byron
    { getKey
    , derivationPath
    , payloadPassphrase = hdPassphrase rootPub
    }
{-# DEPRECATED liftXPub "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

--
-- Internal
--

-- The amount of entropy carried by a BIP-39 12-word mnemonic is 16 bytes.
minSeedLengthBytes :: Int
minSeedLengthBytes = 16

-- Hash the seed entropy (generated from mnemonic) used to initiate a HD
-- wallet. This increases the key length to 34 bytes, selectKey is greater than the
-- minimum for 'generate' (32 bytes).
--
-- Note that our current implementation deviates from BIP-39 because we use a
-- hash function (Blake2b) rather than key stretching with PBKDF2.
--
-- There are two methods of hashing the seed entropy, for different use cases.
--
-- 1. Normal random derivation wallet seeds. The seed entropy is hashed using
--    Blake2b_256, inside a double CBOR serialization sandwich.
--
-- 2. Seeds for redeeming paper wallets. The seed entropy is hashed using
--    Blake2b_256, without any serialization.
hashSeed :: ScrubbedBytes -> ScrubbedBytes
hashSeed = serialize . blake2b256 . serialize
  where
    serialize = BA.convert . cbor . BA.convert
    cbor = CBOR.toStrictByteString . CBOR.encodeBytes

-- Hash a byte string through blake2b 256
blake2b256 :: ScrubbedBytes -> ScrubbedBytes
blake2b256 = BA.convert . hash @ScrubbedBytes @Blake2b_256

-- Derive a symmetric key for encrypting and authenticating the address
-- derivation path. PBKDF2 encryption using HMAC with the hash algorithm SHA512
-- is employed.
hdPassphrase :: XPub -> ScrubbedBytes
hdPassphrase masterKey =
    PBKDF2.generate
    (PBKDF2.prfHMAC SHA512)
    (PBKDF2.Parameters 500 32)
    (xpubToBytes masterKey)
    ("address-hashing" :: ByteString)