{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK prune #-}
module Cardano.Address.Script
(
Script (..)
, serializeScript
, foldScript
, ScriptTemplate (..)
, Cosigner (..)
, cosignerToText
, ValidationLevel (..)
, ErrValidateScript (..)
, ErrRecommendedValidateScript (..)
, ErrValidateScriptTemplate (..)
, validateScript
, validateScriptTemplate
, validateScriptOfTemplate
, prettyErrValidateScript
, prettyErrValidateScriptTemplate
, ScriptHash (..)
, toScriptHash
, scriptHashFromBytes
, KeyHash (..)
, KeyRole (..)
, keyHashFromBytes
, keyHashFromText
, keyHashToText
, ErrKeyHashFromText
, prettyErrKeyHashFromText
) where
import Prelude
import Cardano.Address.Derivation
( XPub, credentialHashSize, hashCredential, xpubFromBytes, xpubToBytes )
import Codec.Binary.Encoding
( AbstractEncoding (..), encode, fromBase16 )
import Control.Applicative
( (<|>) )
import Control.DeepSeq
( NFData )
import Control.Monad
( foldM, unless, when )
import Data.Aeson
( FromJSON (..)
, ToJSON (..)
, Value (..)
, object
, withObject
, withText
, (.:)
, (.:?)
, (.=)
)
import Data.Aeson.Types
( Parser )
import Data.Bifunctor
( first )
import Data.ByteString
( ByteString )
import Data.Either.Combinators
( maybeToRight )
import Data.Foldable
( asum, foldl', traverse_ )
import Data.Functor.Identity
( Identity (..) )
import Data.Hashable
( Hashable )
import Data.Kind
( Type )
import Data.Map.Strict
( Map )
import Data.Text
( Text )
import Data.Traversable
( for )
import Data.Word
( Word8 )
import GHC.Generics
( Generic )
import qualified HaskellWorks.Data.Aeson.Compat as J
import qualified HaskellWorks.Data.Aeson.Compat.Map as JM
import Numeric.Natural
( Natural )
import qualified Cardano.Codec.Bech32.Prefixes as CIP5
import qualified Cardano.Codec.Cbor as CBOR
import qualified Codec.Binary.Bech32 as Bech32
import qualified Codec.CBOR.Encoding as CBOR
import qualified Data.Aeson.Types as Json
import qualified Data.ByteString as BS
import qualified Data.HashSet as Set
import qualified Data.List as L
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Read as T
data Script (elem :: Type)
= RequireSignatureOf !elem
| RequireAllOf ![Script elem]
| RequireAnyOf ![Script elem]
| RequireSomeOf Word8 ![Script elem]
| ActiveFromSlot Natural
| ActiveUntilSlot Natural
deriving stock ((forall x. Script elem -> Rep (Script elem) x)
-> (forall x. Rep (Script elem) x -> Script elem)
-> Generic (Script elem)
forall x. Rep (Script elem) x -> Script elem
forall x. Script elem -> Rep (Script elem) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall elem x. Rep (Script elem) x -> Script elem
forall elem x. Script elem -> Rep (Script elem) x
$cto :: forall elem x. Rep (Script elem) x -> Script elem
$cfrom :: forall elem x. Script elem -> Rep (Script elem) x
Generic, Int -> Script elem -> ShowS
[Script elem] -> ShowS
Script elem -> String
(Int -> Script elem -> ShowS)
-> (Script elem -> String)
-> ([Script elem] -> ShowS)
-> Show (Script elem)
forall elem. Show elem => Int -> Script elem -> ShowS
forall elem. Show elem => [Script elem] -> ShowS
forall elem. Show elem => Script elem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Script elem] -> ShowS
$cshowList :: forall elem. Show elem => [Script elem] -> ShowS
show :: Script elem -> String
$cshow :: forall elem. Show elem => Script elem -> String
showsPrec :: Int -> Script elem -> ShowS
$cshowsPrec :: forall elem. Show elem => Int -> Script elem -> ShowS
Show, Script elem -> Script elem -> Bool
(Script elem -> Script elem -> Bool)
-> (Script elem -> Script elem -> Bool) -> Eq (Script elem)
forall elem. Eq elem => Script elem -> Script elem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Script elem -> Script elem -> Bool
$c/= :: forall elem. Eq elem => Script elem -> Script elem -> Bool
== :: Script elem -> Script elem -> Bool
$c== :: forall elem. Eq elem => Script elem -> Script elem -> Bool
Eq)
instance NFData elem => NFData (Script elem)
serializeScript :: Script KeyHash -> ByteString
serializeScript :: Script KeyHash -> ByteString
serializeScript Script KeyHash
script =
ByteString
multisigTag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Encoding -> ByteString
CBOR.toStrictByteString (Script KeyHash -> Encoding
toCBOR Script KeyHash
script)
where
multisigTag :: ByteString
multisigTag :: ByteString
multisigTag = ByteString
"\00"
toCBOR :: Script KeyHash -> CBOR.Encoding
toCBOR :: Script KeyHash -> Encoding
toCBOR = \case
RequireSignatureOf (KeyHash KeyRole
_ ByteString
verKeyHash) ->
Word -> Word -> Encoding
encodeMultiscriptCtr Word
0 Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
verKeyHash
RequireAllOf [Script KeyHash]
contents ->
Word -> Word -> Encoding
encodeMultiscriptCtr Word
1 Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Script KeyHash -> Encoding) -> [Script KeyHash] -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldable Script KeyHash -> Encoding
toCBOR [Script KeyHash]
contents
RequireAnyOf [Script KeyHash]
contents ->
Word -> Word -> Encoding
encodeMultiscriptCtr Word
2 Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Script KeyHash -> Encoding) -> [Script KeyHash] -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldable Script KeyHash -> Encoding
toCBOR [Script KeyHash]
contents
RequireSomeOf Word8
m [Script KeyHash]
contents -> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
[ Word -> Word -> Encoding
encodeMultiscriptCtr Word
3 Word
3
, Int -> Encoding
CBOR.encodeInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
m)
, (Script KeyHash -> Encoding) -> [Script KeyHash] -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldable Script KeyHash -> Encoding
toCBOR [Script KeyHash]
contents
]
ActiveFromSlot Natural
slotNum ->
Word -> Word -> Encoding
encodeMultiscriptCtr Word
4 Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
CBOR.encodeWord64 (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
slotNum)
ActiveUntilSlot Natural
slotNum ->
Word -> Word -> Encoding
encodeMultiscriptCtr Word
5 Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
CBOR.encodeWord64 (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
slotNum)
encodeMultiscriptCtr :: Word -> Word -> CBOR.Encoding
encodeMultiscriptCtr :: Word -> Word -> Encoding
encodeMultiscriptCtr Word
ctrIndex Word
listLen =
Word -> Encoding
CBOR.encodeListLen Word
listLen Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
ctrIndex
encodeFoldable :: (Foldable f) => (a -> CBOR.Encoding) -> f a -> CBOR.Encoding
encodeFoldable :: (a -> Encoding) -> f a -> Encoding
encodeFoldable a -> Encoding
encode' f a
xs = Word -> Encoding -> Encoding
wrapArray Word
len Encoding
contents
where
(Word
len, Encoding
contents) = ((Word, Encoding) -> a -> (Word, Encoding))
-> (Word, Encoding) -> f a -> (Word, Encoding)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word, Encoding) -> a -> (Word, Encoding)
forall a. Num a => (a, Encoding) -> a -> (a, Encoding)
go (Word
0, Encoding
forall a. Monoid a => a
mempty) f a
xs
go :: (a, Encoding) -> a -> (a, Encoding)
go (!a
l, !Encoding
enc) a
next = (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, Encoding
enc Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
encode' a
next)
wrapArray :: Word -> CBOR.Encoding -> CBOR.Encoding
wrapArray :: Word -> Encoding -> Encoding
wrapArray Word
len' Encoding
contents'
| Word
len' Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
23 = Word -> Encoding
CBOR.encodeListLen Word
len' Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
contents'
| Bool
otherwise = Encoding
CBOR.encodeListLenIndef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
contents' Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeBreak
newtype Cosigner = Cosigner Word8
deriving ((forall x. Cosigner -> Rep Cosigner x)
-> (forall x. Rep Cosigner x -> Cosigner) -> Generic Cosigner
forall x. Rep Cosigner x -> Cosigner
forall x. Cosigner -> Rep Cosigner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cosigner x -> Cosigner
$cfrom :: forall x. Cosigner -> Rep Cosigner x
Generic, Eq Cosigner
Eq Cosigner
-> (Cosigner -> Cosigner -> Ordering)
-> (Cosigner -> Cosigner -> Bool)
-> (Cosigner -> Cosigner -> Bool)
-> (Cosigner -> Cosigner -> Bool)
-> (Cosigner -> Cosigner -> Bool)
-> (Cosigner -> Cosigner -> Cosigner)
-> (Cosigner -> Cosigner -> Cosigner)
-> Ord Cosigner
Cosigner -> Cosigner -> Bool
Cosigner -> Cosigner -> Ordering
Cosigner -> Cosigner -> Cosigner
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 :: Cosigner -> Cosigner -> Cosigner
$cmin :: Cosigner -> Cosigner -> Cosigner
max :: Cosigner -> Cosigner -> Cosigner
$cmax :: Cosigner -> Cosigner -> Cosigner
>= :: Cosigner -> Cosigner -> Bool
$c>= :: Cosigner -> Cosigner -> Bool
> :: Cosigner -> Cosigner -> Bool
$c> :: Cosigner -> Cosigner -> Bool
<= :: Cosigner -> Cosigner -> Bool
$c<= :: Cosigner -> Cosigner -> Bool
< :: Cosigner -> Cosigner -> Bool
$c< :: Cosigner -> Cosigner -> Bool
compare :: Cosigner -> Cosigner -> Ordering
$ccompare :: Cosigner -> Cosigner -> Ordering
$cp1Ord :: Eq Cosigner
Ord, Cosigner -> Cosigner -> Bool
(Cosigner -> Cosigner -> Bool)
-> (Cosigner -> Cosigner -> Bool) -> Eq Cosigner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cosigner -> Cosigner -> Bool
$c/= :: Cosigner -> Cosigner -> Bool
== :: Cosigner -> Cosigner -> Bool
$c== :: Cosigner -> Cosigner -> Bool
Eq)
instance Hashable Cosigner
instance NFData Cosigner
instance Show Cosigner where
show :: Cosigner -> String
show = Text -> String
T.unpack (Text -> String) -> (Cosigner -> Text) -> Cosigner -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosigner -> Text
cosignerToText
data ScriptTemplate = ScriptTemplate
{ ScriptTemplate -> Map Cosigner XPub
cosigners :: Map Cosigner XPub
, ScriptTemplate -> Script Cosigner
template :: Script Cosigner
} deriving ((forall x. ScriptTemplate -> Rep ScriptTemplate x)
-> (forall x. Rep ScriptTemplate x -> ScriptTemplate)
-> Generic ScriptTemplate
forall x. Rep ScriptTemplate x -> ScriptTemplate
forall x. ScriptTemplate -> Rep ScriptTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptTemplate x -> ScriptTemplate
$cfrom :: forall x. ScriptTemplate -> Rep ScriptTemplate x
Generic, Int -> ScriptTemplate -> ShowS
[ScriptTemplate] -> ShowS
ScriptTemplate -> String
(Int -> ScriptTemplate -> ShowS)
-> (ScriptTemplate -> String)
-> ([ScriptTemplate] -> ShowS)
-> Show ScriptTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptTemplate] -> ShowS
$cshowList :: [ScriptTemplate] -> ShowS
show :: ScriptTemplate -> String
$cshow :: ScriptTemplate -> String
showsPrec :: Int -> ScriptTemplate -> ShowS
$cshowsPrec :: Int -> ScriptTemplate -> ShowS
Show, ScriptTemplate -> ScriptTemplate -> Bool
(ScriptTemplate -> ScriptTemplate -> Bool)
-> (ScriptTemplate -> ScriptTemplate -> Bool) -> Eq ScriptTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptTemplate -> ScriptTemplate -> Bool
$c/= :: ScriptTemplate -> ScriptTemplate -> Bool
== :: ScriptTemplate -> ScriptTemplate -> Bool
$c== :: ScriptTemplate -> ScriptTemplate -> Bool
Eq)
instance NFData ScriptTemplate
toScriptHash :: Script KeyHash -> ScriptHash
toScriptHash :: Script KeyHash -> ScriptHash
toScriptHash = ByteString -> ScriptHash
ScriptHash (ByteString -> ScriptHash)
-> (Script KeyHash -> ByteString) -> Script KeyHash -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Script KeyHash -> ByteString) -> Script KeyHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script KeyHash -> ByteString
serializeScript
newtype ScriptHash = ScriptHash { ScriptHash -> ByteString
unScriptHash :: ByteString }
deriving ((forall x. ScriptHash -> Rep ScriptHash x)
-> (forall x. Rep ScriptHash x -> ScriptHash) -> Generic ScriptHash
forall x. Rep ScriptHash x -> ScriptHash
forall x. ScriptHash -> Rep ScriptHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptHash x -> ScriptHash
$cfrom :: forall x. ScriptHash -> Rep ScriptHash x
Generic, Int -> ScriptHash -> ShowS
[ScriptHash] -> ShowS
ScriptHash -> String
(Int -> ScriptHash -> ShowS)
-> (ScriptHash -> String)
-> ([ScriptHash] -> ShowS)
-> Show ScriptHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptHash] -> ShowS
$cshowList :: [ScriptHash] -> ShowS
show :: ScriptHash -> String
$cshow :: ScriptHash -> String
showsPrec :: Int -> ScriptHash -> ShowS
$cshowsPrec :: Int -> ScriptHash -> ShowS
Show, Eq ScriptHash
Eq ScriptHash
-> (ScriptHash -> ScriptHash -> Ordering)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> ScriptHash)
-> (ScriptHash -> ScriptHash -> ScriptHash)
-> Ord ScriptHash
ScriptHash -> ScriptHash -> Bool
ScriptHash -> ScriptHash -> Ordering
ScriptHash -> ScriptHash -> ScriptHash
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 :: ScriptHash -> ScriptHash -> ScriptHash
$cmin :: ScriptHash -> ScriptHash -> ScriptHash
max :: ScriptHash -> ScriptHash -> ScriptHash
$cmax :: ScriptHash -> ScriptHash -> ScriptHash
>= :: ScriptHash -> ScriptHash -> Bool
$c>= :: ScriptHash -> ScriptHash -> Bool
> :: ScriptHash -> ScriptHash -> Bool
$c> :: ScriptHash -> ScriptHash -> Bool
<= :: ScriptHash -> ScriptHash -> Bool
$c<= :: ScriptHash -> ScriptHash -> Bool
< :: ScriptHash -> ScriptHash -> Bool
$c< :: ScriptHash -> ScriptHash -> Bool
compare :: ScriptHash -> ScriptHash -> Ordering
$ccompare :: ScriptHash -> ScriptHash -> Ordering
$cp1Ord :: Eq ScriptHash
Ord, ScriptHash -> ScriptHash -> Bool
(ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool) -> Eq ScriptHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptHash -> ScriptHash -> Bool
$c/= :: ScriptHash -> ScriptHash -> Bool
== :: ScriptHash -> ScriptHash -> Bool
$c== :: ScriptHash -> ScriptHash -> Bool
Eq)
instance NFData ScriptHash
scriptHashFromBytes :: ByteString -> Maybe ScriptHash
scriptHashFromBytes :: ByteString -> Maybe ScriptHash
scriptHashFromBytes ByteString
bytes
| ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
credentialHashSize = Maybe ScriptHash
forall a. Maybe a
Nothing
| Bool
otherwise = ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash) -> ScriptHash -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ScriptHash
ScriptHash ByteString
bytes
data KeyRole = Payment | Delegation | Policy
deriving ((forall x. KeyRole -> Rep KeyRole x)
-> (forall x. Rep KeyRole x -> KeyRole) -> Generic KeyRole
forall x. Rep KeyRole x -> KeyRole
forall x. KeyRole -> Rep KeyRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyRole x -> KeyRole
$cfrom :: forall x. KeyRole -> Rep KeyRole x
Generic, Int -> KeyRole -> ShowS
[KeyRole] -> ShowS
KeyRole -> String
(Int -> KeyRole -> ShowS)
-> (KeyRole -> String) -> ([KeyRole] -> ShowS) -> Show KeyRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyRole] -> ShowS
$cshowList :: [KeyRole] -> ShowS
show :: KeyRole -> String
$cshow :: KeyRole -> String
showsPrec :: Int -> KeyRole -> ShowS
$cshowsPrec :: Int -> KeyRole -> ShowS
Show, Eq KeyRole
Eq KeyRole
-> (KeyRole -> KeyRole -> Ordering)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> KeyRole)
-> (KeyRole -> KeyRole -> KeyRole)
-> Ord KeyRole
KeyRole -> KeyRole -> Bool
KeyRole -> KeyRole -> Ordering
KeyRole -> KeyRole -> KeyRole
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 :: KeyRole -> KeyRole -> KeyRole
$cmin :: KeyRole -> KeyRole -> KeyRole
max :: KeyRole -> KeyRole -> KeyRole
$cmax :: KeyRole -> KeyRole -> KeyRole
>= :: KeyRole -> KeyRole -> Bool
$c>= :: KeyRole -> KeyRole -> Bool
> :: KeyRole -> KeyRole -> Bool
$c> :: KeyRole -> KeyRole -> Bool
<= :: KeyRole -> KeyRole -> Bool
$c<= :: KeyRole -> KeyRole -> Bool
< :: KeyRole -> KeyRole -> Bool
$c< :: KeyRole -> KeyRole -> Bool
compare :: KeyRole -> KeyRole -> Ordering
$ccompare :: KeyRole -> KeyRole -> Ordering
$cp1Ord :: Eq KeyRole
Ord, KeyRole -> KeyRole -> Bool
(KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool) -> Eq KeyRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyRole -> KeyRole -> Bool
$c/= :: KeyRole -> KeyRole -> Bool
== :: KeyRole -> KeyRole -> Bool
$c== :: KeyRole -> KeyRole -> Bool
Eq)
instance NFData KeyRole
data KeyHash = KeyHash
{ KeyHash -> KeyRole
role :: KeyRole
, KeyHash -> ByteString
digest :: ByteString }
deriving ((forall x. KeyHash -> Rep KeyHash x)
-> (forall x. Rep KeyHash x -> KeyHash) -> Generic KeyHash
forall x. Rep KeyHash x -> KeyHash
forall x. KeyHash -> Rep KeyHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyHash x -> KeyHash
$cfrom :: forall x. KeyHash -> Rep KeyHash x
Generic, Int -> KeyHash -> ShowS
[KeyHash] -> ShowS
KeyHash -> String
(Int -> KeyHash -> ShowS)
-> (KeyHash -> String) -> ([KeyHash] -> ShowS) -> Show KeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyHash] -> ShowS
$cshowList :: [KeyHash] -> ShowS
show :: KeyHash -> String
$cshow :: KeyHash -> String
showsPrec :: Int -> KeyHash -> ShowS
$cshowsPrec :: Int -> KeyHash -> ShowS
Show, Eq KeyHash
Eq KeyHash
-> (KeyHash -> KeyHash -> Ordering)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> KeyHash)
-> (KeyHash -> KeyHash -> KeyHash)
-> Ord KeyHash
KeyHash -> KeyHash -> Bool
KeyHash -> KeyHash -> Ordering
KeyHash -> KeyHash -> KeyHash
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 :: KeyHash -> KeyHash -> KeyHash
$cmin :: KeyHash -> KeyHash -> KeyHash
max :: KeyHash -> KeyHash -> KeyHash
$cmax :: KeyHash -> KeyHash -> KeyHash
>= :: KeyHash -> KeyHash -> Bool
$c>= :: KeyHash -> KeyHash -> Bool
> :: KeyHash -> KeyHash -> Bool
$c> :: KeyHash -> KeyHash -> Bool
<= :: KeyHash -> KeyHash -> Bool
$c<= :: KeyHash -> KeyHash -> Bool
< :: KeyHash -> KeyHash -> Bool
$c< :: KeyHash -> KeyHash -> Bool
compare :: KeyHash -> KeyHash -> Ordering
$ccompare :: KeyHash -> KeyHash -> Ordering
$cp1Ord :: Eq KeyHash
Ord, KeyHash -> KeyHash -> Bool
(KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool) -> Eq KeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyHash -> KeyHash -> Bool
$c/= :: KeyHash -> KeyHash -> Bool
== :: KeyHash -> KeyHash -> Bool
$c== :: KeyHash -> KeyHash -> Bool
Eq)
instance NFData KeyHash
keyHashFromBytes :: (KeyRole, ByteString) -> Maybe KeyHash
keyHashFromBytes :: (KeyRole, ByteString) -> Maybe KeyHash
keyHashFromBytes (KeyRole
cred, ByteString
bytes)
| ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
credentialHashSize = Maybe KeyHash
forall a. Maybe a
Nothing
| Bool
otherwise = KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just (KeyHash -> Maybe KeyHash) -> KeyHash -> Maybe KeyHash
forall a b. (a -> b) -> a -> b
$ KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
cred ByteString
bytes
keyHashToText :: KeyHash -> Text
keyHashToText :: KeyHash -> Text
keyHashToText (KeyHash KeyRole
cred ByteString
keyHash) = case KeyRole
cred of
KeyRole
Payment ->
ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.addr_shared_vkh) ByteString
keyHash
KeyRole
Delegation ->
ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.stake_shared_vkh) ByteString
keyHash
KeyRole
Policy ->
ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.policy_vkh) ByteString
keyHash
keyHashFromText :: Text -> Either ErrKeyHashFromText KeyHash
keyHashFromText :: Text -> Either ErrKeyHashFromText KeyHash
keyHashFromText Text
txt = do
(HumanReadablePart
hrp, DataPart
dp) <- (DecodingError -> ErrKeyHashFromText)
-> Either DecodingError (HumanReadablePart, DataPart)
-> Either ErrKeyHashFromText (HumanReadablePart, DataPart)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ErrKeyHashFromText -> DecodingError -> ErrKeyHashFromText
forall a b. a -> b -> a
const ErrKeyHashFromText
ErrKeyHashFromTextInvalidString) (Either DecodingError (HumanReadablePart, DataPart)
-> Either ErrKeyHashFromText (HumanReadablePart, DataPart))
-> Either DecodingError (HumanReadablePart, DataPart)
-> Either ErrKeyHashFromText (HumanReadablePart, DataPart)
forall a b. (a -> b) -> a -> b
$
Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient Text
txt
ErrKeyHashFromText
-> Maybe ByteString -> Either ErrKeyHashFromText ByteString
forall b a. b -> Maybe a -> Either b a
maybeToRight ErrKeyHashFromText
ErrKeyHashFromTextWrongDataPart (DataPart -> Maybe ByteString
Bech32.dataPartToBytes DataPart
dp)
Either ErrKeyHashFromText ByteString
-> (ByteString -> Either ErrKeyHashFromText (KeyRole, ByteString))
-> Either ErrKeyHashFromText (KeyRole, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrKeyHashFromText
-> Maybe (KeyRole, ByteString)
-> Either ErrKeyHashFromText (KeyRole, ByteString)
forall b a. b -> Maybe a -> Either b a
maybeToRight ErrKeyHashFromText
ErrKeyHashFromTextWrongHrp (Maybe (KeyRole, ByteString)
-> Either ErrKeyHashFromText (KeyRole, ByteString))
-> (ByteString -> Maybe (KeyRole, ByteString))
-> ByteString
-> Either ErrKeyHashFromText (KeyRole, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HumanReadablePart -> ByteString -> Maybe (KeyRole, ByteString)
convertBytes HumanReadablePart
hrp
Either ErrKeyHashFromText (KeyRole, ByteString)
-> ((KeyRole, ByteString) -> Either ErrKeyHashFromText KeyHash)
-> Either ErrKeyHashFromText KeyHash
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrKeyHashFromText
-> Maybe KeyHash -> Either ErrKeyHashFromText KeyHash
forall b a. b -> Maybe a -> Either b a
maybeToRight ErrKeyHashFromText
ErrKeyHashFromTextWrongPayload (Maybe KeyHash -> Either ErrKeyHashFromText KeyHash)
-> ((KeyRole, ByteString) -> Maybe KeyHash)
-> (KeyRole, ByteString)
-> Either ErrKeyHashFromText KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyRole, ByteString) -> Maybe KeyHash
keyHashFromBytes
where
convertBytes :: HumanReadablePart -> ByteString -> Maybe (KeyRole, ByteString)
convertBytes HumanReadablePart
hrp ByteString
bytes
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_shared_vkh = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_shared_vkh = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_vkh = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_vkh = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.policy_vkh = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Policy, ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_shared_vk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_vk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_shared_xvk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_xvk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_shared_vk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_vk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_shared_xvk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_xvk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.policy_vk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Policy, ByteString -> ByteString
hashCredential ByteString
bytes)
| HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.policy_xvk = (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Policy, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
| Bool
otherwise = Maybe (KeyRole, ByteString)
forall a. Maybe a
Nothing
data ValidationLevel = RequiredValidation | RecommendedValidation
deriving (Int -> ValidationLevel -> ShowS
[ValidationLevel] -> ShowS
ValidationLevel -> String
(Int -> ValidationLevel -> ShowS)
-> (ValidationLevel -> String)
-> ([ValidationLevel] -> ShowS)
-> Show ValidationLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationLevel] -> ShowS
$cshowList :: [ValidationLevel] -> ShowS
show :: ValidationLevel -> String
$cshow :: ValidationLevel -> String
showsPrec :: Int -> ValidationLevel -> ShowS
$cshowsPrec :: Int -> ValidationLevel -> ShowS
Show, ValidationLevel -> ValidationLevel -> Bool
(ValidationLevel -> ValidationLevel -> Bool)
-> (ValidationLevel -> ValidationLevel -> Bool)
-> Eq ValidationLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationLevel -> ValidationLevel -> Bool
$c/= :: ValidationLevel -> ValidationLevel -> Bool
== :: ValidationLevel -> ValidationLevel -> Bool
$c== :: ValidationLevel -> ValidationLevel -> Bool
Eq, (forall x. ValidationLevel -> Rep ValidationLevel x)
-> (forall x. Rep ValidationLevel x -> ValidationLevel)
-> Generic ValidationLevel
forall x. Rep ValidationLevel x -> ValidationLevel
forall x. ValidationLevel -> Rep ValidationLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidationLevel x -> ValidationLevel
$cfrom :: forall x. ValidationLevel -> Rep ValidationLevel x
Generic)
instance NFData ValidationLevel
data ErrKeyHashFromText
= ErrKeyHashFromTextInvalidString
| ErrKeyHashFromTextWrongPayload
| ErrKeyHashFromTextWrongHrp
| ErrKeyHashFromTextWrongDataPart
deriving (Int -> ErrKeyHashFromText -> ShowS
[ErrKeyHashFromText] -> ShowS
ErrKeyHashFromText -> String
(Int -> ErrKeyHashFromText -> ShowS)
-> (ErrKeyHashFromText -> String)
-> ([ErrKeyHashFromText] -> ShowS)
-> Show ErrKeyHashFromText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrKeyHashFromText] -> ShowS
$cshowList :: [ErrKeyHashFromText] -> ShowS
show :: ErrKeyHashFromText -> String
$cshow :: ErrKeyHashFromText -> String
showsPrec :: Int -> ErrKeyHashFromText -> ShowS
$cshowsPrec :: Int -> ErrKeyHashFromText -> ShowS
Show, ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
(ErrKeyHashFromText -> ErrKeyHashFromText -> Bool)
-> (ErrKeyHashFromText -> ErrKeyHashFromText -> Bool)
-> Eq ErrKeyHashFromText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
$c/= :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
== :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
$c== :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
Eq)
prettyErrKeyHashFromText :: ErrKeyHashFromText -> String
prettyErrKeyHashFromText :: ErrKeyHashFromText -> String
prettyErrKeyHashFromText = \case
ErrKeyHashFromText
ErrKeyHashFromTextInvalidString ->
String
"Invalid encoded string: must be bech32-encoded."
ErrKeyHashFromText
ErrKeyHashFromTextWrongPayload ->
String
"Verification key hash must contain exactly 28 bytes."
ErrKeyHashFromText
ErrKeyHashFromTextWrongHrp ->
String
"Invalid human-readable prefix: must be 'X_vkh', 'X_vk', 'X_xvk' where X is 'addr_shared', 'stake_shared' or 'policy'."
ErrKeyHashFromText
ErrKeyHashFromTextWrongDataPart ->
String
"Verification key hash is Bech32-encoded but has an invalid data part."
foldScript :: (a -> b -> b) -> b -> Script a -> b
foldScript :: (a -> b -> b) -> b -> Script a -> b
foldScript a -> b -> b
fn b
zero = \case
RequireSignatureOf a
k -> a -> b -> b
fn a
k b
zero
RequireAllOf [Script a]
xs -> [Script a] -> b
foldMScripts [Script a]
xs
RequireAnyOf [Script a]
xs -> [Script a] -> b
foldMScripts [Script a]
xs
RequireSomeOf Word8
_ [Script a]
xs -> [Script a] -> b
foldMScripts [Script a]
xs
ActiveFromSlot Natural
_ -> b
zero
ActiveUntilSlot Natural
_ -> b
zero
where
foldMScripts :: [Script a] -> b
foldMScripts =
Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> ([Script a] -> Identity b) -> [Script a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Script a -> Identity b) -> b -> [Script a] -> Identity b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\b
acc -> b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (Script a -> b) -> Script a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> Script a -> b
forall a b. (a -> b -> b) -> b -> Script a -> b
foldScript a -> b -> b
fn b
acc) b
zero
validateScript
:: ValidationLevel
-> Script KeyHash
-> Either ErrValidateScript ()
validateScript :: ValidationLevel -> Script KeyHash -> Either ErrValidateScript ()
validateScript ValidationLevel
level Script KeyHash
script = do
let validateKeyHash :: KeyHash -> Bool
validateKeyHash (KeyHash KeyRole
_ ByteString
bytes) =
(ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize)
let allSigs :: [KeyHash]
allSigs = (KeyHash -> [KeyHash] -> [KeyHash])
-> [KeyHash] -> Script KeyHash -> [KeyHash]
forall a b. (a -> b -> b) -> b -> Script a -> b
foldScript (:) [] Script KeyHash
script
Bool -> Either ErrValidateScript () -> Either ErrValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((KeyHash -> Bool) -> [KeyHash] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.all KeyHash -> Bool
validateKeyHash [KeyHash]
allSigs) (Either ErrValidateScript () -> Either ErrValidateScript ())
-> Either ErrValidateScript () -> Either ErrValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrValidateScript -> Either ErrValidateScript ()
forall a b. a -> Either a b
Left ErrValidateScript
WrongKeyHash
Bool -> Either ErrValidateScript () -> Either ErrValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([KeyRole] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([KeyRole] -> [KeyRole]
forall a. Eq a => [a] -> [a]
L.nub ([KeyRole] -> [KeyRole]) -> [KeyRole] -> [KeyRole]
forall a b. (a -> b) -> a -> b
$ (KeyHash -> KeyRole) -> [KeyHash] -> [KeyRole]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash -> KeyRole
role [KeyHash]
allSigs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Either ErrValidateScript () -> Either ErrValidateScript ())
-> Either ErrValidateScript () -> Either ErrValidateScript ()
forall a b. (a -> b) -> a -> b
$
ErrValidateScript -> Either ErrValidateScript ()
forall a b. a -> Either a b
Left ErrValidateScript
NotUniformKeyType
Script KeyHash -> Either ErrValidateScript ()
forall elem. Script elem -> Either ErrValidateScript ()
requiredValidation Script KeyHash
script
Bool -> Either ErrValidateScript () -> Either ErrValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValidationLevel
level ValidationLevel -> ValidationLevel -> Bool
forall a. Eq a => a -> a -> Bool
== ValidationLevel
RecommendedValidation) (Either ErrValidateScript () -> Either ErrValidateScript ())
-> Either ErrValidateScript () -> Either ErrValidateScript ()
forall a b. (a -> b) -> a -> b
$
(ErrRecommendedValidateScript -> ErrValidateScript)
-> Either ErrRecommendedValidateScript ()
-> Either ErrValidateScript ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ErrRecommendedValidateScript -> ErrValidateScript
NotRecommended (Script KeyHash -> Either ErrRecommendedValidateScript ()
forall elem.
Eq elem =>
Script elem -> Either ErrRecommendedValidateScript ()
recommendedValidation Script KeyHash
script)
requiredValidation
:: Script elem
-> Either ErrValidateScript ()
requiredValidation :: Script elem -> Either ErrValidateScript ()
requiredValidation Script elem
script =
Bool -> Either ErrValidateScript () -> Either ErrValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Script elem -> Bool
forall elem. Script elem -> Bool
check Script elem
script) (Either ErrValidateScript () -> Either ErrValidateScript ())
-> Either ErrValidateScript () -> Either ErrValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrValidateScript -> Either ErrValidateScript ()
forall a b. a -> Either a b
Left ErrValidateScript
LedgerIncompatible
where
check :: Script elem -> Bool
check = \case
RequireSignatureOf elem
_ -> Bool
True
RequireAllOf [Script elem]
xs ->
(Script elem -> Bool) -> [Script elem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.all Script elem -> Bool
check [Script elem]
xs
RequireAnyOf [Script elem]
xs ->
(Script elem -> Bool) -> [Script elem] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any Script elem -> Bool
check [Script elem]
xs
RequireSomeOf Word8
m [Script elem]
xs ->
Word8
m Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= [Word8] -> Word8
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Script elem -> Word8) -> [Script elem] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Script elem
x -> if Script elem -> Bool
check Script elem
x then Word8
1 else Word8
0) [Script elem]
xs)
ActiveFromSlot Natural
_ -> Bool
True
ActiveUntilSlot Natural
_ -> Bool
True
recommendedValidation
:: Eq elem
=> Script elem
-> Either ErrRecommendedValidateScript ()
recommendedValidation :: Script elem -> Either ErrRecommendedValidateScript ()
recommendedValidation = \case
RequireSignatureOf elem
_ -> () -> Either ErrRecommendedValidateScript ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
RequireAllOf [Script elem]
script -> do
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null ([Script elem] -> [Script elem]
forall elem. [Script elem] -> [Script elem]
omitTimelocks [Script elem]
script)) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
EmptyList
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall a. Eq a => [Script a] -> Bool
hasDuplicate [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
DuplicateSignatures
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall elem. [Script elem] -> Bool
redundantTimelocks [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
RedundantTimelocks
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall elem. [Script elem] -> Bool
timelockTrap [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
TimelockTrap
(Script elem -> Either ErrRecommendedValidateScript ())
-> [Script elem] -> Either ErrRecommendedValidateScript ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Script elem -> Either ErrRecommendedValidateScript ()
forall elem.
Eq elem =>
Script elem -> Either ErrRecommendedValidateScript ()
recommendedValidation [Script elem]
script
RequireAnyOf [Script elem]
script -> do
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall a. Eq a => [Script a] -> Bool
hasDuplicate [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
DuplicateSignatures
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall elem. [Script elem] -> Bool
redundantTimelocks [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
RedundantTimelocks
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall elem. [Script elem] -> Bool
redundantTimelocksInAny [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
RedundantTimelocks
(Script elem -> Either ErrRecommendedValidateScript ())
-> [Script elem] -> Either ErrRecommendedValidateScript ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Script elem -> Either ErrRecommendedValidateScript ()
forall elem.
Eq elem =>
Script elem -> Either ErrRecommendedValidateScript ()
recommendedValidation [Script elem]
script
RequireSomeOf Word8
m [Script elem]
script -> do
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
MZero
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Script elem] -> [Script elem]
forall elem. [Script elem] -> [Script elem]
omitTimelocks [Script elem]
script) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
ListTooSmall
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall a. Eq a => [Script a] -> Bool
hasDuplicate [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
DuplicateSignatures
Bool
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Script elem] -> Bool
forall elem. [Script elem] -> Bool
redundantTimelocks [Script elem]
script) (Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ())
-> Either ErrRecommendedValidateScript ()
-> Either ErrRecommendedValidateScript ()
forall a b. (a -> b) -> a -> b
$ ErrRecommendedValidateScript
-> Either ErrRecommendedValidateScript ()
forall a b. a -> Either a b
Left ErrRecommendedValidateScript
RedundantTimelocks
(Script elem -> Either ErrRecommendedValidateScript ())
-> [Script elem] -> Either ErrRecommendedValidateScript ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Script elem -> Either ErrRecommendedValidateScript ()
forall elem.
Eq elem =>
Script elem -> Either ErrRecommendedValidateScript ()
recommendedValidation [Script elem]
script
ActiveFromSlot Natural
_ -> () -> Either ErrRecommendedValidateScript ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ActiveUntilSlot Natural
_ -> () -> Either ErrRecommendedValidateScript ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
hasDuplicate :: [Script a] -> Bool
hasDuplicate [Script a]
xs =
[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
L.nub [a]
sigs)
where
sigs :: [a]
sigs = [ a
sig | RequireSignatureOf a
sig <- [Script a]
xs ]
hasTimelocks :: Script elem -> Bool
hasTimelocks = \case
ActiveFromSlot Natural
_ -> Bool
True
ActiveUntilSlot Natural
_ -> Bool
True
Script elem
_ -> Bool
False
redundantTimelocks :: [Script elem] -> Bool
redundantTimelocks [Script elem]
xs = case (Script elem -> Bool) -> [Script elem] -> [Script elem]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Script elem -> Bool
forall elem. Script elem -> Bool
hasTimelocks [Script elem]
xs of
[] -> Bool
False
[Script elem
_] -> Bool
False
[Script elem
_, Script elem
_] -> Bool
False
[Script elem]
_ -> Bool
True
redundantTimelocksInAny :: [Script elem] -> Bool
redundantTimelocksInAny [Script elem]
xs = case (Script elem -> Bool) -> [Script elem] -> [Script elem]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Script elem -> Bool
forall elem. Script elem -> Bool
hasTimelocks [Script elem]
xs of
[] -> Bool
False
[Script elem
_] -> Bool
False
[ActiveFromSlot Natural
s1, ActiveUntilSlot Natural
s2] -> Natural
s2 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
s1
[ActiveUntilSlot Natural
s2, ActiveFromSlot Natural
s1] -> Natural
s2 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
s1
[Script elem]
_ -> Bool
True
timelockTrap :: [Script elem] -> Bool
timelockTrap [Script elem]
xs = case (Script elem -> Bool) -> [Script elem] -> [Script elem]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Script elem -> Bool
forall elem. Script elem -> Bool
hasTimelocks [Script elem]
xs of
[ActiveFromSlot Natural
s1, ActiveUntilSlot Natural
s2] -> Natural
s2 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
s1
[ActiveUntilSlot Natural
s2, ActiveFromSlot Natural
s1] -> Natural
s2 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
s1
[Script elem]
_ -> Bool
False
omitTimelocks :: [Script elem] -> [Script elem]
omitTimelocks = (Script elem -> Bool) -> [Script elem] -> [Script elem]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Script elem -> Bool) -> Script elem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script elem -> Bool
forall elem. Script elem -> Bool
hasTimelocks)
validateScriptTemplate
:: ValidationLevel
-> ScriptTemplate
-> Either ErrValidateScriptTemplate ()
validateScriptTemplate :: ValidationLevel
-> ScriptTemplate -> Either ErrValidateScriptTemplate ()
validateScriptTemplate ValidationLevel
level (ScriptTemplate Map Cosigner XPub
cosigners_ Script Cosigner
script) = do
(ErrValidateScript -> ErrValidateScriptTemplate)
-> Either ErrValidateScript ()
-> Either ErrValidateScriptTemplate ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ErrValidateScript -> ErrValidateScriptTemplate
WrongScript (ValidationLevel -> Script Cosigner -> Either ErrValidateScript ()
validateScriptOfTemplate ValidationLevel
level Script Cosigner
script)
ErrValidateScriptTemplate
-> Bool -> Either ErrValidateScriptTemplate ()
forall a. a -> Bool -> Either a ()
check ErrValidateScriptTemplate
NoCosignerInScript (HashSet Cosigner -> Bool
forall a. HashSet a -> Bool
nonEmpty HashSet Cosigner
scriptCosigners)
ErrValidateScriptTemplate
-> Bool -> Either ErrValidateScriptTemplate ()
forall a. a -> Bool -> Either a ()
check ErrValidateScriptTemplate
NoCosignerXPub (HashSet XPub -> Bool
forall a. HashSet a -> Bool
nonEmpty HashSet XPub
cosignerKeys)
ErrValidateScriptTemplate
-> Bool -> Either ErrValidateScriptTemplate ()
forall a. a -> Bool -> Either a ()
check ErrValidateScriptTemplate
DuplicateXPubs (HashSet XPub -> Int
forall a. HashSet a -> Int
Set.size HashSet XPub
cosignerKeys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Map Cosigner XPub -> Int
forall k a. Map k a -> Int
Map.size Map Cosigner XPub
cosigners_)
ErrValidateScriptTemplate
-> Bool -> Either ErrValidateScriptTemplate ()
forall a. a -> Bool -> Either a ()
check ErrValidateScriptTemplate
UnknownCosigner (HashSet Cosigner
cosignerSet HashSet Cosigner -> HashSet Cosigner -> Bool
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> Bool
`Set.isSubsetOf` HashSet Cosigner
scriptCosigners)
ErrValidateScriptTemplate
-> Bool -> Either ErrValidateScriptTemplate ()
forall a. a -> Bool -> Either a ()
check ErrValidateScriptTemplate
MissingCosignerXPub (HashSet Cosigner
scriptCosigners HashSet Cosigner -> HashSet Cosigner -> Bool
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> Bool
`Set.isSubsetOf` HashSet Cosigner
cosignerSet)
where
scriptCosigners :: HashSet Cosigner
scriptCosigners = [Cosigner] -> HashSet Cosigner
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Cosigner] -> HashSet Cosigner) -> [Cosigner] -> HashSet Cosigner
forall a b. (a -> b) -> a -> b
$ (Cosigner -> [Cosigner] -> [Cosigner])
-> [Cosigner] -> Script Cosigner -> [Cosigner]
forall a b. (a -> b -> b) -> b -> Script a -> b
foldScript (:) [] Script Cosigner
script
cosignerKeys :: HashSet XPub
cosignerKeys = [XPub] -> HashSet XPub
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([XPub] -> HashSet XPub) -> [XPub] -> HashSet XPub
forall a b. (a -> b) -> a -> b
$ Map Cosigner XPub -> [XPub]
forall k a. Map k a -> [a]
Map.elems Map Cosigner XPub
cosigners_
cosignerSet :: HashSet Cosigner
cosignerSet = [Cosigner] -> HashSet Cosigner
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Cosigner] -> HashSet Cosigner) -> [Cosigner] -> HashSet Cosigner
forall a b. (a -> b) -> a -> b
$ Map Cosigner XPub -> [Cosigner]
forall k a. Map k a -> [k]
Map.keys Map Cosigner XPub
cosigners_
check :: a -> Bool -> Either a ()
check a
err Bool
cond = Bool -> Either a () -> Either a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cond (a -> Either a ()
forall a b. a -> Either a b
Left a
err)
nonEmpty :: HashSet a -> Bool
nonEmpty = Bool -> Bool
not (Bool -> Bool) -> (HashSet a -> Bool) -> HashSet a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> Bool
forall a. HashSet a -> Bool
Set.null
validateScriptOfTemplate
:: ValidationLevel
-> Script Cosigner
-> Either ErrValidateScript ()
validateScriptOfTemplate :: ValidationLevel -> Script Cosigner -> Either ErrValidateScript ()
validateScriptOfTemplate ValidationLevel
level Script Cosigner
script = do
Script Cosigner -> Either ErrValidateScript ()
forall elem. Script elem -> Either ErrValidateScript ()
requiredValidation Script Cosigner
script
Bool -> Either ErrValidateScript () -> Either ErrValidateScript ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValidationLevel
level ValidationLevel -> ValidationLevel -> Bool
forall a. Eq a => a -> a -> Bool
== ValidationLevel
RecommendedValidation ) (Either ErrValidateScript () -> Either ErrValidateScript ())
-> Either ErrValidateScript () -> Either ErrValidateScript ()
forall a b. (a -> b) -> a -> b
$
(ErrRecommendedValidateScript -> ErrValidateScript)
-> Either ErrRecommendedValidateScript ()
-> Either ErrValidateScript ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ErrRecommendedValidateScript -> ErrValidateScript
NotRecommended (Script Cosigner -> Either ErrRecommendedValidateScript ()
forall elem.
Eq elem =>
Script elem -> Either ErrRecommendedValidateScript ()
recommendedValidation Script Cosigner
script)
data ErrValidateScript
= LedgerIncompatible
| WrongKeyHash
| NotUniformKeyType
| Malformed
| NotRecommended ErrRecommendedValidateScript
deriving (ErrValidateScript -> ErrValidateScript -> Bool
(ErrValidateScript -> ErrValidateScript -> Bool)
-> (ErrValidateScript -> ErrValidateScript -> Bool)
-> Eq ErrValidateScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrValidateScript -> ErrValidateScript -> Bool
$c/= :: ErrValidateScript -> ErrValidateScript -> Bool
== :: ErrValidateScript -> ErrValidateScript -> Bool
$c== :: ErrValidateScript -> ErrValidateScript -> Bool
Eq, Int -> ErrValidateScript -> ShowS
[ErrValidateScript] -> ShowS
ErrValidateScript -> String
(Int -> ErrValidateScript -> ShowS)
-> (ErrValidateScript -> String)
-> ([ErrValidateScript] -> ShowS)
-> Show ErrValidateScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrValidateScript] -> ShowS
$cshowList :: [ErrValidateScript] -> ShowS
show :: ErrValidateScript -> String
$cshow :: ErrValidateScript -> String
showsPrec :: Int -> ErrValidateScript -> ShowS
$cshowsPrec :: Int -> ErrValidateScript -> ShowS
Show)
data ErrRecommendedValidateScript
= EmptyList
| ListTooSmall
| MZero
| DuplicateSignatures
| RedundantTimelocks
| TimelockTrap
deriving (ErrRecommendedValidateScript
-> ErrRecommendedValidateScript -> Bool
(ErrRecommendedValidateScript
-> ErrRecommendedValidateScript -> Bool)
-> (ErrRecommendedValidateScript
-> ErrRecommendedValidateScript -> Bool)
-> Eq ErrRecommendedValidateScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrRecommendedValidateScript
-> ErrRecommendedValidateScript -> Bool
$c/= :: ErrRecommendedValidateScript
-> ErrRecommendedValidateScript -> Bool
== :: ErrRecommendedValidateScript
-> ErrRecommendedValidateScript -> Bool
$c== :: ErrRecommendedValidateScript
-> ErrRecommendedValidateScript -> Bool
Eq, Int -> ErrRecommendedValidateScript -> ShowS
[ErrRecommendedValidateScript] -> ShowS
ErrRecommendedValidateScript -> String
(Int -> ErrRecommendedValidateScript -> ShowS)
-> (ErrRecommendedValidateScript -> String)
-> ([ErrRecommendedValidateScript] -> ShowS)
-> Show ErrRecommendedValidateScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrRecommendedValidateScript] -> ShowS
$cshowList :: [ErrRecommendedValidateScript] -> ShowS
show :: ErrRecommendedValidateScript -> String
$cshow :: ErrRecommendedValidateScript -> String
showsPrec :: Int -> ErrRecommendedValidateScript -> ShowS
$cshowsPrec :: Int -> ErrRecommendedValidateScript -> ShowS
Show)
data ErrValidateScriptTemplate
= WrongScript ErrValidateScript
| DuplicateXPubs
| UnknownCosigner
| MissingCosignerXPub
| NoCosignerInScript
| NoCosignerXPub
deriving (ErrValidateScriptTemplate -> ErrValidateScriptTemplate -> Bool
(ErrValidateScriptTemplate -> ErrValidateScriptTemplate -> Bool)
-> (ErrValidateScriptTemplate -> ErrValidateScriptTemplate -> Bool)
-> Eq ErrValidateScriptTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrValidateScriptTemplate -> ErrValidateScriptTemplate -> Bool
$c/= :: ErrValidateScriptTemplate -> ErrValidateScriptTemplate -> Bool
== :: ErrValidateScriptTemplate -> ErrValidateScriptTemplate -> Bool
$c== :: ErrValidateScriptTemplate -> ErrValidateScriptTemplate -> Bool
Eq, Int -> ErrValidateScriptTemplate -> ShowS
[ErrValidateScriptTemplate] -> ShowS
ErrValidateScriptTemplate -> String
(Int -> ErrValidateScriptTemplate -> ShowS)
-> (ErrValidateScriptTemplate -> String)
-> ([ErrValidateScriptTemplate] -> ShowS)
-> Show ErrValidateScriptTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrValidateScriptTemplate] -> ShowS
$cshowList :: [ErrValidateScriptTemplate] -> ShowS
show :: ErrValidateScriptTemplate -> String
$cshow :: ErrValidateScriptTemplate -> String
showsPrec :: Int -> ErrValidateScriptTemplate -> ShowS
$cshowsPrec :: Int -> ErrValidateScriptTemplate -> ShowS
Show)
prettyErrValidateScript
:: ErrValidateScript
-> String
prettyErrValidateScript :: ErrValidateScript -> String
prettyErrValidateScript = \case
ErrValidateScript
LedgerIncompatible ->
String
"The script is ill-formed and is not going to be accepted by the ledger."
ErrValidateScript
WrongKeyHash ->
String
"The hash of verification key is expected to have "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
credentialHashSize String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes."
ErrValidateScript
NotUniformKeyType ->
String
"All keys of a script must have the same role: either payment or delegation."
ErrValidateScript
Malformed ->
String
"Parsing of the script failed. The script should be composed of nested \
\lists, the verification keys should be bech32-encoded with prefix \
\'X_vkh', 'X_vk', 'X_xvk' where X is 'addr_shared', 'stake_shared' or 'policy' and\
\timelocks must use non-negative numbers as slots."
NotRecommended ErrRecommendedValidateScript
EmptyList ->
String
"The list inside a script is empty or only contains timelocks \
\(which is not recommended)."
NotRecommended ErrRecommendedValidateScript
MZero ->
String
"At least's coefficient is 0 (which is not recommended)."
NotRecommended ErrRecommendedValidateScript
ListTooSmall ->
String
"At least's coefficient is larger than the number of non-timelock \
\elements in the list (which is not recommended)."
NotRecommended ErrRecommendedValidateScript
DuplicateSignatures ->
String
"The list inside a script has duplicate keys (which is not recommended)."
NotRecommended ErrRecommendedValidateScript
RedundantTimelocks ->
String
"Some timelocks used are redundant (which is not recommended)."
NotRecommended ErrRecommendedValidateScript
TimelockTrap ->
String
"The timelocks used are contradictory when used with 'all' (which is not recommended)."
prettyErrValidateScriptTemplate
:: ErrValidateScriptTemplate
-> String
prettyErrValidateScriptTemplate :: ErrValidateScriptTemplate -> String
prettyErrValidateScriptTemplate = \case
WrongScript ErrValidateScript
err -> ErrValidateScript -> String
prettyErrValidateScript ErrValidateScript
err
ErrValidateScriptTemplate
DuplicateXPubs ->
String
"The cosigners in a script template must stand behind an unique extended public key."
ErrValidateScriptTemplate
MissingCosignerXPub ->
String
"Each cosigner in a script template must have an extended public key."
ErrValidateScriptTemplate
NoCosignerInScript ->
String
"The script of a template must have at least one cosigner defined."
ErrValidateScriptTemplate
NoCosignerXPub ->
String
"The script template must have at least one cosigner with an extended public key."
ErrValidateScriptTemplate
UnknownCosigner ->
String
"The specified cosigner must be present in the script of the template."
instance ToJSON elem => ToJSON (Script elem) where
toJSON :: Script elem -> Value
toJSON (RequireSignatureOf elem
content) = elem -> Value
forall a. ToJSON a => a -> Value
toJSON elem
content
toJSON (RequireAllOf [Script elem]
content) =
[Pair] -> Value
object [Key
"all" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Script elem -> Value) -> [Script elem] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script elem -> Value
forall a. ToJSON a => a -> Value
toJSON [Script elem]
content]
toJSON (RequireAnyOf [Script elem]
content) =
[Pair] -> Value
object [Key
"any" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Script elem -> Value) -> [Script elem] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script elem -> Value
forall a. ToJSON a => a -> Value
toJSON [Script elem]
content]
toJSON (RequireSomeOf Word8
count [Script elem]
scripts) =
[Pair] -> Value
object [Key
"some" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"at_least" Key -> Word8 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word8
count, Key
"from" Key -> [Script elem] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Script elem]
scripts]]
toJSON (ActiveFromSlot Natural
slot) =
[Pair] -> Value
object [Key
"active_from" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
slot]
toJSON (ActiveUntilSlot Natural
slot) =
[Pair] -> Value
object [Key
"active_until" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
slot]
instance ToJSON KeyHash where
toJSON :: KeyHash -> Value
toJSON = Text -> Value
String (Text -> Value) -> (KeyHash -> Text) -> KeyHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> Text
keyHashToText
instance FromJSON (Script KeyHash) where
parseJSON :: Value -> Parser (Script KeyHash)
parseJSON Value
v =
(Value -> Parser (Script KeyHash))
-> (Value -> Parser (Script KeyHash))
-> Value
-> Parser (Script KeyHash)
forall elem.
FromJSON (Script elem) =>
(Value -> Parser (Script elem))
-> (Value -> Parser (Script elem)) -> Value -> Parser (Script elem)
fromScriptJson Value -> Parser (Script KeyHash)
parseKey Value -> Parser (Script KeyHash)
backtrack Value
v
where
parseKey :: Value -> Parser (Script KeyHash)
parseKey = String
-> (Text -> Parser (Script KeyHash))
-> Value
-> Parser (Script KeyHash)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Script KeyHash" ((Text -> Parser (Script KeyHash))
-> Value -> Parser (Script KeyHash))
-> (Text -> Parser (Script KeyHash))
-> Value
-> Parser (Script KeyHash)
forall a b. (a -> b) -> a -> b
$
(ErrKeyHashFromText -> Parser (Script KeyHash))
-> (KeyHash -> Parser (Script KeyHash))
-> Either ErrKeyHashFromText KeyHash
-> Parser (Script KeyHash)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(String -> Parser (Script KeyHash)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Script KeyHash))
-> (ErrKeyHashFromText -> String)
-> ErrKeyHashFromText
-> Parser (Script KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrKeyHashFromText -> String
prettyErrKeyHashFromText)
(Script KeyHash -> Parser (Script KeyHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Script KeyHash -> Parser (Script KeyHash))
-> (KeyHash -> Script KeyHash)
-> KeyHash
-> Parser (Script KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> Script KeyHash
forall elem. elem -> Script elem
RequireSignatureOf)
(Either ErrKeyHashFromText KeyHash -> Parser (Script KeyHash))
-> (Text -> Either ErrKeyHashFromText KeyHash)
-> Text
-> Parser (Script KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ErrKeyHashFromText KeyHash
keyHashFromText
backtrack :: Value -> Parser (Script KeyHash)
backtrack = \case
Object Object
o -> do
Maybe Value
mAny <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"any" :: Parser (Maybe Value)
Maybe Value
mAll <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"all" :: Parser (Maybe Value)
Maybe Value
mSome <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"some" :: Parser (Maybe Value)
case (Maybe Value
mAny, Maybe Value
mAll, Maybe Value
mSome) of
(Just{}, Maybe Value
Nothing, Maybe Value
Nothing) -> Value -> Parser (Script KeyHash)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAnyOf Value
v
(Maybe Value
Nothing, Just{}, Maybe Value
Nothing) -> Value -> Parser (Script KeyHash)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAllOf Value
v
(Maybe Value
Nothing, Maybe Value
Nothing, Just{}) -> Value -> Parser (Script KeyHash)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAtLeast Value
v
(Maybe Value
Nothing, Maybe Value
Nothing, Maybe Value
Nothing) -> String -> Parser (Script KeyHash)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
String
"Found object with unknown key. Expecting 'any', 'all' or 'some'"
( Maybe Value
_, Maybe Value
_, Maybe Value
_) -> String -> Parser (Script KeyHash)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
String
"Found multiple keys 'any', 'all' and/or 'some' at the same level"
String{} ->
Value -> Parser (Script KeyHash)
parseKey Value
v
Value
_ ->
String -> Value -> Parser (Script KeyHash)
forall a. String -> Value -> Parser a
Json.typeMismatch String
"Object or String" Value
v
fromScriptJson
:: FromJSON (Script elem)
=> (Value -> Parser (Script elem))
-> (Value -> Parser (Script elem))
-> Value
-> Parser (Script elem)
fromScriptJson :: (Value -> Parser (Script elem))
-> (Value -> Parser (Script elem)) -> Value -> Parser (Script elem)
fromScriptJson Value -> Parser (Script elem)
parseElem Value -> Parser (Script elem)
backtrack Value
v =
[Parser (Script elem)] -> Parser (Script elem)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ Value -> Parser (Script elem)
parseElem Value
v
, Value -> Parser (Script elem)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAnyOf Value
v
, Value -> Parser (Script elem)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAllOf Value
v
, Value -> Parser (Script elem)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAtLeast Value
v
, Value -> Parser (Script elem)
forall elem. Value -> Parser (Script elem)
parseActiveFrom Value
v
, Value -> Parser (Script elem)
forall elem. Value -> Parser (Script elem)
parseActiveUntil Value
v
] Parser (Script elem)
-> Parser (Script elem) -> Parser (Script elem)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (Script elem)
backtrack Value
v
parseAnyOf
:: FromJSON (Script elem)
=> Value
-> Parser (Script elem)
parseAnyOf :: Value -> Parser (Script elem)
parseAnyOf = String
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Script AnyOf" ((Object -> Parser (Script elem)) -> Value -> Parser (Script elem))
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
[Script elem] -> Script elem
forall elem. [Script elem] -> Script elem
RequireAnyOf ([Script elem] -> Script elem)
-> Parser [Script elem] -> Parser (Script elem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Script elem]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"any"
parseAllOf
:: FromJSON (Script elem)
=> Value
-> Parser (Script elem)
parseAllOf :: Value -> Parser (Script elem)
parseAllOf = String
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Script AllOf" ((Object -> Parser (Script elem)) -> Value -> Parser (Script elem))
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
[Script elem] -> Script elem
forall elem. [Script elem] -> Script elem
RequireAllOf ([Script elem] -> Script elem)
-> Parser [Script elem] -> Parser (Script elem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Script elem]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"all"
parseAtLeast
:: FromJSON (Script elem)
=> Value
-> Parser (Script elem)
parseAtLeast :: Value -> Parser (Script elem)
parseAtLeast = String
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Script SomeOf" ((Object -> Parser (Script elem)) -> Value -> Parser (Script elem))
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Object
some <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"some"
Word8 -> [Script elem] -> Script elem
forall elem. Word8 -> [Script elem] -> Script elem
RequireSomeOf (Word8 -> [Script elem] -> Script elem)
-> Parser Word8 -> Parser ([Script elem] -> Script elem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
some Object -> Key -> Parser Word8
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"at_least" Parser ([Script elem] -> Script elem)
-> Parser [Script elem] -> Parser (Script elem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
some Object -> Key -> Parser [Script elem]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from"
parseActiveFrom
:: Value
-> Parser (Script elem)
parseActiveFrom :: Value -> Parser (Script elem)
parseActiveFrom = String
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Script ActiveFrom" ((Object -> Parser (Script elem)) -> Value -> Parser (Script elem))
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Natural -> Script elem
forall elem. Natural -> Script elem
ActiveFromSlot (Natural -> Script elem) -> Parser Natural -> Parser (Script elem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_from"
parseActiveUntil
:: Value
-> Parser (Script elem)
parseActiveUntil :: Value -> Parser (Script elem)
parseActiveUntil = String
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Script ActiveUntil" ((Object -> Parser (Script elem)) -> Value -> Parser (Script elem))
-> (Object -> Parser (Script elem))
-> Value
-> Parser (Script elem)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Natural -> Script elem
forall elem. Natural -> Script elem
ActiveUntilSlot (Natural -> Script elem) -> Parser Natural -> Parser (Script elem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_until"
cosignerToText :: Cosigner -> Text
cosignerToText :: Cosigner -> Text
cosignerToText (Cosigner Word8
ix) = Text
"cosigner#"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word8 -> String
forall a. Show a => a -> String
show Word8
ix)
instance ToJSON Cosigner where
toJSON :: Cosigner -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Cosigner -> Text) -> Cosigner -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosigner -> Text
cosignerToText
instance FromJSON Cosigner where
parseJSON :: Value -> Parser Cosigner
parseJSON = String -> (Text -> Parser Cosigner) -> Value -> Parser Cosigner
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Cosigner" ((Text -> Parser Cosigner) -> Value -> Parser Cosigner)
-> (Text -> Parser Cosigner) -> Value -> Parser Cosigner
forall a b. (a -> b) -> a -> b
$ \Text
txt -> case Text -> Text -> [Text]
T.splitOn Text
"cosigner#" Text
txt of
[Text
"",Text
numTxt] -> case Reader Word8
forall a. Integral a => Reader a
T.decimal Text
numTxt of
Right (Word8
num,Text
"") -> do
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
num Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Bounded Word8 => Word8
forall a. Bounded a => a
minBound @Word8 Bool -> Bool -> Bool
|| Word8
num Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Bounded Word8 => Word8
forall a. Bounded a => a
maxBound @Word8) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cosigner number should be between '0' and '255'"
Cosigner -> Parser Cosigner
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cosigner -> Parser Cosigner) -> Cosigner -> Parser Cosigner
forall a b. (a -> b) -> a -> b
$ Word8 -> Cosigner
Cosigner Word8
num
Either String (Word8, Text)
_ -> String -> Parser Cosigner
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cosigner should be enumerated with number"
[Text]
_ -> String -> Parser Cosigner
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cosigner should be of the form: cosigner#num"
encodeXPub :: XPub -> Value
encodeXPub :: XPub -> Value
encodeXPub = Text -> Value
String (Text -> Value) -> (XPub -> Text) -> XPub -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (XPub -> ByteString) -> XPub -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase16 (ByteString -> ByteString)
-> (XPub -> ByteString) -> XPub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubToBytes
parseXPub :: Value -> Parser XPub
parseXPub :: Value -> Parser XPub
parseXPub = String -> (Text -> Parser XPub) -> Value -> Parser XPub
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"XPub" ((Text -> Parser XPub) -> Value -> Parser XPub)
-> (Text -> Parser XPub) -> Value -> Parser XPub
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
case ByteString -> Either String ByteString
fromBase16 (Text -> ByteString
T.encodeUtf8 Text
txt) of
Left String
err -> String -> Parser XPub
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
Right ByteString
hex -> case ByteString -> Maybe XPub
xpubFromBytes ByteString
hex of
Maybe XPub
Nothing -> String -> Parser XPub
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Extended public key cannot be retrieved from a given hex bytestring"
Just XPub
validXPub -> XPub -> Parser XPub
forall (f :: * -> *) a. Applicative f => a -> f a
pure XPub
validXPub
instance ToJSON ScriptTemplate where
toJSON :: ScriptTemplate -> Value
toJSON (ScriptTemplate Map Cosigner XPub
cosigners' Script Cosigner
template') =
[Pair] -> Value
object [ Key
"cosigners" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (((Cosigner, XPub) -> Pair) -> [(Cosigner, XPub)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Key) -> (Text, Value) -> Pair
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Key
J.textToKey ((Text, Value) -> Pair)
-> ((Cosigner, XPub) -> (Text, Value)) -> (Cosigner, XPub) -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosigner, XPub) -> (Text, Value)
toPair) (Map Cosigner XPub -> [(Cosigner, XPub)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Cosigner XPub
cosigners'))
, Key
"template" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Script Cosigner -> Value
forall a. ToJSON a => a -> Value
toJSON Script Cosigner
template']
where
toPair :: (Cosigner, XPub) -> (Text, Value)
toPair (Cosigner
cosigner', XPub
xpub) =
( Cosigner -> Text
cosignerToText Cosigner
cosigner'
, XPub -> Value
encodeXPub XPub
xpub )
instance FromJSON (Script Cosigner) where
parseJSON :: Value -> Parser (Script Cosigner)
parseJSON Value
v = (Value -> Parser (Script Cosigner))
-> (Value -> Parser (Script Cosigner))
-> Value
-> Parser (Script Cosigner)
forall elem.
FromJSON (Script elem) =>
(Value -> Parser (Script elem))
-> (Value -> Parser (Script elem)) -> Value -> Parser (Script elem)
fromScriptJson Value -> Parser (Script Cosigner)
parserCosigner Value -> Parser (Script Cosigner)
backtrack Value
v
where
parserCosigner :: Value -> Parser (Script Cosigner)
parserCosigner Value
o = do
Cosigner
cosigner <- Value -> Parser Cosigner
forall a. FromJSON a => Value -> Parser a
parseJSON @Cosigner Value
o
Script Cosigner -> Parser (Script Cosigner)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Script Cosigner -> Parser (Script Cosigner))
-> Script Cosigner -> Parser (Script Cosigner)
forall a b. (a -> b) -> a -> b
$ Cosigner -> Script Cosigner
forall elem. elem -> Script elem
RequireSignatureOf Cosigner
cosigner
backtrack :: Value -> Parser (Script Cosigner)
backtrack = \case
Object Object
o -> do
Maybe Value
mAny <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"any" :: Parser (Maybe Value)
Maybe Value
mAll <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"all" :: Parser (Maybe Value)
Maybe Value
mSome <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"some" :: Parser (Maybe Value)
Maybe Value
mCos <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cosigner" :: Parser (Maybe Value)
case (Maybe Value
mAny, Maybe Value
mAll, Maybe Value
mSome, Maybe Value
mCos) of
(Just{}, Maybe Value
Nothing, Maybe Value
Nothing, Maybe Value
Nothing) -> Value -> Parser (Script Cosigner)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAnyOf Value
v
(Maybe Value
Nothing, Just{}, Maybe Value
Nothing, Maybe Value
Nothing) -> Value -> Parser (Script Cosigner)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAllOf Value
v
(Maybe Value
Nothing, Maybe Value
Nothing, Just{}, Maybe Value
Nothing) -> Value -> Parser (Script Cosigner)
forall elem.
FromJSON (Script elem) =>
Value -> Parser (Script elem)
parseAtLeast Value
v
(Maybe Value
Nothing, Maybe Value
Nothing, Maybe Value
Nothing, Just{}) -> Value -> Parser (Script Cosigner)
parserCosigner Value
v
(Maybe Value
Nothing, Maybe Value
Nothing, Maybe Value
Nothing, Maybe Value
Nothing) -> String -> Parser (Script Cosigner)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
String
"Found object with unknown key. Expecting 'any', 'all', 'some' or 'cosigner'"
( Maybe Value
_, Maybe Value
_, Maybe Value
_, Maybe Value
_) -> String -> Parser (Script Cosigner)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
String
"Found multiple keys 'any', 'all', 'cosigner' and/or 'some' at the same level"
Value
_ ->
String -> Value -> Parser (Script Cosigner)
forall a. String -> Value -> Parser a
Json.typeMismatch String
"Object only" Value
v
instance FromJSON ScriptTemplate where
parseJSON :: Value -> Parser ScriptTemplate
parseJSON = String
-> (Object -> Parser ScriptTemplate)
-> Value
-> Parser ScriptTemplate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ScriptTemplate" ((Object -> Parser ScriptTemplate)
-> Value -> Parser ScriptTemplate)
-> (Object -> Parser ScriptTemplate)
-> Value
-> Parser ScriptTemplate
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Parser (Script Cosigner)
template' <- Value -> Parser (Script Cosigner)
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (Script Cosigner))
-> Parser Value -> Parser (Parser (Script Cosigner))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"template"
Parser [(Cosigner, XPub)]
cosigners' <- Value -> Parser [(Cosigner, XPub)]
parseCosignerPairs (Value -> Parser [(Cosigner, XPub)])
-> Parser Value -> Parser (Parser [(Cosigner, XPub)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cosigners"
Map Cosigner XPub -> Script Cosigner -> ScriptTemplate
ScriptTemplate (Map Cosigner XPub -> Script Cosigner -> ScriptTemplate)
-> Parser (Map Cosigner XPub)
-> Parser (Script Cosigner -> ScriptTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Cosigner, XPub)] -> Map Cosigner XPub
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Cosigner, XPub)] -> Map Cosigner XPub)
-> Parser [(Cosigner, XPub)] -> Parser (Map Cosigner XPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Cosigner, XPub)]
cosigners') Parser (Script Cosigner -> ScriptTemplate)
-> Parser (Script Cosigner) -> Parser ScriptTemplate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Script Cosigner)
template'
where
parseCosignerPairs :: Value -> Parser [(Cosigner, XPub)]
parseCosignerPairs = String
-> (Object -> Parser [(Cosigner, XPub)])
-> Value
-> Parser [(Cosigner, XPub)]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Cosigner pairs" ((Object -> Parser [(Cosigner, XPub)])
-> Value -> Parser [(Cosigner, XPub)])
-> (Object -> Parser [(Cosigner, XPub)])
-> Value
-> Parser [(Cosigner, XPub)]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
JM.toList Object
o of
[] -> String -> Parser [(Cosigner, XPub)]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cosigners object array should not be empty"
[Pair]
cs -> [Pair]
-> (Pair -> Parser (Cosigner, XPub)) -> Parser [(Cosigner, XPub)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([Pair] -> [Pair]
forall a. [a] -> [a]
reverse [Pair]
cs) ((Pair -> Parser (Cosigner, XPub)) -> Parser [(Cosigner, XPub)])
-> (Pair -> Parser (Cosigner, XPub)) -> Parser [(Cosigner, XPub)]
forall a b. (a -> b) -> a -> b
$ \(Key
numTxt, Value
str) -> do
Cosigner
cosigner' <- Value -> Parser Cosigner
forall a. FromJSON a => Value -> Parser a
parseJSON @Cosigner (Text -> Value
String (Key -> Text
J.keyToText Key
numTxt))
XPub
xpub <- Value -> Parser XPub
parseXPub Value
str
(Cosigner, XPub) -> Parser (Cosigner, XPub)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cosigner
cosigner', XPub
xpub)