{-# LANGUAGE LambdaCase #-}

{- |
 Module: Language.Bitcoin.Miniscript.Syntax

 Haskell embedding of miniscript.  See http://bitcoin.sipa.be/miniscript/ for
 details.  Much of the documentation below is taken from this site.
-}
module Language.Bitcoin.Miniscript.Syntax (
    Value (..),
    var,
    literal,
    Miniscript (..),
    let_,
    key,
    keyH,
    older,
    after,
    sha256,
    ripemd160,
    hash256,
    hash160,
    thresh,
    multi,
    Annotation (..),
    MiniscriptAnnotation (..),
) where

import Data.ByteString (ByteString)
import Data.Foldable (foldr')
import Data.Text (Text)

import Language.Bitcoin.Script.Descriptors (KeyDescriptor)

data Value a = Variable Text | Lit a
    deriving (Value a -> Value a -> Bool
(Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool) -> Eq (Value a)
forall a. Eq a => Value a -> Value a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value a -> Value a -> Bool
$c/= :: forall a. Eq a => Value a -> Value a -> Bool
== :: Value a -> Value a -> Bool
$c== :: forall a. Eq a => Value a -> Value a -> Bool
Eq, Int -> Value a -> ShowS
[Value a] -> ShowS
Value a -> String
(Int -> Value a -> ShowS)
-> (Value a -> String) -> ([Value a] -> ShowS) -> Show (Value a)
forall a. Show a => Int -> Value a -> ShowS
forall a. Show a => [Value a] -> ShowS
forall a. Show a => Value a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value a] -> ShowS
$cshowList :: forall a. Show a => [Value a] -> ShowS
show :: Value a -> String
$cshow :: forall a. Show a => Value a -> String
showsPrec :: Int -> Value a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Value a -> ShowS
Show, Eq (Value a)
Eq (Value a) =>
(Value a -> Value a -> Ordering)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Value a)
-> (Value a -> Value a -> Value a)
-> Ord (Value a)
Value a -> Value a -> Bool
Value a -> Value a -> Ordering
Value a -> Value a -> Value a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Value a)
forall a. Ord a => Value a -> Value a -> Bool
forall a. Ord a => Value a -> Value a -> Ordering
forall a. Ord a => Value a -> Value a -> Value a
min :: Value a -> Value a -> Value a
$cmin :: forall a. Ord a => Value a -> Value a -> Value a
max :: Value a -> Value a -> Value a
$cmax :: forall a. Ord a => Value a -> Value a -> Value a
>= :: Value a -> Value a -> Bool
$c>= :: forall a. Ord a => Value a -> Value a -> Bool
> :: Value a -> Value a -> Bool
$c> :: forall a. Ord a => Value a -> Value a -> Bool
<= :: Value a -> Value a -> Bool
$c<= :: forall a. Ord a => Value a -> Value a -> Bool
< :: Value a -> Value a -> Bool
$c< :: forall a. Ord a => Value a -> Value a -> Bool
compare :: Value a -> Value a -> Ordering
$ccompare :: forall a. Ord a => Value a -> Value a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Value a)
Ord)

var :: Text -> Value a
var :: Text -> Value a
var = Text -> Value a
forall a. Text -> Value a
Variable

literal :: a -> Value a
literal :: a -> Value a
literal = a -> Value a
forall a. a -> Value a
Lit

-- | The Miniscript AST with the addition of key descriptors and let bindings
data Miniscript
    = Var Text
    | Let Text Miniscript Miniscript
    | Boolean Bool
    | Number Int
    | Bytes ByteString
    | KeyDesc KeyDescriptor
    | Key (Value KeyDescriptor)
    | KeyH (Value KeyDescriptor)
    | Older (Value Int)
    | After (Value Int)
    | Sha256 (Value ByteString)
    | Ripemd160 (Value ByteString)
    | Hash256 (Value ByteString)
    | Hash160 (Value ByteString)
    | AndOr Miniscript Miniscript Miniscript
    | AndV Miniscript Miniscript
    | AndB Miniscript Miniscript
    | OrB Miniscript Miniscript
    | OrC Miniscript Miniscript
    | OrD Miniscript Miniscript
    | OrI Miniscript Miniscript
    | Thresh (Value Int) Miniscript [Miniscript]
    | Multi (Value Int) [Value KeyDescriptor]
    | AnnA Miniscript
    | AnnS Miniscript
    | AnnC Miniscript
    | AnnD Miniscript
    | AnnV Miniscript
    | AnnJ Miniscript
    | AnnN Miniscript
    deriving (Miniscript -> Miniscript -> Bool
(Miniscript -> Miniscript -> Bool)
-> (Miniscript -> Miniscript -> Bool) -> Eq Miniscript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Miniscript -> Miniscript -> Bool
$c/= :: Miniscript -> Miniscript -> Bool
== :: Miniscript -> Miniscript -> Bool
$c== :: Miniscript -> Miniscript -> Bool
Eq, Int -> Miniscript -> ShowS
[Miniscript] -> ShowS
Miniscript -> String
(Int -> Miniscript -> ShowS)
-> (Miniscript -> String)
-> ([Miniscript] -> ShowS)
-> Show Miniscript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Miniscript] -> ShowS
$cshowList :: [Miniscript] -> ShowS
show :: Miniscript -> String
$cshow :: Miniscript -> String
showsPrec :: Int -> Miniscript -> ShowS
$cshowsPrec :: Int -> Miniscript -> ShowS
Show)

