{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Convert descriptors to text
module Language.Bitcoin.Script.Descriptors.Text (
    descriptorToText,
    descriptorToTextWithChecksum,
    keyDescriptorToText,
) where

import Data.Maybe (fromMaybe)
import Data.Text (
    Text,
    intercalate,
    pack,
 )
import Haskoin (
    Network,
    PubKeyI (..),
    addrToText,
    encodeHex,
    exportPubKey,
    fingerprintToText,
    pathToStr,
    toWif,
    xPubExport,
 )

import Language.Bitcoin.Script.Descriptors.Checksum (descriptorChecksum)
import Language.Bitcoin.Script.Descriptors.Syntax
import Language.Bitcoin.Utils (
    applicationText,
    showText,
 )

descriptorToText :: Network -> OutputDescriptor -> Text
descriptorToText :: Network -> OutputDescriptor -> Text
descriptorToText Network
net = \case
    ScriptPubKey ScriptDescriptor
x -> ScriptDescriptor -> Text
sdToText ScriptDescriptor
x
    P2SH ScriptDescriptor
x -> Text -> Text -> Text
applicationText Text
"sh" forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
sdToText ScriptDescriptor
x
    P2WPKH KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"wpkh" forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    P2WSH ScriptDescriptor
x -> Text -> Text -> Text
applicationText Text
"wsh" forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
sdToText ScriptDescriptor
x
    WrappedWPkh KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"sh" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
applicationText Text
"wpkh" forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    WrappedWSh ScriptDescriptor
x -> Text -> Text -> Text
applicationText Text
"sh" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
applicationText Text
"wsh" forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
sdToText ScriptDescriptor
x
    Combo KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"combo" forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    Addr Address
a -> Text -> Text -> Text
applicationText Text
"addr" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
addrErr forall a b. (a -> b) -> a -> b
$ Network -> Address -> Maybe Text
addrToText Network
net Address
a
  where
    sdToText :: ScriptDescriptor -> Text
sdToText = Network -> ScriptDescriptor -> Text
scriptDescriptorToText Network
net
    keyToText :: KeyDescriptor -> Text
keyToText = Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net

    addrErr :: a
addrErr = forall a. HasCallStack => [Char] -> a
error [Char]
"Unable to parse address"

descriptorToTextWithChecksum :: Network -> OutputDescriptor -> Text
descriptorToTextWithChecksum :: Network -> OutputDescriptor -> Text
descriptorToTextWithChecksum Network
net OutputDescriptor
desc =
    Text
descText forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
"#" forall a. Semigroup a => a -> a -> a
<>) (Text -> Maybe Text
descriptorChecksum Text
descText)
  where
    descText :: Text
descText = Network -> OutputDescriptor -> Text
descriptorToText Network
net OutputDescriptor
desc

scriptDescriptorToText :: Network -> ScriptDescriptor -> Text
scriptDescriptorToText :: Network -> ScriptDescriptor -> Text
scriptDescriptorToText Network
net = \case
    Pk KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"pk" forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    Pkh KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"pkh" forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    Raw ByteString
bs -> Text -> Text -> Text
applicationText Text
"raw" forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHex ByteString
bs
    Multi Int
k [KeyDescriptor]
ks ->
        Text -> Text -> Text
applicationText Text
"multi" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
showText Int
k forall a. a -> [a] -> [a]
: (KeyDescriptor -> Text
keyToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyDescriptor]
ks)
    SortedMulti Int
k [KeyDescriptor]
ks ->
        Text -> Text -> Text
applicationText Text
"sortedmulti" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
showText Int
k forall a. a -> [a] -> [a]
: (KeyDescriptor -> Text
keyToText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyDescriptor]
ks)
  where
    keyToText :: KeyDescriptor -> Text
keyToText = Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net

keyDescriptorToText :: Network -> KeyDescriptor -> Text
keyDescriptorToText :: Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net (KeyDescriptor Maybe Origin
o Key
k) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Origin -> Text
originText Maybe Origin
o forall a. Semigroup a => a -> a -> a
<> Text
definitionText
  where
    originText :: Origin -> Text
originText (Origin Fingerprint
fp DerivPath
path) = Text
"[" forall a. Semigroup a => a -> a -> a
<> Fingerprint -> Text
fingerprintToText Fingerprint
fp forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall t. DerivPathI t -> [Char]
pathToStr DerivPath
path) forall a. Semigroup a => a -> a -> a
<> Text
"]"

    definitionText :: Text
definitionText = case Key
k of
        Pubkey (PubKeyI PubKey
key Bool
c) -> ByteString -> Text
encodeHex forall a b. (a -> b) -> a -> b
$ Bool -> PubKey -> ByteString
exportPubKey Bool
c PubKey
key
        SecretKey SecKeyI
key -> Network -> SecKeyI -> Text
toWif Network
net SecKeyI
key
        XPub XPubKey
xpub DerivPath
path KeyCollection
fam -> Network -> XPubKey -> Text
xPubExport Network
net XPubKey
xpub forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> [Char]
pathToStr) DerivPath
path forall a. Semigroup a => a -> a -> a
<> KeyCollection -> Text
famText KeyCollection
fam

    famText :: KeyCollection -> Text
famText = \case
        KeyCollection
Single -> Text
""
        KeyCollection
HardKeys -> Text
"/*'"
        KeyCollection
SoftKeys -> Text
"/*"