{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- This module provides the main 'Address' data type used by the wallet.
--
module Cardano.Wallet.Primitive.Types.Address
    ( Address (..)
    , AddressState (..)
    ) where

import Prelude

import Control.DeepSeq
    ( NFData (..) )
import Data.Bifunctor
    ( bimap )
import Data.ByteArray.Encoding
    ( Base (Base16), convertFromBase, convertToBase )
import Data.ByteString
    ( ByteString )
import Data.Hashable
    ( Hashable )
import Data.Text.Class
    ( CaseStyle (..)
    , FromText (..)
    , TextDecodingError (..)
    , ToText (..)
    , fromTextToBoundedEnum
    , toTextFromBoundedEnum
    )
import Fmt
    ( Buildable (..), prefixF, suffixF )
import GHC.Generics
    ( Generic )
import Quiet
    ( Quiet (..) )

import qualified Data.Text.Encoding as T

-- | Representation of Cardano addresses.
--
-- Addresses are basically a human-friendly representation of public keys.
-- Historically in Cardano, there exist different sort of addresses, and new
-- ones are to come. So far, we can distinguish between three types of
-- address:
--
-- - Byron Random addresses, which holds a payload with derivation path details
-- - Byron Sequential addresses, also known as Icarus'style addresses
-- - Shelley base addresses, see also [implementation-decisions/address](https://github.com/input-output-hk/implementation-decisions/blob/master/text/0001-address.md)
--
-- For more details, see also [About Address Derivation](https://github.com/input-output-hk/cardano-wallet/wiki/About-Address-Derivation)
--
-- Shelley base addresses can be divided into two types:
--
-- - Single Addresses: which only hold a public spending key
-- - Group Addresses: which hold both a spending and delegation keys
--
-- It'll therefore seem legitimate to represent addresses as:
--
-- @
-- data Address
--   = ByronAddress !ByteString
--   | SingleAddress !XPub
--   | GroupAddress !XPub XPub
-- @
--
-- However, there's a major drawback to this approach:  we have to consider all
-- three constructors everywhere, and make sure we test every function using
-- them three despite having no need for such fine-grained representation.
--
-- Indeed, from the wallet core code, addresses are nothing more than an opaque
-- bunch of bytes that can be compared with each other. When signing
-- transactions, we have to look up addresses anyway and therefore can
-- re-derive their corresponding public keys. The only moment the distinction
-- between address types matters is when it comes to representing addresses at
-- the edge of the application (the API layer). And here, this is precisely
-- where we need to also what target backend we're connected to. Different
-- backends use different encodings which may not be compatible.
--
-- Therefore, for simplicity, it's easier to consider addresses as "bytes", and
-- only peak into these bytes whenever we need to do something with them. This
-- makes it fairly clear that addresses are just an opaque string for the wallet
-- layer and that the underlying encoding is rather agnostic to the underlying
-- backend.
--
newtype Address = Address
    { Address -> ByteString
unAddress :: ByteString
    }
    deriving ((forall x. Address -> Rep Address x)
-> (forall x. Rep Address x -> Address) -> Generic Address
forall x. Rep Address x -> Address
forall x. Address -> Rep Address x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Address x -> Address
$cfrom :: forall x. Address -> Rep Address x
Generic, Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c== :: Address -> Address -> Bool
Eq, Eq Address
Eq Address
-> (Address -> Address -> Ordering)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Address)
-> (Address -> Address -> Address)
-> Ord Address
Address -> Address -> Bool
Address -> Address -> Ordering
Address -> Address -> Address
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Address -> Address -> Address
$cmin :: Address -> Address -> Address
max :: Address -> Address -> Address
$cmax :: Address -> Address -> Address
>= :: Address -> Address -> Bool
$c>= :: Address -> Address -> Bool
> :: Address -> Address -> Bool
$c> :: Address -> Address -> Bool
<= :: Address -> Address -> Bool
$c<= :: Address -> Address -> Bool
< :: Address -> Address -> Bool
$c< :: Address -> Address -> Bool
compare :: Address -> Address -> Ordering
$ccompare :: Address -> Address -> Ordering
$cp1Ord :: Eq Address
Ord)
    deriving anyclass (Address -> ()
(Address -> ()) -> NFData Address
forall a. (a -> ()) -> NFData a
rnf :: Address -> ()
$crnf :: Address -> ()
NFData, Int -> Address -> Int
Address -> Int
(Int -> Address -> Int) -> (Address -> Int) -> Hashable Address
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Address -> Int
$chash :: Address -> Int
hashWithSalt :: Int -> Address -> Int
$chashWithSalt :: Int -> Address -> Int
Hashable)
    deriving (ReadPrec [Address]
ReadPrec Address
Int -> ReadS Address
ReadS [Address]
(Int -> ReadS Address)
-> ReadS [Address]
-> ReadPrec Address
-> ReadPrec [Address]
-> Read Address
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Address]
$creadListPrec :: ReadPrec [Address]
readPrec :: ReadPrec Address
$creadPrec :: ReadPrec Address
readList :: ReadS [Address]
$creadList :: ReadS [Address]
readsPrec :: Int -> ReadS Address
$creadsPrec :: Int -> ReadS Address
Read, Int -> Address -> ShowS
[Address] -> ShowS
Address -> String
(Int -> Address -> ShowS)
-> (Address -> String) -> ([Address] -> ShowS) -> Show Address
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Address] -> ShowS
$cshowList :: [Address] -> ShowS
show :: Address -> String
$cshow :: Address -> String
showsPrec :: Int -> Address -> ShowS
$cshowsPrec :: Int -> Address -> ShowS
Show) via (Quiet Address)