-- | Check a key
key :: KeyDescriptor -> Miniscript
key :: KeyDescriptor -> Miniscript
key = Miniscript -> Miniscript
AnnC (Miniscript -> Miniscript)
-> (KeyDescriptor -> Miniscript) -> KeyDescriptor -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value KeyDescriptor -> Miniscript
Key (Value KeyDescriptor -> Miniscript)
-> (KeyDescriptor -> Value KeyDescriptor)
-> KeyDescriptor
-> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyDescriptor -> Value KeyDescriptor
forall a. a -> Value a
literal

-- | Check a key hash
keyH :: KeyDescriptor -> Miniscript
keyH :: KeyDescriptor -> Miniscript
keyH = Miniscript -> Miniscript
AnnC (Miniscript -> Miniscript)
-> (KeyDescriptor -> Miniscript) -> KeyDescriptor -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value KeyDescriptor -> Miniscript
KeyH (Value KeyDescriptor -> Miniscript)
-> (KeyDescriptor -> Value KeyDescriptor)
-> KeyDescriptor
-> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyDescriptor -> Value KeyDescriptor
forall a. a -> Value a
literal

older :: Int -> Miniscript
older :: Int -> Miniscript
older = Value Int -> Miniscript
Older (Value Int -> Miniscript)
-> (Int -> Value Int) -> Int -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value Int
forall a. a -> Value a
literal

after :: Int -> Miniscript
after :: Int -> Miniscript
after = Value Int -> Miniscript
After (Value Int -> Miniscript)
-> (Int -> Value Int) -> Int -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value Int
forall a. a -> Value a
literal

sha256 :: ByteString -> Miniscript
sha256 :: ByteString -> Miniscript
sha256 = Value ByteString -> Miniscript
Sha256 (Value ByteString -> Miniscript)
-> (ByteString -> Value ByteString) -> ByteString -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Value ByteString
forall a. a -> Value a
literal

ripemd160 :: ByteString -> Miniscript
ripemd160 :: ByteString -> Miniscript
ripemd160 = Value ByteString -> Miniscript
Ripemd160 (Value ByteString -> Miniscript)
-> (ByteString -> Value ByteString) -> ByteString -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Value ByteString
forall a. a -> Value a
literal

hash256 :: ByteString -> Miniscript
hash256 :: ByteString -> Miniscript
hash256 = Value ByteString -> Miniscript
Hash256 (Value ByteString -> Miniscript)
-> (ByteString -> Value ByteString) -> ByteString -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Value ByteString
forall a. a -> Value a
literal

hash160 :: ByteString -> Miniscript
hash160 :: ByteString -> Miniscript
hash160 = Value ByteString -> Miniscript
Hash160 (Value ByteString -> Miniscript)
-> (ByteString -> Value ByteString) -> ByteString -> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Value ByteString
forall a. a -> Value a
literal

thresh :: Int -> Miniscript -> [Miniscript] -> Miniscript
thresh :: Int -> Miniscript -> [Miniscript] -> Miniscript
thresh k :: Int
k = Value Int -> Miniscript -> [Miniscript] -> Miniscript
Thresh (Int -> Value Int
forall a. a -> Value a
Lit Int
k)

multi :: Int -> [KeyDescriptor] -> Miniscript
multi :: Int -> [KeyDescriptor] -> Miniscript
multi k :: Int
k ks :: [KeyDescriptor]
ks = Value Int -> [Value KeyDescriptor] -> Miniscript
Multi (Int -> Value Int
forall a. a -> Value a
literal Int
k) ([Value KeyDescriptor] -> Miniscript)
-> [Value KeyDescriptor] -> Miniscript
forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> Value KeyDescriptor
forall a. a -> Value a
literal (KeyDescriptor -> Value KeyDescriptor)
-> [KeyDescriptor] -> [Value KeyDescriptor]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyDescriptor]
ks

let_ :: [(Text, Miniscript)] -> Miniscript -> Miniscript
let_ :: [(Text, Miniscript)] -> Miniscript -> Miniscript
let_ = (Miniscript -> [(Text, Miniscript)] -> Miniscript)
-> [(Text, Miniscript)] -> Miniscript -> Miniscript
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Miniscript -> [(Text, Miniscript)] -> Miniscript)
 -> [(Text, Miniscript)] -> Miniscript -> Miniscript)
-> (((Text, Miniscript) -> Miniscript -> Miniscript)
    -> Miniscript -> [(Text, Miniscript)] -> Miniscript)
-> ((Text, Miniscript) -> Miniscript -> Miniscript)
-> [(Text, Miniscript)]
-> Miniscript
-> Miniscript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Miniscript) -> Miniscript -> Miniscript)
-> Miniscript -> [(Text, Miniscript)] -> Miniscript
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (((Text, Miniscript) -> Miniscript -> Miniscript)
 -> [(Text, Miniscript)] -> Miniscript -> Miniscript)
