content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE BinaryLiterals #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DerivingStrategies #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TypeFamilies #-}
  
  {-# 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
      ( -- * Address
        Address
      , PaymentAddress (..)
      , StakeAddress (..)
      , DelegationAddress (..)
      , PointerAddress (..)
      , ChainPointer (..)
      , unsafeMkAddress
      , unAddress
  
        -- * Conversion From / To Text
      , base58
      , fromBase58
      , bech32
      , bech32With
      , fromBech32
  
        -- Internal / Network Discrimination
      , HasNetworkDiscriminant (..)
      , AddressDiscrimination (..)
      , NetworkTag (..)
      , invariantSize
      , invariantNetworkTag
      ) where
  
  import Prelude
  
  import Cardano.Address.Derivation
      ( Depth (..), XPub )
  import Cardano.Codec.Cbor
      ( decodeAddress, deserialiseCbor )
  import Codec.Binary.Bech32
      ( HumanReadablePart )
  import Codec.Binary.Encoding
      ( AbstractEncoding (..), encode )
  import Control.DeepSeq
      ( NFData )
  import Control.Monad
      ( (<=<) )
  import Data.Aeson
      ( ToJSON (..), Value (..), object, (.=) )
  import Data.Bits
      ( Bits (testBit) )
  import Data.ByteString
      ( ByteString )
  import Data.Either.Extra
      ( eitherToMaybe )
  import Data.Kind
      ( Type )
  import Data.Text
      ( Text )
  import Data.Word
      ( Word32, Word8 )
  import GHC.Generics
      ( Generic )
  import GHC.Stack
      ( HasCallStack )
  import Numeric.Natural
      ( Natural )
  
  import qualified Cardano.Codec.Bech32.Prefixes as CIP5
  import qualified Codec.Binary.Encoding as E
  import qualified Data.ByteString as BS
  import qualified Data.Text.Encoding as T
  
  -- | An 'Address' type representing 'Cardano' addresses. Internals are
  -- irrevelant to the user.
  --
  -- @since 1.0.0
  newtype Address = Address
      { unAddress :: ByteString
      } deriving stock (Generic, Show, Eq, Ord)
  instance NFData Address
  
  -- | Unsafe constructor for easily lifting bytes inside an 'Address'.
  --
  -- __Use at your own risks.__
  unsafeMkAddress :: ByteString -> Address
  unsafeMkAddress = Address
  
  -- | Encode an 'Address' to a base58 'Text'.
  --
  -- @since 1.0.0
  base58 :: Address -> Text
  base58 = T.decodeUtf8 . encode EBase58 . unAddress
  
  -- | Decode a base58-encoded 'Text' into an 'Address'
  --
  -- @since 1.0.0
  fromBase58 :: Text -> Maybe Address
  fromBase58 =
      (eitherToMaybe . deserialiseCbor (unsafeMkAddress <$> decodeAddress)
      <=< (eitherToMaybe . E.fromBase58 . T.encodeUtf8))
  
  -- | Encode a Shelley 'Address' to bech32 'Text', using @addr@ or @addr_test@ as
  -- a human readable prefix (depending on the network tag in the address).
  --
  -- @since 1.0.0
  bech32 :: Address -> Text
  bech32 addr = bech32With (addressHrp addr) addr
  
  -- | Encode an 'Address' to bech32 'Text', using the specified human readable
  -- prefix.
  --
  -- @since 2.0.0
  bech32With :: HumanReadablePart -> Address -> Text
  bech32With hrp = T.decodeLatin1 . encode (EBech32 hrp) . unAddress
  
  -- | Decode a bech32-encoded 'Text' into an 'Address'
  --
  -- @since 1.0.0
  fromBech32 :: Text -> Maybe Address
  fromBech32 = eitherToMaybe
      . fmap (unsafeMkAddress . snd)
      . E.fromBech32 (const id)
      . T.encodeUtf8
  
  -- | Returns the HRP for a shelley address, using the network tag.
  addressHrp :: Address -> HumanReadablePart
  addressHrp (Address bs) = case BS.uncons bs of
      Just (w8, _) | testBit w8 0 -> CIP5.addr
      _ -> CIP5.addr_test
  
  -- | Encoding of addresses for certain key types and backend targets.
  --
  -- @since 2.0.0
  class HasNetworkDiscriminant key => StakeAddress key where
      -- | Convert a delegation key to a stake 'Address' (aka: reward account address)
      -- valid for the given network discrimination.
      --
      -- @since 2.0.0
      stakeAddress :: NetworkDiscriminant key -> key 'DelegationK XPub -> Address
  
  -- | Encoding of addresses for certain key types and backend targets.
  --
  -- @since 1.0.0
  class HasNetworkDiscriminant key => PaymentAddress key where
      -- | Convert a public key to a payment 'Address' valid for the given
      -- network discrimination.
      --
      -- @since 1.0.0
      paymentAddress :: NetworkDiscriminant key -> key 'PaymentK XPub -> Address
  
  -- | Encoding of delegation addresses for certain key types and backend targets.
  --
  -- @since 2.0.0
  class PaymentAddress key
      => DelegationAddress key where
      -- | Convert a public key and a delegation key to a delegation 'Address' valid
      -- for the given network discrimination. Funds sent to this address will be
      -- delegated according to the delegation settings attached to the delegation
      -- key.
      --
      -- @since 2.0.0
      delegationAddress
          :: NetworkDiscriminant key
          ->  key 'PaymentK XPub
              -- ^ Payment key
          ->  key 'DelegationK XPub
              -- ^ Delegation key
          -> Address
  
  -- | A 'ChainPointer' type representing location of some object
  -- in the blockchain (eg., delegation certificate). This can be achieved
  -- unambiguously by specifying slot number, transaction index and the index
  -- in the object list (eg., certification list).
  -- For delegation certificates, alternatively, the delegation key can be used and
  -- then 'DelegationAddress' can be used.
  --
  -- @since 2.0.0
  data ChainPointer = ChainPointer
      { slotNum :: Natural
        -- ^ Pointer to the slot
      , transactionIndex :: Natural
        -- ^ transaction index
      , outputIndex :: Natural
        -- ^ output list index
      } deriving stock (Generic, Show, Eq, Ord)
  instance NFData ChainPointer
  
  instance ToJSON ChainPointer where
      toJSON ChainPointer{..} = object
          [ "slot_num" .= slotNum
          , "transaction_index" .= transactionIndex
          , "output_index" .= outputIndex
          ]
  
  -- | Encoding of pointer addresses for payment key type, pointer to delegation
  -- certificate in the blockchain and backend targets.
  --
  -- @since 2.0.0
  class PaymentAddress key
      => PointerAddress key where
      -- | Convert a payment public key and a pointer to delegation key in the
      -- blockchain to a delegation 'Address' valid for the given network
      -- discrimination. Funds sent to this address will be delegated according to
      -- the delegation settings attached to the delegation key located by
      -- 'ChainPointer'.
      --
      -- @since 2.0.0
      pointerAddress
          :: NetworkDiscriminant key
          ->  key 'PaymentK XPub
              -- ^ Payment key
          ->  ChainPointer
              -- ^ Pointer to locate delegation key in blockchain
          -> Address
  
  class HasNetworkDiscriminant (key :: Depth -> Type -> Type) where
      type NetworkDiscriminant key :: Type
  
      addressDiscrimination :: NetworkDiscriminant key -> AddressDiscrimination
      networkTag :: NetworkDiscriminant key -> NetworkTag
  
  -- | Magic constant associated with a given network. This is mainly used in two
  -- places:
  --
  -- (1) In 'Address' payloads, to discriminate addresses between networks.
  -- (2) At the network-level, when doing handshake with nodes.
  newtype NetworkTag
      = NetworkTag { unNetworkTag :: Word32 }
      deriving (Generic, Show, Eq)
  instance NFData NetworkTag
  
  instance ToJSON NetworkTag where
      toJSON (NetworkTag net) = Number (fromIntegral net)
  
  -- Describe requirements for address discrimination on the Byron era.
  data AddressDiscrimination
      = RequiresNetworkTag
      | RequiresNoTag
      deriving (Generic, Show, Eq)
  instance NFData AddressDiscrimination
  
  invariantSize :: HasCallStack => Int -> ByteString -> ByteString
  invariantSize expectedLength bytes
      | BS.length bytes == expectedLength = bytes
      | otherwise = error
        $ "length was "
        ++ show (BS.length bytes)
        ++ ", but expected to be "
        ++ (show expectedLength)
  
  invariantNetworkTag :: HasCallStack => Word32 -> NetworkTag -> Word8
  invariantNetworkTag limit (NetworkTag num)
      | num < limit = fromIntegral num
      | otherwise = error
        $ "network tag was "
        ++ show num
        ++ ", but expected to be less than "
        ++ show limit
  