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