{-# LANGUAGE OverloadedStrings #-} module Language.Bitcoin.Script.Descriptors.Parser ( parseDescriptor, descriptorParser, parseKeyDescriptor, keyDescriptorParser, ) where import Control.Applicative (optional, (<|>)) import Data.Attoparsec.Text (Parser) import qualified Data.Attoparsec.Text as A import Data.Bool (bool) import qualified Data.ByteString as BS import Data.Maybe (isJust) import Data.Text (Text, pack) import Haskoin.Address (textToAddr) import Haskoin.Constants (Network) import Haskoin.Keys ( DerivPath, DerivPathI (..), fromWif, importPubKey, wrapPubKey, xPubImport, ) import Language.Bitcoin.Script.Descriptors.Syntax import Language.Bitcoin.Utils ( alphanum, application, argList, brackets, comma, hex, maybeFail, ) parseDescriptor :: Network -> Text -> Either String ScriptDescriptor parseDescriptor :: Network -> Text -> Either String ScriptDescriptor parseDescriptor net :: Network net = Parser ScriptDescriptor -> Text -> Either String ScriptDescriptor forall a. Parser a -> Text -> Either String a A.parseOnly (Parser ScriptDescriptor -> Text -> Either String ScriptDescriptor) -> Parser ScriptDescriptor -> Text -> Either String ScriptDescriptor forall a b. (a -> b) -> a -> b $ Network -> Parser ScriptDescriptor descriptorParser Network net descriptorParser :: Network -> Parser ScriptDescriptor descriptorParser :: Network -> Parser ScriptDescriptor descriptorParser net :: Network net = Parser ScriptDescriptor shP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor wshP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor pkP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor pkhP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor wpkhP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor comboP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor rawP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor addrP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor multiP Parser ScriptDescriptor -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser ScriptDescriptor sortedMultiP where dp :: Parser ScriptDescriptor dp = Network -> Parser ScriptDescriptor descriptorParser Network net kp :: Parser KeyDescriptor kp = Network -> Parser KeyDescriptor keyDescriptorParser Network net shP :: Parser ScriptDescriptor shP = ScriptDescriptor -> ScriptDescriptor Sh (ScriptDescriptor -> ScriptDescriptor) -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall a. Text -> Parser a -> Parser a application "sh" Parser ScriptDescriptor dp wshP :: Parser ScriptDescriptor wshP = ScriptDescriptor -> ScriptDescriptor Wsh (ScriptDescriptor -> ScriptDescriptor) -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall a. Text -> Parser a -> Parser a application "wsh" Parser ScriptDescriptor dp pkP :: Parser ScriptDescriptor pkP = KeyDescriptor -> ScriptDescriptor Pk (KeyDescriptor -> ScriptDescriptor) -> Parser KeyDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Parser KeyDescriptor -> Parser KeyDescriptor forall a. Text -> Parser a -> Parser a application "pk" Parser KeyDescriptor kp pkhP :: Parser ScriptDescriptor pkhP = KeyDescriptor -> ScriptDescriptor Pkh (KeyDescriptor -> ScriptDescriptor) -> Parser KeyDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Parser KeyDescriptor -> Parser KeyDescriptor forall a. Text -> Parser a -> Parser a application "pkh" Parser KeyDescriptor kp wpkhP :: Parser ScriptDescriptor wpkhP = KeyDescriptor -> ScriptDescriptor Wpkh (KeyDescriptor -> ScriptDescriptor) -> Parser KeyDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Parser KeyDescriptor -> Parser KeyDescriptor forall a. Text -> Parser a -> Parser a application "wpkh" Parser KeyDescriptor kp comboP :: Parser ScriptDescriptor comboP = KeyDescriptor -> ScriptDescriptor Combo (KeyDescriptor -> ScriptDescriptor) -> Parser KeyDescriptor -> Parser ScriptDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Parser KeyDescriptor -> Parser KeyDescriptor forall a. Text -> Parser a -> Parser a application "combo" Parser KeyDescriptor kp rawP :: Parser ScriptDescriptor rawP = ByteString -> ScriptDescriptor Raw (ByteString -> ScriptDescriptor) -> Parser Text ByteString -> Parser ScriptDescriptor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Parser Text ByteString -> Parser Text ByteString forall a. Text -> Parser a -> Parser a application "raw" Parser Text ByteString hex addrP :: Parser ScriptDescriptor addrP = Text -> Parser String -> Parser String forall a. Text -> Parser a -> Parser a application "addr" (Parser Text Char -> Parser Text Char -> Parser String forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a] A.manyTill Parser Text Char A.anyChar (Parser Text Char -> Parser String) -> Parser Text Char -> Parser String forall a b. (a -> b) -> a -> b $ Char -> Parser Text Char A.char ')') Parser String -> (String -> Parser ScriptDescriptor) -> Parser ScriptDescriptor forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= String -> (Address -> ScriptDescriptor) -> Maybe Address -> Parser ScriptDescriptor forall a b. String -> (a -> b) -> Maybe a -> Parser b maybeFail "descriptorParser: unable to parse address" Address -> ScriptDescriptor Addr (Maybe Address -> Parser ScriptDescriptor) -> (String -> Maybe Address) -> String -> Parser ScriptDescriptor forall b c a. (b -> c) -> (a -> b) -> a -> c . Network -> Text -> Maybe Address textToAddr Network net (Text -> Maybe Address) -> (String -> Text) -> String -> Maybe Address forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text pack multiP :: Parser ScriptDescriptor multiP = Text -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall a. Text -> Parser a -> Parser a application "multi" (Parser ScriptDescriptor -> Parser ScriptDescriptor) -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall a b. (a -> b) -> a -> b $ Int -> [KeyDescriptor] -> ScriptDescriptor Multi (Int -> [KeyDescriptor] -> ScriptDescriptor) -> Parser Text Int -> Parser Text ([KeyDescriptor] -> ScriptDescriptor) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Int forall a. Integral a => Parser a A.decimal Parser Text ([KeyDescriptor] -> ScriptDescriptor) -> Parser Text [KeyDescriptor] -> Parser ScriptDescriptor forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Text [KeyDescriptor] -> Parser Text [KeyDescriptor] forall a. Parser a -> Parser a comma Parser Text [KeyDescriptor] keyList sortedMultiP :: Parser ScriptDescriptor sortedMultiP = Text -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall a. Text -> Parser a -> Parser a application "sortedmulti" (Parser ScriptDescriptor -> Parser ScriptDescriptor) -> Parser ScriptDescriptor -> Parser ScriptDescriptor forall a b. (a -> b) -> a -> b $ Int -> [KeyDescriptor] -> ScriptDescriptor SortedMulti (Int -> [KeyDescriptor] -> ScriptDescriptor) -> Parser Text Int -> Parser Text ([KeyDescriptor] -> ScriptDescriptor) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Int forall a. Integral a => Parser a A.decimal Parser Text ([KeyDescriptor] -> ScriptDescriptor) -> Parser Text [KeyDescriptor] -> Parser ScriptDescriptor forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Text [KeyDescriptor] -> Parser Text [KeyDescriptor] forall a. Parser a -> Parser a comma Parser Text [KeyDescriptor] keyList keyList :: Parser Text [KeyDescriptor] keyList = Parser KeyDescriptor -> Parser Text [KeyDescriptor] forall a. Parser a -> Parser [a] argList Parser KeyDescriptor kp parseKeyDescriptor :: Network -> Text -> Either String KeyDescriptor parseKeyDescriptor :: Network -> Text -> Either String KeyDescriptor parseKeyDescriptor net :: Network net = Parser KeyDescriptor -> Text -> Either String KeyDescriptor forall a. Parser a -> Text -> Either String a A.parseOnly (Parser KeyDescriptor -> Text -> Either String KeyDescriptor) -> Parser KeyDescriptor -> Text -> Either String KeyDescriptor forall a b. (a -> b) -> a -> b $ Network -> Parser KeyDescriptor keyDescriptorParser Network net keyDescriptorParser :: Network -> Parser KeyDescriptor keyDescriptorParser :: Network -> Parser KeyDescriptor keyDescriptorParser net :: Network net = Maybe Origin -> Key -> KeyDescriptor KeyDescriptor (Maybe Origin -> Key -> KeyDescriptor) -> Parser Text (Maybe Origin) -> Parser Text (Key -> KeyDescriptor) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text (Maybe Origin) originP Parser Text (Key -> KeyDescriptor) -> Parser Text Key -> Parser KeyDescriptor forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Text Key keyP where originP :: Parser Text (Maybe Origin) originP = Parser Text Origin -> Parser Text (Maybe Origin) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Parser Text Origin -> Parser Text (Maybe Origin)) -> (Parser Text Origin -> Parser Text Origin) -> Parser Text Origin -> Parser Text (Maybe Origin) forall b c a. (b -> c) -> (a -> b) -> a -> c . Parser Text Origin -> Parser Text Origin forall a. Parser a -> Parser a brackets (Parser Text Origin -> Parser Text (Maybe Origin)) -> Parser Text Origin -> Parser Text (Maybe Origin) forall a b. (a -> b) -> a -> b $ Fingerprint -> DerivPath -> Origin Origin (Fingerprint -> DerivPath -> Origin) -> Parser Text Fingerprint -> Parser Text (DerivPath -> Origin) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Fingerprint forall a. (Integral a, Bits a) => Parser a A.hexadecimal Parser Text (DerivPath -> Origin) -> Parser Text DerivPath -> Parser Text Origin forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Text DerivPath pathP keyP :: Parser Text Key keyP = Parser Text Key pubP Parser Text Key -> Parser Text Key -> Parser Text Key forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Text Key wifP Parser Text Key -> Parser Text Key -> Parser Text Key forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> XPubKey -> DerivPath -> KeyCollection -> Key XPub (XPubKey -> DerivPath -> KeyCollection -> Key) -> Parser Text XPubKey -> Parser Text (DerivPath -> KeyCollection -> Key) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text XPubKey xpubP Parser Text (DerivPath -> KeyCollection -> Key) -> Parser Text DerivPath -> Parser Text (KeyCollection -> Key) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Text DerivPath pathP Parser Text (KeyCollection -> Key) -> Parser Text KeyCollection -> Parser Text Key forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Text KeyCollection famP pubP :: Parser Text Key pubP = do ByteString bs <- Parser Text ByteString hex String -> (PubKey -> Key) -> Maybe PubKey -> Parser Text Key forall a b. String -> (a -> b) -> Maybe a -> Parser b maybeFail "Unable to parse pubkey" (ByteString -> PubKey -> Key toPubKey ByteString bs) (Maybe PubKey -> Parser Text Key) -> Maybe PubKey -> Parser Text Key forall a b. (a -> b) -> a -> b $ ByteString -> Maybe PubKey importPubKey ByteString bs toPubKey :: ByteString -> PubKey -> Key toPubKey bs :: ByteString bs = PubKeyI -> Key Pubkey (PubKeyI -> Key) -> (PubKey -> PubKeyI) -> PubKey -> Key forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> PubKey -> PubKeyI wrapPubKey (ByteString -> Bool isCompressed ByteString bs) isCompressed :: ByteString -> Bool isCompressed bs :: ByteString bs = ByteString -> Int BS.length ByteString bs Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == 33 wifP :: Parser Text Key wifP = Parser Text Char -> Parser String forall (m :: * -> *) a. MonadPlus m => m a -> m [a] A.many1' Parser Text Char alphanum Parser String -> (String -> Parser Text Key) -> Parser Text Key forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= String -> (SecKeyI -> Key) -> Maybe SecKeyI -> Parser Text Key forall a b. String -> (a -> b) -> Maybe a -> Parser b maybeFail "Unable to parse WIF secret key" SecKeyI -> Key SecretKey (Maybe SecKeyI -> Parser Text Key) -> (String -> Maybe SecKeyI) -> String -> Parser Text Key forall b c a. (b -> c) -> (a -> b) -> a -> c . Network -> Text -> Maybe SecKeyI fromWif Network net (Text -> Maybe SecKeyI) -> (String -> Text) -> String -> Maybe SecKeyI forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text pack xpubP :: Parser Text XPubKey xpubP = Parser Text Char -> Parser String forall (m :: * -> *) a. MonadPlus m => m a -> m [a] A.many1' Parser Text Char alphanum Parser String -> (String -> Parser Text XPubKey) -> Parser Text XPubKey forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= String -> (XPubKey -> XPubKey) -> Maybe XPubKey -> Parser Text XPubKey forall a b. String -> (a -> b) -> Maybe a -> Parser b maybeFail "Unable to parse xpub" XPubKey -> XPubKey forall a. a -> a id (Maybe XPubKey -> Parser Text XPubKey) -> (String -> Maybe XPubKey) -> String -> Parser Text XPubKey forall b c a. (b -> c) -> (a -> b) -> a -> c . Network -> Text -> Maybe XPubKey xPubImport Network net (Text -> Maybe XPubKey) -> (String -> Text) -> String -> Maybe XPubKey forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text pack famP :: Parser Text KeyCollection famP = (KeyCollection HardKeys KeyCollection -> Parser Text Text -> Parser Text KeyCollection forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Text -> Parser Text Text A.string "/*'") Parser Text KeyCollection -> Parser Text KeyCollection -> Parser Text KeyCollection forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (KeyCollection SoftKeys KeyCollection -> Parser Text Text -> Parser Text KeyCollection forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Text -> Parser Text Text A.string "/*") Parser Text KeyCollection -> Parser Text KeyCollection -> Parser Text KeyCollection forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> KeyCollection -> Parser Text KeyCollection forall (f :: * -> *) a. Applicative f => a -> f a pure KeyCollection Single pathP :: Parser DerivPath pathP :: Parser Text DerivPath pathP = DerivPath -> Parser Text DerivPath forall t. (AnyOrSoft t, HardOrAny t) => DerivPathI t -> Parser Text (DerivPathI t) go DerivPath forall t. DerivPathI t Deriv where go :: DerivPathI t -> Parser Text (DerivPathI t) go d :: DerivPathI t d = Parser Text (DerivPathI t) -> (DerivPathI t -> Parser Text (DerivPathI t)) -> Maybe (DerivPathI t) -> Parser Text (DerivPathI t) forall b a. b -> (a -> b) -> Maybe a -> b maybe (DerivPathI t -> Parser Text (DerivPathI t) forall (m :: * -> *) a. Monad m => a -> m a return DerivPathI t d) DerivPathI t -> Parser Text (DerivPathI t) go (Maybe (DerivPathI t) -> Parser Text (DerivPathI t)) -> Parser Text (Maybe (DerivPathI t)) -> Parser Text (DerivPathI t) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Parser Text (DerivPathI t) -> Parser Text (Maybe (DerivPathI t)) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (DerivPathI t -> Parser Text (DerivPathI t) forall t. (AnyOrSoft t, HardOrAny t) => DerivPathI t -> Parser Text (DerivPathI t) componentP DerivPathI t d) componentP :: DerivPathI t -> Parser Text (DerivPathI t) componentP d :: DerivPathI t d = do Char _ <- Char -> Parser Text Char A.char '/' Fingerprint n <- Parser Text Fingerprint forall a. Integral a => Parser a A.decimal Bool isHard <- Maybe Char -> Bool forall a. Maybe a -> Bool isJust (Maybe Char -> Bool) -> Parser Text (Maybe Char) -> Parser Text Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Char -> Parser Text (Maybe Char) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Char -> Parser Text Char A.char '\'' Parser Text Char -> Parser Text Char -> Parser Text Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Char -> Parser Text Char A.char 'h') DerivPathI t -> Parser Text (DerivPathI t) forall (m :: * -> *) a. Monad m => a -> m a return (DerivPathI t -> Parser Text (DerivPathI t)) -> DerivPathI t -> Parser Text (DerivPathI t) forall a b. (a -> b) -> a -> b $ (Fingerprint -> DerivPathI t) -> (Fingerprint -> DerivPathI t) -> Bool -> Fingerprint -> DerivPathI t forall a. a -> a -> Bool -> a bool (DerivPathI t d DerivPathI t -> Fingerprint -> DerivPathI t forall t. AnyOrSoft t => DerivPathI t -> Fingerprint -> DerivPathI t :/) (DerivPathI t d DerivPathI t -> Fingerprint -> DerivPathI t forall t. HardOrAny t => DerivPathI t -> Fingerprint -> DerivPathI t :|) Bool isHard Fingerprint n