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

-- | Convert descriptors to text
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 -> 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" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
sdToText ScriptDescriptor
x
    P2WPKH KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"wpkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    P2WSH ScriptDescriptor
x -> Text -> Text -> Text
applicationText Text
"wsh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
sdToText ScriptDescriptor
x
    WrappedWPkh KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"sh" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
applicationText Text
"wpkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    WrappedWSh ScriptDescriptor
x -> Text -> Text -> Text
applicationText Text
"sh" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
applicationText Text
"wsh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ScriptDescriptor -> Text
sdToText ScriptDescriptor
x
    Combo KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"combo" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    Addr Address
a -> Text -> Text -> Text
applicationText Text
"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
  where
    sdToText :: ScriptDescriptor -> Text
sdToText = Network -> ScriptDescriptor -> Text
scriptDescriptorToText Network
net
    keyToText :: KeyDescriptor -> Text
keyToText = Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net

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

scriptDescriptorToText :: Network -> ScriptDescriptor -> Text
scriptDescriptorToText :: Network -> ScriptDescriptor -> Text
scriptDescriptorToText Network
net = \case
    Pk KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"pk" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    Pkh KeyDescriptor
k -> Text -> Text -> Text
applicationText Text
"pkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Text
keyToText KeyDescriptor
k
    Raw ByteString
bs -> Text -> Text -> Text
applicationText Text
"raw" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHex ByteString
bs
    Multi Int
k [KeyDescriptor]
ks ->
        Text -> Text -> Text
applicationText Text
"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] -> 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
keyToText (KeyDescriptor -> Text) -> [KeyDescriptor] -> [Text]
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" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate Text
"," ([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
keyToText (KeyDescriptor -> Text) -> [KeyDescriptor] -> [Text]
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) = 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 Fingerprint
fp DerivPath
path) = Text
"[" 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
<> Text
"]"

    definitionText :: Text
definitionText = case Key
k of
        Pubkey (PubKeyI PubKey
key 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 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 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
        KeyCollection
Single -> Text
""
        KeyCollection
HardKeys -> Text
"/*'"
        KeyCollection
SoftKeys -> Text
"/*"

    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