{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Haskoin.Address
( Address
, getAddrHash160
, getAddrHash256
, getAddrNet
, isPubKeyAddress
, isScriptAddress
, isWitnessPubKeyAddress
, isWitnessScriptAddress
, addrToString
, stringToAddr
, addrFromJSON
, pubKeyAddr
, pubKeyWitnessAddr
, p2pkhAddr
, p2wpkhAddr
, p2shAddr
, p2wshAddr
, inputAddress
, outputAddress
, addressToScript
, addressToScriptBS
, addressToOutput
, payToScriptAddress
, payToWitnessScriptAddress
, scriptToAddress
, scriptToAddressBS
, fromWif
, toWif
) where
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Data.Aeson as A
import Data.Aeson.Types
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Function
import Data.Hashable
import Data.List
import Data.Maybe
import Data.Serialize as S
import Data.String.Conversions
import Data.Text (Text)
import GHC.Generics as G (Generic)
import Network.Haskoin.Address.Base58
import Network.Haskoin.Address.Bech32
import Network.Haskoin.Address.CashAddr
import Network.Haskoin.Constants
import Network.Haskoin.Crypto
import Network.Haskoin.Keys.Common
import Network.Haskoin.Script
import Network.Haskoin.Util
import Text.Read as R
data Address
= PubKeyAddress { getAddrHash160 :: !Hash160
, getAddrNet :: !Network
}
| ScriptAddress { getAddrHash160 :: !Hash160
, getAddrNet :: !Network
}
| WitnessPubKeyAddress { getAddrHash160 :: !Hash160
, getAddrNet :: !Network
}
| WitnessScriptAddress { getAddrHash256 :: !Hash256
, getAddrNet :: !Network
}
deriving (Eq, G.Generic)
instance Serialize Address where
put a = do
put $ getAddrNet a
let bs = addressToScriptBS a
put $ B.length bs
putByteString bs
get = do
net <- S.get
bs <- getByteString =<< S.get
case scriptToAddressBS net bs of
Nothing -> fail "Could not decode address"
Just a -> return a
instance Hashable Address where
hashWithSalt i (PubKeyAddress h _) = i `hashWithSalt` h
hashWithSalt i (ScriptAddress h _) = i `hashWithSalt` h
hashWithSalt i (WitnessPubKeyAddress h _) = i `hashWithSalt` h
hashWithSalt i (WitnessScriptAddress h _) = i `hashWithSalt` h
hash (PubKeyAddress h _) = hash h
hash (ScriptAddress h _) = hash h
hash (WitnessPubKeyAddress h _) = hash h
hash (WitnessScriptAddress h _) = hash h
instance Ord Address where
compare = compare `on` f
where
f (PubKeyAddress h _) = S.encode h
f (ScriptAddress h _) = S.encode h
f (WitnessPubKeyAddress h _) = S.encode h
f (WitnessScriptAddress h _) = S.encode h
instance NFData Address
isPubKeyAddress :: Address -> Bool
isPubKeyAddress PubKeyAddress {} = True
isPubKeyAddress _ = False
isScriptAddress :: Address -> Bool
isScriptAddress ScriptAddress {} = True
isScriptAddress _ = False
isWitnessPubKeyAddress :: Address -> Bool
isWitnessPubKeyAddress WitnessPubKeyAddress {} = True
isWitnessPubKeyAddress _ = False
isWitnessScriptAddress :: Address -> Bool
isWitnessScriptAddress WitnessScriptAddress {} = True
isWitnessScriptAddress _ = False
base58get :: Network -> Get Address
base58get net = do
pfx <- getWord8
addr <- S.get
f pfx addr
where
f x a
| x == getAddrPrefix net = return (PubKeyAddress a net)
| x == getScriptPrefix net = return (ScriptAddress a net)
| otherwise = fail "Does not recognize address prefix"
base58put :: Putter Address
base58put (PubKeyAddress h net) = do
putWord8 (getAddrPrefix net)
put h
base58put (ScriptAddress h net) = do
putWord8 (getScriptPrefix net)
put h
base58put _ = error "Cannot serialize this address as Base58"
instance Show Address where
showsPrec _ a = shows (addrToString a)
instance Read Address where
readPrec = do
R.String str <- lexP
let bs = cs str
maybe pfail return $
foldl' (\a n -> a <|> stringToAddr n bs) Nothing allNets
instance ToJSON Address where
toJSON = A.String . addrToString
addrFromJSON :: Network -> Value -> Parser Address
addrFromJSON net =
withText "address" $ \t ->
case stringToAddr net t of
Nothing -> fail "could not decode address"
Just x -> return x
addrToString :: Address -> Text
addrToString a@PubKeyAddress {getAddrHash160 = h, getAddrNet = net}
| isNothing (getCashAddrPrefix net) =
encodeBase58Check $ runPut $ base58put a
| otherwise =
fromMaybe (error "Colud not encode a CashAddr") $
cashAddrEncode net 0 (S.encode h)
addrToString a@ScriptAddress {getAddrHash160 = h, getAddrNet = net}
| isNothing (getCashAddrPrefix net) =
encodeBase58Check $ runPut $ base58put a
| otherwise =
fromMaybe (error "Could not encode a CashAddr") $
cashAddrEncode net 1 (S.encode h)
addrToString WitnessPubKeyAddress {getAddrHash160 = h, getAddrNet = net} =
let mt = do
hrp <- getBech32Prefix net
segwitEncode hrp 0 (B.unpack (S.encode h))
in fromMaybe (error "Could not encode a Bech32 address") mt
addrToString WitnessScriptAddress {getAddrHash256 = h, getAddrNet = net} =
let mt = do
hrp <- getBech32Prefix net
segwitEncode hrp 0 (B.unpack (S.encode h))
in fromMaybe (error "Could not encode a Bech32 address") mt
stringToAddr :: Network -> Text -> Maybe Address
stringToAddr net bs = cash <|> segwit <|> b58
where
b58 = eitherToMaybe . runGet (base58get net) =<< decodeBase58Check bs
cash = cashAddrDecode net bs >>= \(ver, bs') -> case ver of
0 -> do
h <- eitherToMaybe (S.decode bs')
return $ PubKeyAddress h net
1 -> do
h <- eitherToMaybe (S.decode bs')
return $ ScriptAddress h net
_ -> Nothing
segwit = do
hrp <- getBech32Prefix net
(ver, bs') <- segwitDecode hrp bs
guard (ver == 0)
let bs'' = B.pack bs'
case B.length bs'' of
20 -> do
h <- eitherToMaybe (S.decode bs'')
return $ WitnessPubKeyAddress h net
32 -> do
h <- eitherToMaybe (S.decode bs'')
return $ WitnessScriptAddress h net
_ -> Nothing
pubKeyAddr :: Network -> PubKeyI -> Address
pubKeyAddr net k = PubKeyAddress (addressHash (S.encode k)) net
p2pkhAddr :: Network -> Hash160 -> Address
p2pkhAddr net h = PubKeyAddress h net
pubKeyWitnessAddr :: Network -> PubKeyI -> Maybe Address
pubKeyWitnessAddr net k
| getSegWit net = Just $ WitnessPubKeyAddress (addressHash (S.encode k)) net
| otherwise = Nothing
p2wpkhAddr :: Network -> Hash160 -> Maybe Address
p2wpkhAddr net h
| getSegWit net = Just $ WitnessPubKeyAddress h net
| otherwise = Nothing
p2shAddr :: Network -> Hash160 -> Address
p2shAddr net h = ScriptAddress h net
p2wshAddr :: Network -> Hash256 -> Maybe Address
p2wshAddr net h
| getSegWit net = Just $ WitnessScriptAddress h net
| otherwise = Nothing
payToScriptAddress :: Network -> ScriptOutput -> Address
payToScriptAddress net out = p2shAddr net (addressHash (encodeOutputBS out))
payToWitnessScriptAddress :: Network -> ScriptOutput -> Maybe Address
payToWitnessScriptAddress net out = p2wshAddr net (sha256 (encodeOutputBS out))
addressToOutput :: Address -> ScriptOutput
addressToOutput a
| isPubKeyAddress a = PayPKHash (getAddrHash160 a)
| isScriptAddress a = PayScriptHash (getAddrHash160 a)
| isWitnessPubKeyAddress a = PayWitnessPKHash (getAddrHash160 a)
| isWitnessScriptAddress a = PayWitnessScriptHash (getAddrHash256 a)
| otherwise = undefined
addressToScript :: Address -> Script
addressToScript = encodeOutput . addressToOutput
addressToScriptBS :: Address -> ByteString
addressToScriptBS = S.encode . addressToScript
scriptToAddress :: Network -> Script -> Maybe Address
scriptToAddress net = eitherToMaybe . (outputAddress net <=< decodeOutput)
scriptToAddressBS :: Network -> ByteString -> Maybe Address
scriptToAddressBS net = eitherToMaybe . (outputAddress net <=< decodeOutputBS)
outputAddress :: Network -> ScriptOutput -> Either String Address
outputAddress net s =
case s of
PayPKHash h -> Right $ p2pkhAddr net h
PayScriptHash h -> Right $ p2shAddr net h
PayPK k -> Right $ pubKeyAddr net k
PayWitnessPKHash h ->
maybeToEither "outputAddress: segwit not supported in this network" $
p2wpkhAddr net h
PayWitnessScriptHash h ->
maybeToEither "outputAddress: segwit not supported in this network" $
p2wshAddr net h
_ -> Left "outputAddress: bad output script type"
inputAddress :: Network -> ScriptInput -> Either String Address
inputAddress net s = case s of
RegularInput (SpendPKHash _ key) -> return $ pubKeyAddr net key
ScriptHashInput _ rdm -> return $ payToScriptAddress net rdm
_ -> Left "inputAddress: bad input script type"
fromWif :: Network -> Base58 -> Maybe SecKeyI
fromWif net wif = do
bs <- decodeBase58Check wif
guard (B.head bs == getSecretPrefix net)
case B.length bs of
33 -> wrapSecKey False <$> secKey (B.tail bs)
34 -> do
guard $ B.last bs == 0x01
wrapSecKey True <$> secKey (B.tail $ B.init bs)
_ -> Nothing
toWif :: Network -> SecKeyI -> Base58
toWif net (SecKeyI k c) =
encodeBase58Check . B.cons (getSecretPrefix net) $
if c
then getSecKey k `B.snoc` 0x01
else getSecKey k