{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Bitcoin.Miniscript.Text (
miniscriptToText,
) where
import Data.Text (Text)
import qualified Data.Text as Text
import Haskoin.Constants (Network)
import Haskoin.Util (encodeHex)
import Language.Bitcoin.Miniscript.Syntax (
Miniscript (..),
Value (..),
)
import Language.Bitcoin.Script.Descriptors (keyDescriptorToText)
import Language.Bitcoin.Utils (applicationText, showText)
miniscriptToText :: Network -> Miniscript -> Text
miniscriptToText :: Network -> Miniscript -> Text
miniscriptToText net :: Network
net = \case
Var n :: Text
n -> Text
n
Let n :: Text
n e :: Miniscript
e b :: Miniscript
b ->
"let " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Network -> Miniscript -> Text
miniscriptToText Network
net Miniscript
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Network -> Miniscript -> Text
miniscriptToText Network
net Miniscript
b
Boolean True -> "1"
Boolean False -> "0"
Number w :: Int
w -> Int -> Text
forall a. Show a => a -> Text
showText Int
w
Bytes b :: ByteString
b -> ByteString -> Text
encodeHex ByteString
b
KeyDesc k :: KeyDescriptor
k -> Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net KeyDescriptor
k
Key x :: Value KeyDescriptor
x -> Text -> Text -> Text
applicationText "pk_k" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
KeyH x :: Value KeyDescriptor
x -> Text -> Text -> Text
applicationText "pk_h" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
Older n :: Value Int
n -> Text -> Text -> Text
applicationText "older" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
After n :: Value Int
n -> Text -> Text -> Text
applicationText "after" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n
Sha256 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "sha256" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
Ripemd160 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "ripemd160" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
Hash256 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "hash256" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
Hash160 h :: Value ByteString
h -> Text -> Text -> Text
applicationText "hash160" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value ByteString -> Text
atomicBytesText Value ByteString
h
AndV x :: Miniscript
x (Boolean True) -> "t:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
OrI (Boolean False) x :: Miniscript
x -> "l:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
OrI x :: Miniscript
x (Boolean False) -> "u:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Miniscript -> Text
toText Miniscript
x
AndOr x :: Miniscript
x y :: Miniscript
y z :: Miniscript
z -> Text -> Text -> Text
applicationText "andor" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y, Miniscript
z]
AndV x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "and_v" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
AndB x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "and_b" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrB x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_b" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrC x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_c" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrD x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_d" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
OrI x :: Miniscript
x y :: Miniscript
y -> Text -> Text -> Text
applicationText "or_i" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Miniscript] -> Text
printList [Miniscript
x, Miniscript
y]
Thresh k :: Value Int
k x :: Miniscript
x xs :: [Miniscript]
xs ->
Text -> Text -> Text
applicationText "thresh" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate "," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Miniscript -> Text
toText (Miniscript -> Text) -> [Miniscript] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Miniscript
x Miniscript -> [Miniscript] -> [Miniscript]
forall a. a -> [a] -> [a]
: [Miniscript]
xs))
Multi n :: Value Int
n xs :: [Value KeyDescriptor]
xs ->
Text -> Text -> Text
applicationText "multi" (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate "," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Value Int -> Text
atomicNumberText Value Int
n Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Value KeyDescriptor -> Text
atomicKeyDescText (Value KeyDescriptor -> Text) -> [Value KeyDescriptor] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value KeyDescriptor]
xs)
a :: Miniscript
a -> [Char] -> Miniscript -> Text
ann "" Miniscript
a
where
ann :: [Char] -> Miniscript -> Text
ann as :: [Char]
as = \case
AnnC (Key x :: Value KeyDescriptor
x) -> [Char] -> Text -> Text
printAnn [Char]
as (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText "pk" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
AnnC (KeyH x :: Value KeyDescriptor
x) -> [Char] -> Text -> Text
printAnn [Char]
as (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
applicationText "pkh" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor -> Text
atomicKeyDescText Value KeyDescriptor
x
AnnA x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('a' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnS x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('s' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnC x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('c' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnD x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('d' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnV x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('v' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnJ x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('j' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
AnnN x :: Miniscript
x -> [Char] -> Miniscript -> Text
ann ('n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
as) Miniscript
x
e :: Miniscript
e -> [Char] -> Text -> Text
printAnn [Char]
as (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Miniscript -> Text
toText Miniscript
e
printAnn :: [Char] -> Text -> Text
printAnn as :: [Char]
as x :: Text
x
| [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
as = Text
x
| Bool
otherwise = [Char] -> Text
Text.pack ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
as) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
printList :: [Miniscript] -> Text
printList = Text -> [Text] -> Text
Text.intercalate "," ([Text] -> Text)
-> ([Miniscript] -> [Text]) -> [Miniscript] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Miniscript -> Text) -> [Miniscript] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Miniscript -> Text
toText
toText :: Miniscript -> Text
toText = Network -> Miniscript -> Text
miniscriptToText Network
net
atomicNumberText :: Value Int -> Text
atomicNumberText = (Int -> Text) -> Value Int -> Text
forall t. (t -> Text) -> Value t -> Text
atomicText Int -> Text
forall a. Show a => a -> Text
showText
atomicBytesText :: Value ByteString -> Text
atomicBytesText = (ByteString -> Text) -> Value ByteString -> Text
forall t. (t -> Text) -> Value t -> Text
atomicText ByteString -> Text
encodeHex
atomicKeyDescText :: Value KeyDescriptor -> Text
atomicKeyDescText = (KeyDescriptor -> Text) -> Value KeyDescriptor -> Text
forall t. (t -> Text) -> Value t -> Text
atomicText (Network -> KeyDescriptor -> Text
keyDescriptorToText Network
net)
atomicText :: (t -> Text) -> Value t -> Text
atomicText f :: t -> Text
f = \case
Variable name :: Text
name -> Text
name
Lit x :: t
x -> t -> Text
f t
x