-> ((Text, Miniscript) -> Miniscript -> Miniscript)
-> [(Text, Miniscript)]
-> Miniscript
-> Miniscript
forall a b. (a -> b) -> a -> b
$ (Text -> Miniscript -> Miniscript -> Miniscript)
-> (Text, Miniscript) -> Miniscript -> Miniscript
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Miniscript -> Miniscript -> Miniscript
Let

class MiniscriptAnnotation a where
    (.:) :: a -> Miniscript -> Miniscript

data Annotation = A | S | C | D | V | J | N | T | L | U deriving (Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show, Eq Annotation
Eq Annotation =>
(Annotation -> Annotation -> Ordering)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Annotation)
-> (Annotation -> Annotation -> Annotation)
-> Ord Annotation
Annotation -> Annotation -> Bool
Annotation -> Annotation -> Ordering
Annotation -> Annotation -> Annotation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Annotation -> Annotation -> Annotation
$cmin :: Annotation -> Annotation -> Annotation
max :: Annotation -> Annotation -> Annotation
$cmax :: Annotation -> Annotation -> Annotation
>= :: Annotation -> Annotation -> Bool
$c>= :: Annotation -> Annotation -> Bool
> :: Annotation -> Annotation -> Bool
$c> :: Annotation -> Annotation -> Bool
<= :: Annotation -> Annotation -> Bool
$c<= :: Annotation -> Annotation -> Bool
< :: Annotation -> Annotation -> Bool
$c< :: Annotation -> Annotation -> Bool
compare :: Annotation -> Annotation -> Ordering
$ccompare :: Annotation -> Annotation -> Ordering
$cp1Ord :: Eq Annotation
Ord, Int -> Annotation
Annotation -> Int
Annotation -> [Annotation]
Annotation -> Annotation
Annotation -> Annotation -> [Annotation]
Annotation -> Annotation -> Annotation -> [Annotation]
(Annotation -> Annotation)
-> (Annotation -> Annotation)
-> (Int -> Annotation)
-> (Annotation -> Int)
-> (Annotation -> [Annotation])
-> (Annotation -> Annotation -> [Annotation])
-> (Annotation -> Annotation -> [Annotation])
-> (Annotation -> Annotation -> Annotation -> [Annotation])
-> Enum Annotation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Annotation -> Annotation -> Annotation -> [Annotation]
$cenumFromThenTo :: Annotation -> Annotation -> Annotation -> [Annotation]
enumFromTo :: Annotation -> Annotation -> [Annotation]
$cenumFromTo :: Annotation -> Annotation -> [Annotation]
enumFromThen :: Annotation -> Annotation -> [Annotation]
$cenumFromThen :: Annotation -> Annotation -> [Annotation]
enumFrom :: Annotation -> [Annotation]
$cenumFrom :: Annotation -> [Annotation]
fromEnum :: Annotation -> Int
$cfromEnum :: Annotation -> Int
toEnum :: Int -> Annotation
$ctoEnum :: Int -> Annotation
pred :: Annotation -> Annotation
$cpred :: Annotation -> Annotation
succ :: Annotation -> Annotation
$csucc :: Annotation -> Annotation
Enum)

instance MiniscriptAnnotation Annotation where
    .: :: Annotation -> Miniscript -> Miniscript
(.:) = \case
        A -> Miniscript -> Miniscript
AnnA
        S -> Miniscript -> Miniscript
AnnS
        C -> Miniscript -> Miniscript
AnnC
        D -> Miniscript -> Miniscript
AnnD
        V -> Miniscript -> Miniscript
AnnV
        J -> Miniscript -> Miniscript
AnnJ
        N -> Miniscript -> Miniscript
AnnN
        T -> (Miniscript -> Miniscript -> Miniscript
`AndV` Bool -> Miniscript
Boolean Bool
True)
        L -> Miniscript -> Miniscript -> Miniscript
OrI (Miniscript -> Miniscript -> Miniscript)
-> Miniscript -> Miniscript -> Miniscript
forall a b. (a -> b) -> a -> b
$ Bool -> Miniscript
Boolean Bool
True
        U -> (Miniscript -> Miniscript -> Miniscript
`OrI` Bool -> Miniscript
Boolean Bool
False)

instance MiniscriptAnnotation a => MiniscriptAnnotation [a] where
    .: :: [a] -> Miniscript -> Miniscript
(.:) = (Miniscript -> [a] -> Miniscript)
-> [a] -> Miniscript -> Miniscript
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Miniscript -> [a] -> Miniscript)
 -> [a] -> Miniscript -> Miniscript)
-> (Miniscript -> [a] -> Miniscript)
-> [a]
-> Miniscript
-> Miniscript
forall a b. (a -> b) -> a -> b
$ (a -> Miniscript -> Miniscript) -> Miniscript -> [a] -> Miniscript
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> Miniscript -> Miniscript
forall a. MiniscriptAnnotation a => a -> Miniscript -> Miniscript
(.:)