instance Buildable Address where
    build :: Address -> Builder
build Address
addr = Builder
forall a. Monoid a => a
mempty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
prefixF Int
8 Builder
addrF
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"..."
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
suffixF Int
8 Builder
addrF
      where
        addrF :: Builder
addrF = Text -> Builder
forall p. Buildable p => p -> Builder
build (Address -> Text
forall a. ToText a => a -> Text
toText Address
addr)

instance ToText Address where
    toText :: Address -> Text
toText = ByteString -> Text
T.decodeUtf8
        (ByteString -> Text) -> (Address -> ByteString) -> Address -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16
        (ByteString -> ByteString)
-> (Address -> ByteString) -> Address -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> ByteString
unAddress

instance FromText Address where
    fromText :: Text -> Either TextDecodingError Address
fromText = (String -> TextDecodingError)
-> (ByteString -> Address)
-> Either String ByteString
-> Either TextDecodingError Address
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> TextDecodingError
textDecodingError ByteString -> Address
Address
        (Either String ByteString -> Either TextDecodingError Address)
-> (Text -> Either String ByteString)
-> Text
-> Either TextDecodingError Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16
        (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
      where
        textDecodingError :: String -> TextDecodingError
textDecodingError = String -> TextDecodingError
TextDecodingError (String -> TextDecodingError)
-> ShowS -> String -> TextDecodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show

-- | Denotes if an address has been previously used or not... whether that be
-- in the output of a transaction on the blockchain or one in our pending set.
data AddressState = Used | Unused
    deriving (AddressState
AddressState -> AddressState -> Bounded AddressState
forall a. a -> a -> Bounded a
maxBound :: AddressState
$cmaxBound :: AddressState
minBound :: AddressState
$cminBound :: AddressState
Bounded, Int -> AddressState
AddressState -> Int
AddressState -> [AddressState]
AddressState -> AddressState
AddressState -> AddressState -> [AddressState]
AddressState -> AddressState -> AddressState -> [AddressState]
(AddressState -> AddressState)
-> (AddressState -> AddressState)
-> (Int -> AddressState)
-> (AddressState -> Int)
-> (AddressState -> [AddressState])
-> (AddressState -> AddressState -> [AddressState])
-> (AddressState -> AddressState -> [AddressState])
-> (AddressState -> AddressState -> AddressState -> [AddressState])
-> Enum AddressState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AddressState -> AddressState -> AddressState -> [AddressState]
$cenumFromThenTo :: AddressState -> AddressState -> AddressState -> [AddressState]
enumFromTo :: AddressState -> AddressState -> [AddressState]
$cenumFromTo :: AddressState -> AddressState -> [AddressState]
enumFromThen :: AddressState -> AddressState -> [AddressState]
$cenumFromThen :: AddressState -> AddressState -> [AddressState]
enumFrom :: AddressState -> [AddressState]
$cenumFrom :: AddressState -> [AddressState]
fromEnum :: AddressState -> Int
$cfromEnum :: AddressState -> Int
toEnum :: Int -> AddressState
$ctoEnum :: Int -> AddressState
pred :: AddressState -> AddressState
$cpred :: AddressState -> AddressState
succ :: AddressState -> AddressState
$csucc :: AddressState -> AddressState
Enum, AddressState -> AddressState -> Bool
(AddressState -> AddressState -> Bool)
-> (AddressState -> AddressState -> Bool) -> Eq AddressState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressState -> AddressState -> Bool
$c/= :: AddressState -> AddressState -> Bool
== :: AddressState -> AddressState -> Bool
$c== :: AddressState -> AddressState -> Bool
Eq, (forall x. AddressState -> Rep AddressState x)
-> (forall x. Rep AddressState x -> AddressState)
-> Generic AddressState
forall x. Rep AddressState x -> AddressState
forall x. AddressState -> Rep AddressState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddressState x -> AddressState
$cfrom :: forall x. AddressState -> Rep AddressState x
Generic, Int -> AddressState -> ShowS
[AddressState] -> ShowS
AddressState -> String
(Int -> AddressState -> ShowS)
-> (AddressState -> String)
-> ([AddressState] -> ShowS)
-> Show AddressState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressState] -> ShowS
$cshowList :: [AddressState] -> ShowS
show :: AddressState -> String
$cshow :: AddressState -> String
showsPrec :: Int -> AddressState -> ShowS
$cshowsPrec :: Int -> AddressState -> ShowS
Show)

instance FromText AddressState where
    fromText :: Text -> Either TextDecodingError AddressState
fromText = CaseStyle -> Text -> Either TextDecodingError AddressState
forall a.
(Bounded a, Enum a, Show a) =>
CaseStyle -> Text -> Either TextDecodingError a
fromTextToBoundedEnum CaseStyle
SnakeLowerCase

instance ToText AddressState where
    toText :: AddressState -> Text
toText = CaseStyle -> AddressState -> Text
forall a. (Bounded a, Enum a, Show a) => CaseStyle -> a -> Text
toTextFromBoundedEnum CaseStyle
SnakeLowerCase

instance Buildable AddressState where
    build :: AddressState -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder)
-> (AddressState -> Text) -> AddressState -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressState -> Text
forall a. ToText a => a -> Text
toText

instance NFData AddressState