{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Bitcoin.Miniscript.Compiler (
CompilerError (..),
compile,
compileOnly,
) where
import Control.Exception (Exception)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (Except, runExcept, throwE)
import Control.Monad.Trans.Reader (
ReaderT,
local,
runReaderT,
)
import Data.Bifunctor (first)
import Data.Functor (void)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Serialize (encode)
import Data.Text (Text)
import Haskoin.Crypto (ripemd160)
import Haskoin.Script (
Script (..),
ScriptOp (..),
opPushData,
)
import Language.Bitcoin.Miniscript.Syntax (
Miniscript (..),
Value (..),
)
import Language.Bitcoin.Miniscript.Types (
MiniscriptTypeError (..),
typeCheckMiniscript,
)
import Language.Bitcoin.Script.Descriptors.Syntax (KeyDescriptor, keyBytes)
import Language.Bitcoin.Script.Utils (pushNumber)
import Language.Bitcoin.Utils (requiredContextValue)
data CompilerError
= FreeVariable Text
| CompilerError Miniscript
| TypeError MiniscriptTypeError
| NotImplemented Miniscript
| AbstractKey KeyDescriptor
deriving (CompilerError -> CompilerError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerError -> CompilerError -> Bool
$c/= :: CompilerError -> CompilerError -> Bool
== :: CompilerError -> CompilerError -> Bool
$c== :: CompilerError -> CompilerError -> Bool
Eq, Int -> CompilerError -> ShowS
[CompilerError] -> ShowS
CompilerError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerError] -> ShowS
$cshowList :: [CompilerError] -> ShowS
show :: CompilerError -> String
$cshow :: CompilerError -> String
showsPrec :: Int -> CompilerError -> ShowS
$cshowsPrec :: Int -> CompilerError -> ShowS
Show)
instance Exception CompilerError
compile :: Miniscript -> Either CompilerError Script
compile :: Miniscript -> Either CompilerError Script
compile Miniscript
script = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MiniscriptTypeError -> CompilerError
TypeError forall a b. (a -> b) -> a -> b
$ Map Text MiniscriptType
-> Miniscript -> Either MiniscriptTypeError MiniscriptType
typeCheckMiniscript forall a. Monoid a => a
mempty Miniscript
script
Miniscript -> Either CompilerError Script
compileOnly Miniscript
script
compileOnly :: Miniscript -> Either CompilerError Script
compileOnly :: Miniscript -> Either CompilerError Script
compileOnly = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ScriptOp] -> Script
Script forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Except e a -> Either e a
runExcept forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Map Text (Context, Miniscript) -> Context
Context forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext
newtype Context = Context {Context -> Map Text (Context, Miniscript)
unContext :: Map Text (Context, Miniscript)}
addClosure :: Text -> Miniscript -> Context -> Context
addClosure :: Text -> Miniscript -> Context -> Context
addClosure Text
n Miniscript
e Context
c = Map Text (Context, Miniscript) -> Context
Context forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
n (Context
c, Miniscript
e) forall a b. (a -> b) -> a -> b
$ Context -> Map Text (Context, Miniscript)
unContext Context
c
requiredScript :: Text -> ReaderT Context (Except CompilerError) (Context, Miniscript)
requiredScript :: Text
-> ReaderT Context (Except CompilerError) (Context, Miniscript)
requiredScript Text
name = forall r c e.
(r -> Map Text c) -> e -> Text -> ReaderT r (Except e) c
requiredContextValue Context -> Map Text (Context, Miniscript)
unContext (Text -> CompilerError
FreeVariable Text
name) Text
name
compileOpsInContext :: Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext :: Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext = \case
Boolean Bool
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
x then [ScriptOp
OP_1] else [ScriptOp
OP_0]
Key Value KeyDescriptor
vk -> forall {f :: * -> *}.
Applicative f =>
Value KeyDescriptor
-> ReaderT Context (Except CompilerError) (f ScriptOp)
getKeyScript Value KeyDescriptor
vk
KeyH Value KeyDescriptor
vk -> do
ByteString
k <- forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m, Monad (t (ExceptT CompilerError m))) =>
KeyDescriptor -> t (ExceptT CompilerError m) ByteString
getKeyBytes forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value KeyDescriptor
-> ReaderT Context (Except CompilerError) KeyDescriptor
requiredKey Value KeyDescriptor
vk
forall (m :: * -> *) a. Monad m => a -> m a
return [ScriptOp
OP_DUP, ScriptOp
OP_HASH160, ByteString -> ScriptOp
opPushData (forall a. Serialize a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall b. ByteArrayAccess b => b -> Hash160
ripemd160 ByteString
k), ScriptOp
OP_EQUALVERIFY]
Older Value Int
vn -> do
Int
n <- Value Int -> ReaderT Context (Except CompilerError) Int
requiredNumber Value Int
vn
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> ScriptOp
pushNumber Int
n, ScriptOp
OP_CHECKSEQUENCEVERIFY]
After Value Int
vn -> do
Int
n <- Value Int -> ReaderT Context (Except CompilerError) Int
requiredNumber Value Int
vn
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> ScriptOp
pushNumber Int
n, ScriptOp
OP_CHECKLOCKTIMEVERIFY]
Sha256 Value ByteString
vb -> do
ByteString
b <- Value ByteString
-> ReaderT Context (Except CompilerError) ByteString
requiredBytes Value ByteString
vb
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScriptOp]
sizeCheck forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_SHA256, ByteString -> ScriptOp
opPushData ByteString
b, ScriptOp
OP_EQUAL]
Ripemd160 Value ByteString
vb -> do
ByteString
b <- Value ByteString
-> ReaderT Context (Except CompilerError) ByteString
requiredBytes Value ByteString
vb
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScriptOp]
sizeCheck forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_RIPEMD160, ByteString -> ScriptOp
opPushData ByteString
b, ScriptOp
OP_EQUAL]
Hash256 Value ByteString
vb -> do
ByteString
b <- Value ByteString
-> ReaderT Context (Except CompilerError) ByteString
requiredBytes Value ByteString
vb
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScriptOp]
sizeCheck forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_HASH256, ByteString -> ScriptOp
opPushData ByteString
b, ScriptOp
OP_EQUAL]
Hash160 Value ByteString
vb -> do
ByteString
b <- Value ByteString
-> ReaderT Context (Except CompilerError) ByteString
requiredBytes Value ByteString
vb
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScriptOp]
sizeCheck forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_HASH160, ByteString -> ScriptOp
opPushData ByteString
b, ScriptOp
OP_EQUAL]
AndOr Miniscript
x Miniscript
y Miniscript
z -> do
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[ScriptOp]
opsY <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
y
[ScriptOp]
opsZ <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[ScriptOp]
opsX, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_NOTIF, [ScriptOp]
opsZ, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_ELSE, [ScriptOp]
opsY, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_ENDIF]
AndV Miniscript
x Miniscript
z -> do
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[ScriptOp]
opsZ <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScriptOp]
opsX forall a. Semigroup a => a -> a -> a
<> [ScriptOp]
opsZ
AndB Miniscript
x Miniscript
z -> do
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[ScriptOp]
opsZ <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScriptOp]
opsX forall a. Semigroup a => a -> a -> a
<> [ScriptOp]
opsZ forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_BOOLAND]
OrB Miniscript
x Miniscript
z -> do
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[ScriptOp]
opsZ <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScriptOp]
opsX forall a. Semigroup a => a -> a -> a
<> [ScriptOp]
opsZ forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_BOOLOR]
OrC Miniscript
x Miniscript
z -> do
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[ScriptOp]
opsZ <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[ScriptOp]
opsX, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_NOTIF, [ScriptOp]
opsZ, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_ENDIF]
OrD Miniscript
x Miniscript
z -> do
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[ScriptOp]
opsZ <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[ScriptOp]
opsX, [ScriptOp
OP_IFDUP, ScriptOp
OP_NOTIF], [ScriptOp]
opsZ, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_ENDIF]
OrI Miniscript
x Miniscript
z -> do
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[ScriptOp]
opsZ <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
z
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_IF, [ScriptOp]
opsX, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_ELSE, [ScriptOp]
opsZ, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_ENDIF]
Thresh Value Int
vk Miniscript
x [Miniscript]
xs -> do
Int
k <- Value Int -> ReaderT Context (Except CompilerError) Int
requiredNumber Value Int
vk
[ScriptOp]
opsX <- Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
[[ScriptOp]]
opsXS <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext [Miniscript]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure [ScriptOp]
opsX forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {f :: * -> *}. Applicative f => f ScriptOp -> [f ScriptOp]
addX [[ScriptOp]]
opsXS forall a. Semigroup a => a -> a -> a
<> [[Int -> ScriptOp
pushNumber Int
k, ScriptOp
OP_EQUAL]]
where
addX :: f ScriptOp -> [f ScriptOp]
addX f ScriptOp
ops = [f ScriptOp
ops, forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptOp
OP_ADD]
Multi Value Int
vk [Value KeyDescriptor]
xs -> do
Int
k <- Value Int -> ReaderT Context (Except CompilerError) Int
requiredNumber Value Int
vk
[[ScriptOp]]
opsXS <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {f :: * -> *}.
Applicative f =>
Value KeyDescriptor
-> ReaderT Context (Except CompilerError) (f ScriptOp)
getKeyScript [Value KeyDescriptor]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int -> ScriptOp
pushNumber Int
k] forall a. Semigroup a => a -> a -> a
<> [[ScriptOp]]
opsXS forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int -> ScriptOp
pushNumber (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value KeyDescriptor]
xs), ScriptOp
OP_CHECKMULTISIG]
AnnA Miniscript
x -> [ScriptOp] -> [ScriptOp]
annA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
where
annA :: [ScriptOp] -> [ScriptOp]
annA [ScriptOp]
ops = ScriptOp
OP_TOALTSTACK forall a. a -> [a] -> [a]
: [ScriptOp]
ops forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_FROMALTSTACK]
AnnS Miniscript
x -> (ScriptOp
OP_SWAP forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
AnnC Miniscript
x -> (forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_CHECKSIG]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
AnnD Miniscript
x -> [ScriptOp] -> [ScriptOp]
annD forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
where
annD :: [ScriptOp] -> [ScriptOp]
annD [ScriptOp]
ops = [ScriptOp
OP_DUP, ScriptOp
OP_IF] forall a. Semigroup a => a -> a -> a
<> [ScriptOp]
ops forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_ENDIF]
AnnV Miniscript
x -> [ScriptOp] -> [ScriptOp]
annV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
where
annV :: [ScriptOp] -> [ScriptOp]
annV [ScriptOp]
ops =
let ([ScriptOp]
ops', ScriptOp
op) = forall a. [a] -> ([a], a)
unsnoc [ScriptOp]
ops
in case ScriptOp
op of
ScriptOp
OP_EQUAL -> [ScriptOp]
ops' forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_EQUALVERIFY]
ScriptOp
OP_NUMEQUAL -> [ScriptOp]
ops' forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_NUMEQUALVERIFY]
ScriptOp
OP_CHECKSIG -> [ScriptOp]
ops' forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_CHECKSIGVERIFY]
ScriptOp
OP_CHECKMULTISIG -> [ScriptOp]
ops' forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_CHECKMULTISIGVERIFY]
ScriptOp
_ -> [ScriptOp]
ops forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_VERIFY]
AnnJ Miniscript
x -> [ScriptOp] -> [ScriptOp]
annJ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
where
annJ :: [ScriptOp] -> [ScriptOp]
annJ [ScriptOp]
ops = [ScriptOp
OP_SIZE, ScriptOp
OP_0NOTEQUAL, ScriptOp
OP_IF] forall a. Semigroup a => a -> a -> a
<> [ScriptOp]
ops forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_ENDIF]
AnnN Miniscript
x -> (forall a. Semigroup a => a -> a -> a
<> [ScriptOp
OP_0NOTEQUAL]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
x
Var Text
n -> do
(Context
c', Miniscript
s) <- Text
-> ReaderT Context (Except CompilerError) (Context, Miniscript)
requiredScript Text
n
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (forall a b. a -> b -> a
const Context
c') forall a b. (a -> b) -> a -> b
$ Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
s
Let Text
n Miniscript
e Miniscript
b -> forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Text -> Miniscript -> Context -> Context
addClosure Text
n Miniscript
e) forall a b. (a -> b) -> a -> b
$ Miniscript -> ReaderT Context (Except CompilerError) [ScriptOp]
compileOpsInContext Miniscript
b
Number Int
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> ScriptOp
pushNumber Int
x]
Bytes ByteString
b -> forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString -> ScriptOp
opPushData ByteString
b]
KeyDesc KeyDescriptor
k | Just ByteString
b <- KeyDescriptor -> Maybe ByteString
keyBytes KeyDescriptor
k -> forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString -> ScriptOp
opPushData ByteString
b]
e :: Miniscript
e@KeyDesc{} -> forall {a}. Miniscript -> ReaderT Context (Except CompilerError) a
typeError Miniscript
e
where
sizeCheck :: [ScriptOp]
sizeCheck = [ScriptOp
OP_SIZE, Int -> ScriptOp
pushNumber Int
32, ScriptOp
OP_EQUALVERIFY]
typeError :: Miniscript -> ReaderT Context (Except CompilerError) a
typeError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall b c a. (b -> c) -> (a -> b) -> a -> c
. MiniscriptTypeError -> CompilerError
TypeError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Miniscript -> MiniscriptTypeError
MiniscriptTypeError
required :: (Miniscript -> ReaderT Context (Except CompilerError) a)
-> Value a -> ReaderT Context (Except CompilerError) a
required Miniscript -> ReaderT Context (Except CompilerError) a
f = \case
Lit a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Variable Text
n -> Text
-> ReaderT Context (Except CompilerError) (Context, Miniscript)
requiredScript Text
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Miniscript -> ReaderT Context (Except CompilerError) a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
requiredNumber :: Value Int -> ReaderT Context (Except CompilerError) Int
requiredNumber = forall {a}.
(Miniscript -> ReaderT Context (Except CompilerError) a)
-> Value a -> ReaderT Context (Except CompilerError) a
required forall a b. (a -> b) -> a -> b
$ \case
Number Int
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
x
Miniscript
e -> forall {a}. Miniscript -> ReaderT Context (Except CompilerError) a
typeError Miniscript
e
getKeyScript :: Value KeyDescriptor
-> ReaderT Context (Except CompilerError) (f ScriptOp)
getKeyScript Value KeyDescriptor
vk = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ScriptOp
opPushData) forall a b. (a -> b) -> a -> b
$ Value KeyDescriptor
-> ReaderT Context (Except CompilerError) KeyDescriptor
requiredKey Value KeyDescriptor
vk forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m, Monad (t (ExceptT CompilerError m))) =>
KeyDescriptor -> t (ExceptT CompilerError m) ByteString
getKeyBytes
requiredKey :: Value KeyDescriptor
-> ReaderT Context (Except CompilerError) KeyDescriptor
requiredKey = forall {a}.
(Miniscript -> ReaderT Context (Except CompilerError) a)
-> Value a -> ReaderT Context (Except CompilerError) a
required forall a b. (a -> b) -> a -> b
$ \case
KeyDesc KeyDescriptor
k -> forall (m :: * -> *) a. Monad m => a -> m a
return KeyDescriptor
k
Miniscript
e -> forall {a}. Miniscript -> ReaderT Context (Except CompilerError) a
typeError Miniscript
e
getKeyBytes :: KeyDescriptor -> t (ExceptT CompilerError m) ByteString
getKeyBytes KeyDescriptor
k
| Just ByteString
b <- KeyDescriptor -> Maybe ByteString
keyBytes KeyDescriptor
k = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
| Bool
otherwise = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ KeyDescriptor -> CompilerError
AbstractKey KeyDescriptor
k
requiredBytes :: Value ByteString
-> ReaderT Context (Except CompilerError) ByteString
requiredBytes = forall {a}.
(Miniscript -> ReaderT Context (Except CompilerError) a)
-> Value a -> ReaderT Context (Except CompilerError) a
required forall a b. (a -> b) -> a -> b
$ \case
Bytes ByteString
b -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
Miniscript
e -> forall {a}. Miniscript -> ReaderT Context (Except CompilerError) a
typeError Miniscript
e
unsnoc :: [a] -> ([a], a)
unsnoc :: forall a. [a] -> ([a], a)
unsnoc [] = forall a. HasCallStack => String -> a
error String
"unsnoc: empty list"
unsnoc [a
x] = ([], a
x)
unsnoc (a
x : [a]
xs) = let ([a]
zs, a
z) = forall a. [a] -> ([a], a)
unsnoc [a]
xs in (a
x forall a. a -> [a] -> [a]
: [a]
zs, a
z)