{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Language.Bitcoin.Miniscript.Parser ( miniscriptParser, parseMiniscript, ) where import Control.Applicative ((<|>)) import Control.Monad (void) import Data.Attoparsec.Text (Parser) import qualified Data.Attoparsec.Text as A import Data.Text (Text, pack) import Haskoin.Constants (Network) import Language.Bitcoin.Miniscript.Syntax ( Miniscript (..), Value (..), ) import Language.Bitcoin.Script.Descriptors.Parser (keyDescriptorParser) import Language.Bitcoin.Utils ( alphanum, application, argList, comma, hex, spacePadded, ) parseMiniscript :: Network -> Text -> Either String Miniscript parseMiniscript :: Network -> Text -> Either String Miniscript parseMiniscript Network net = forall a. Parser a -> Text -> Either String a A.parseOnly forall a b. (a -> b) -> a -> b $ Network -> Parser Miniscript miniscriptParser Network net miniscriptParser :: Network -> Parser Miniscript miniscriptParser :: Network -> Parser Miniscript miniscriptParser Network net = Parser Miniscript -> Parser Miniscript annotP Parser Miniscript expression forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript expression where expression :: Parser Miniscript expression = Parser Miniscript keyP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript keyCP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript keyHP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript keyHCP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript olderP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript afterP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript sha256P forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript ripemd160P forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript hash256P forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript hash160P forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript andOrP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript andVP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript andBP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript orBP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript orCP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript orDP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript orIP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript threshP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript multiP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript numberP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript trueP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript falseP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript bytesP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript keyDescriptorP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript letP forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Miniscript varP trueP :: Parser Miniscript trueP = Bool -> Miniscript Boolean Bool True forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Char -> Parser Char A.char Char '1' falseP :: Parser Miniscript falseP = Bool -> Miniscript Boolean Bool False forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Char -> Parser Char A.char Char '0' numberP :: Parser Miniscript numberP = Int -> Miniscript Number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Integral a => Parser a A.decimal bytesP :: Parser Miniscript bytesP = ByteString -> Miniscript Bytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ByteString hex keyDescriptorP :: Parser Miniscript keyDescriptorP = KeyDescriptor -> Miniscript KeyDesc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Network -> Parser KeyDescriptor keyDescriptorParser Network net keyP :: Parser Miniscript keyP = Value KeyDescriptor -> Miniscript Key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "pk_k" Parser Text (Value KeyDescriptor) atomicKeyDescP keyCP :: Parser Miniscript keyCP = Miniscript -> Miniscript AnnC forall b c a. (b -> c) -> (a -> b) -> a -> c . Value KeyDescriptor -> Miniscript Key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "pk" Parser Text (Value KeyDescriptor) atomicKeyDescP keyHP :: Parser Miniscript keyHP = Value KeyDescriptor -> Miniscript KeyH forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "pk_h" Parser Text (Value KeyDescriptor) atomicKeyDescP keyHCP :: Parser Miniscript keyHCP = Miniscript -> Miniscript AnnC forall b c a. (b -> c) -> (a -> b) -> a -> c . Value KeyDescriptor -> Miniscript KeyH forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "pkh" Parser Text (Value KeyDescriptor) atomicKeyDescP olderP :: Parser Miniscript olderP = Value Int -> Miniscript Older forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "older" Parser Text (Value Int) atomicNumberP afterP :: Parser Miniscript afterP = Value Int -> Miniscript After forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "after" Parser Text (Value Int) atomicNumberP sha256P :: Parser Miniscript sha256P = Value ByteString -> Miniscript Sha256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "sha256" Parser Text (Value ByteString) atomicBytesP ripemd160P :: Parser Miniscript ripemd160P = Value ByteString -> Miniscript Ripemd160 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "ripemd160" Parser Text (Value ByteString) atomicBytesP hash256P :: Parser Miniscript hash256P = Value ByteString -> Miniscript Hash256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "hash256" Parser Text (Value ByteString) atomicBytesP hash160P :: Parser Miniscript hash160P = Value ByteString -> Miniscript Hash160 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Text -> Parser a -> Parser a application Text "hash160" Parser Text (Value ByteString) atomicBytesP andOrP :: Parser Miniscript andOrP = forall a. Text -> Parser a -> Parser a application Text "andor" forall a b. (a -> b) -> a -> b $ Miniscript -> Miniscript -> Miniscript -> Miniscript AndOr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp andVP :: Parser Miniscript andVP = forall a. Text -> Parser a -> Parser a application Text "and_v" forall a b. (a -> b) -> a -> b $ Miniscript -> Miniscript -> Miniscript AndV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp andBP :: Parser Miniscript andBP = forall a. Text -> Parser a -> Parser a application Text "and_b" forall a b. (a -> b) -> a -> b $ Miniscript -> Miniscript -> Miniscript AndB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp orBP :: Parser Miniscript orBP = forall a. Text -> Parser a -> Parser a application Text "or_b" forall a b. (a -> b) -> a -> b $ Miniscript -> Miniscript -> Miniscript OrB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp orCP :: Parser Miniscript orCP = forall a. Text -> Parser a -> Parser a application Text "or_c" forall a b. (a -> b) -> a -> b $ Miniscript -> Miniscript -> Miniscript OrC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp orDP :: Parser Miniscript orDP = forall a. Text -> Parser a -> Parser a application Text "or_d" forall a b. (a -> b) -> a -> b $ Miniscript -> Miniscript -> Miniscript OrD forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp orIP :: Parser Miniscript orIP = forall a. Text -> Parser a -> Parser a application Text "or_i" forall a b. (a -> b) -> a -> b $ Miniscript -> Miniscript -> Miniscript OrI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp varP :: Parser Miniscript varP = Text -> Miniscript Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Text varIdentP varIdentP :: Parser Text Text varIdentP = String -> Text pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a] A.many' (Parser Char alphanum forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Char -> Parser Char A.char Char '_') letP :: Parser Miniscript letP = do forall (f :: * -> *) a. Functor f => f a -> f () void forall a b. (a -> b) -> a -> b $ Text -> Parser Text Text A.string Text "let" Text -> Miniscript -> Miniscript -> Miniscript Let forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Parser a -> Parser a spacePadded Parser Text Text varIdentP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Char -> Parser Char A.char Char '=' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall a. Parser a -> Parser a spacePadded Parser Miniscript mp) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Text -> Parser Text Text A.string Text "in" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall a. Parser a -> Parser a spacePadded Parser Miniscript mp) threshP :: Parser Miniscript threshP = forall a. Text -> Parser a -> Parser a application Text "thresh" forall a b. (a -> b) -> a -> b $ Value Int -> Miniscript -> [Miniscript] -> Miniscript Thresh forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text (Value Int) atomicNumberP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma Parser Miniscript mp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma (forall a. Parser a -> Parser [a] argList Parser Miniscript mp) multiP :: Parser Miniscript multiP = forall a. Text -> Parser a -> Parser a application Text "multi" forall a b. (a -> b) -> a -> b $ Value Int -> [Value KeyDescriptor] -> Miniscript Multi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text (Value Int) atomicNumberP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Parser a -> Parser a comma (forall a. Parser a -> Parser [a] argList Parser Text (Value KeyDescriptor) atomicKeyDescP) atomicNumberP :: Parser Text (Value Int) atomicNumberP = (forall a. a -> Value a Lit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Integral a => Parser a A.decimal) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (forall a. Text -> Value a Variable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Text varIdentP) atomicBytesP :: Parser Text (Value ByteString) atomicBytesP = (forall a. a -> Value a Lit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ByteString hex) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (forall a. Text -> Value a Variable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Text varIdentP) atomicKeyDescP :: Parser Text (Value KeyDescriptor) atomicKeyDescP = (forall a. a -> Value a Lit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Network -> Parser KeyDescriptor keyDescriptorParser Network net) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (forall a. Text -> Value a Variable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Text varIdentP) annotP :: Parser Miniscript -> Parser Miniscript annotP Parser Miniscript p = do Miniscript -> Miniscript anns <- String -> Miniscript -> Miniscript calcAnnotation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text String annPrefixP Miniscript -> Miniscript anns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Miniscript p annPrefixP :: Parser Text String annPrefixP = forall (m :: * -> *) a. MonadPlus m => m a -> m [a] A.many' (forall a. Parser a -> Parser a spacePadded forall a b. (a -> b) -> a -> b $ (Char -> Bool) -> Parser Char A.satisfy Char -> Bool isAnn) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* forall a. Parser a -> Parser a spacePadded (Char -> Parser Char A.char Char ':') calcAnnotation :: String -> Miniscript -> Miniscript calcAnnotation = forall a b c. (a -> b -> c) -> b -> a -> c flip forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr Char -> Miniscript -> Miniscript toAnn toAnn :: Char -> Miniscript -> Miniscript toAnn = \case Char 'a' -> Miniscript -> Miniscript AnnA Char 's' -> Miniscript -> Miniscript AnnS Char 'c' -> Miniscript -> Miniscript AnnC Char 'd' -> Miniscript -> Miniscript AnnD Char 'v' -> Miniscript -> Miniscript AnnV Char 'j' -> Miniscript -> Miniscript AnnJ Char 'n' -> Miniscript -> Miniscript AnnN Char 't' -> (Miniscript -> Miniscript -> Miniscript `AndV` Bool -> Miniscript Boolean Bool True) Char 'l' -> Miniscript -> Miniscript -> Miniscript OrI (Bool -> Miniscript Boolean Bool False) Char 'u' -> (Miniscript -> Miniscript -> Miniscript `OrI` Bool -> Miniscript Boolean Bool False) Char _ -> forall a. HasCallStack => String -> a error String "unexpected annotation" isAnn :: Char -> Bool isAnn = String -> Char -> Bool A.inClass String "asctdvjnlu" mp :: Parser Miniscript mp = Network -> Parser Miniscript miniscriptParser Network net