{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Haskoin.Address
( Address(..)
, isPubKeyAddress
, isScriptAddress
, isWitnessPubKeyAddress
, isWitnessScriptAddress
, addrToString
, stringToAddr
, addrToJSON
, addrFromJSON
, pubKeyAddr
, pubKeyWitnessAddr
, p2pkhAddr
, p2wpkhAddr
, p2shAddr
, p2wshAddr
, inputAddress
, outputAddress
, addressToScript
, addressToScriptBS
, addressToOutput
, payToScriptAddress
, payToWitnessScriptAddress
, scriptToAddress
, scriptToAddressBS
, fromWif
, toWif
) where
import Control.Applicative
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.Maybe
import Data.Serialize as S
import Data.Text (Text)
import GHC.Generics (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
data Address
= PubKeyAddress { getAddrHash160 :: !Hash160
}
| ScriptAddress { getAddrHash160 :: !Hash160
}
| WitnessPubKeyAddress { getAddrHash160 :: !Hash160
}
| WitnessScriptAddress { getAddrHash256 :: !Hash256
}
deriving (Eq, Generic, Show, Read, Serialize)
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
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
| x == getScriptPrefix net = return $ ScriptAddress a
| otherwise = fail "Does not recognize address prefix"
base58put :: Network -> Putter Address
base58put net (PubKeyAddress h) = do
putWord8 (getAddrPrefix net)
put h
base58put net (ScriptAddress h) = do
putWord8 (getScriptPrefix net)
put h
base58put _ _ = error "Cannot serialize this address as Base58"
addrToJSON :: Network -> Address -> Value
addrToJSON net = String . addrToString net
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 :: Network -> Address -> Text
addrToString net a@PubKeyAddress {getAddrHash160 = h}
| isNothing (getCashAddrPrefix net) =
encodeBase58Check $ runPut $ base58put net a
| otherwise =
fromMaybe (error "Colud not encode a CashAddr") $
cashAddrEncode net 0 (S.encode h)
addrToString net a@ScriptAddress {getAddrHash160 = h}
| isNothing (getCashAddrPrefix net) =
encodeBase58Check $ runPut $ base58put net a
| otherwise =
fromMaybe (error "Could not encode a CashAddr") $
cashAddrEncode net 1 (S.encode h)
addrToString net WitnessPubKeyAddress {getAddrHash160 = h} =
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 net WitnessScriptAddress {getAddrHash256 = h} =
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
1 -> do
h <- eitherToMaybe (S.decode bs')
return $ ScriptAddress h
_ -> 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
32 -> do
h <- eitherToMaybe (S.decode bs'')
return $ WitnessScriptAddress h
_ -> Nothing
pubKeyAddr :: PubKeyI -> Address
pubKeyAddr = PubKeyAddress . addressHash . S.encode
p2pkhAddr :: Hash160 -> Address
p2pkhAddr = PubKeyAddress
pubKeyWitnessAddr :: PubKeyI -> Address
pubKeyWitnessAddr = WitnessPubKeyAddress . addressHash . S.encode
p2wpkhAddr :: Hash160 -> Address
p2wpkhAddr = WitnessPubKeyAddress
p2shAddr :: Hash160 -> Address
p2shAddr = ScriptAddress
p2wshAddr :: Hash256 -> Address
p2wshAddr = WitnessScriptAddress
payToScriptAddress :: ScriptOutput -> Address
payToScriptAddress = p2shAddr . addressHash . encodeOutputBS
payToWitnessScriptAddress :: ScriptOutput -> Address
payToWitnessScriptAddress = p2wshAddr . sha256 . encodeOutputBS
addressToOutput :: Address -> ScriptOutput
addressToOutput (PubKeyAddress h) = PayPKHash h
addressToOutput (ScriptAddress h) = PayScriptHash h
addressToOutput (WitnessPubKeyAddress h) = PayWitnessPKHash h
addressToOutput (WitnessScriptAddress h) = PayWitnessScriptHash h
addressToScript :: Address -> Script
addressToScript = encodeOutput . addressToOutput
addressToScriptBS :: Address -> ByteString
addressToScriptBS = S.encode . addressToScript
scriptToAddress :: Script -> Either String Address
scriptToAddress =
maybeToEither "Could not decode address" . outputAddress <=< decodeOutput
scriptToAddressBS :: ByteString -> Either String Address
scriptToAddressBS =
maybeToEither "Could not decode address" . outputAddress <=< decodeOutputBS
outputAddress :: ScriptOutput -> Maybe Address
outputAddress (PayPKHash h) = Just $ PubKeyAddress h
outputAddress (PayScriptHash h) = Just $ ScriptAddress h
outputAddress (PayPK k) = Just $ pubKeyAddr k
outputAddress (PayWitnessPKHash h) = Just $ WitnessPubKeyAddress h
outputAddress (PayWitnessScriptHash h) = Just $ WitnessScriptAddress h
outputAddress _ = Nothing
inputAddress :: ScriptInput -> Maybe Address
inputAddress (RegularInput (SpendPKHash _ key)) = Just $ pubKeyAddr key
inputAddress (ScriptHashInput _ rdm) = Just $ payToScriptAddress rdm
inputAddress _ = Nothing
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