{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Bitcoin.Script.Descriptors.Text (
descriptorToText,
keyDescriptorToText,
) where
import Data.ByteString.Builder (
toLazyByteString,
word32BE,
)
import Data.ByteString.Lazy (toStrict)
import Data.Maybe (fromMaybe)
import Data.Text (
Text,
intercalate,
pack,
)
import Haskoin.Address (addrToText)
import Haskoin.Constants (Network)
import Haskoin.Keys (
PubKeyI (..),
exportPubKey,
pathToStr,
toWif,
xPubExport,
)
import Haskoin.Util (encodeHex)
import Language.Bitcoin.Script.Descriptors.Syntax
import Language.Bitcoin.Utils (
applicationText,
showText,
)
descriptorToText :: Network -> ScriptDescriptor -> Text
descriptorToText :: Network -> ScriptDescriptor -> Text
descriptorToText net :: Network
net = \case
Sh x :: ScriptDescriptor
x -> Text -> Text -> Text
applicationText "sh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
pd ScriptDescriptor
x
Wsh x :: ScriptDescriptor
x -> Text -> Text -> Text
applicationText "wsh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
pd ScriptDescriptor
x
Pk k :: KeyDescriptor
k -> Text -> Text -> Text
applicationText "pk" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
pk KeyDescriptor
k
Pkh k :: KeyDescriptor
k -> Text -> Text -> Text
applicationText "pkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
pk KeyDescriptor
k
Wpkh k :: KeyDescriptor
k -> Text -> Text -> Text
applicationText "wpkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
pk KeyDescriptor
k
Combo k :: KeyDescriptor
k -> Text -> Text -> Text
applicationText "combo" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
pk KeyDescriptor
k
Addr a :: Address
a -> Text -> Text -> Text
applicationText "addr" (Text -> Text) -> (Maybe Text -> Text) -> Maybe Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. a
addrErr (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Network -> Address -> Maybe Text
addrToText Network
net Address
a
Raw bs :: ByteString
bs -> Text -> Text -> Text
applicationText "raw" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHex ByteString
bs
Multi k :: Int
k ks :: [KeyDescriptor]
ks ->
Text -> Text -> Text
applicationText "multi" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate "," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showText Int
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (KeyDescriptor -> Text
pk (KeyDescriptor -> Text) -> [KeyDescriptor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyDescriptor]
ks)
SortedMulti k :: Int
k ks :: [KeyDescriptor]
ks ->
Text -> Text -> Text
applicationText "sortedmulti" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate "," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
showText Int
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (KeyDescriptor -> Text
pk (KeyDescriptor -> Text) -> [KeyDescriptor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyDescriptor]
ks)
where
pd :: ScriptDescriptor -> Text
pd = Network -> ScriptDescriptor -> Text
descriptorToText Network
net
pk :: KeyDescriptor -> Text
pk = Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net
addrErr :: a
addrErr = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "Unable to parse address"
keyDescriptorToText :: Network -> KeyDescriptor -> Text
keyDescriptorToText :: Network -> KeyDescriptor -> Text
keyDescriptorToText net :: Network
net (KeyDescriptor o :: Maybe Origin
o k :: Key
k) = Text -> (Origin -> Text) -> Maybe Origin -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty Origin -> Text
originText Maybe Origin
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
definitionText
where
originText :: Origin -> Text
originText (Origin fp :: Fingerprint
fp path :: DerivPath
path) = "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Fingerprint -> Text
fingerprintText Fingerprint
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (DerivPath -> [Char]
forall t. DerivPathI t -> [Char]
pathToStr DerivPath
path) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
definitionText :: Text
definitionText = case Key
k of
Pubkey (PubKeyI key :: PubKey
key c :: Bool
c) -> ByteString -> Text
encodeHex (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> PubKey -> ByteString
exportPubKey Bool
c PubKey
key
SecretKey key :: SecKeyI
key -> Network -> SecKeyI -> Text
toWif Network
net SecKeyI
key
XPub xpub :: XPubKey
xpub path :: DerivPath
path fam :: KeyCollection
fam -> Network -> XPubKey -> Text
xPubExport Network
net XPubKey
xpub Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> (DerivPath -> [Char]) -> DerivPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> [Char]
forall t. DerivPathI t -> [Char]
pathToStr) DerivPath
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KeyCollection -> Text
famText KeyCollection
fam
famText :: KeyCollection -> Text
famText = \case
Single -> ""
HardKeys -> "/*'"
SoftKeys -> "/*"
fingerprintText :: Fingerprint -> Text
fingerprintText = ByteString -> Text
encodeHex (ByteString -> Text)
-> (Fingerprint -> ByteString) -> Fingerprint -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Fingerprint -> ByteString) -> Fingerprint -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Fingerprint -> Builder) -> Fingerprint -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> Builder
word32BE