Text.hs

{-# 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 net = \case
    Sh x -> applicationText "sh" $ pd x
    Wsh x -> applicationText "wsh" $ pd x
    Pk k -> applicationText "pk" $ pk k
    Pkh k -> applicationText "pkh" $ pk k
    Wpkh k -> applicationText "wpkh" $ pk k
    Combo k -> applicationText "combo" $ pk k
    Addr a -> applicationText "addr" . fromMaybe addrErr $ addrToText net a
    Raw bs -> applicationText "raw" $ encodeHex bs
    Multi k ks ->
        applicationText "multi" . intercalate "," $ showText k : (pk <$> ks)
    SortedMulti k ks ->
        applicationText "sortedmulti" . intercalate "," $ showText k : (pk <$> ks)
  where
    pd = descriptorToText net
    pk = keyDescriptorToText net

    addrErr = error "Unable to parse address"

keyDescriptorToText :: Network -> KeyDescriptor -> Text
keyDescriptorToText net (KeyDescriptor o k) = maybe mempty originText o <> definitionText
  where
    originText (Origin fp path) = "[" <> fingerprintText fp <> pack (pathToStr path) <> "]"

    definitionText = case k of
        Pubkey (PubKeyI key c) -> encodeHex $ exportPubKey c key
        SecretKey key -> toWif net key
        XPub xpub path fam -> xPubExport net xpub <> (pack . pathToStr) path <> famText fam

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

    fingerprintText = encodeHex . toStrict . toLazyByteString . word32BE