{-# 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 -> 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