module Mantra.Chain.Internal (
interpretAsScript
, toScript
, toSimpleScriptV2
) where
import Control.Monad (guard)
import Data.List (isPrefixOf)
import Data.List.Extra (replace)
import Data.Word (Word64)
import qualified Data.ByteString.Char8 as BS (pack)
import qualified Cardano.Api as API
import qualified Cardano.Ledger.Crypto as Ledger (StandardCrypto)
import qualified Cardano.Ledger.ShelleyMA.Timelocks as ShelleyMA (Timelock)
interpretAsScript :: ShelleyMA.Timelock Ledger.StandardCrypto
-> Maybe (API.SimpleScript API.SimpleScriptV2, API.ScriptHash)
interpretAsScript :: Timelock StandardCrypto
-> Maybe (SimpleScript SimpleScriptV2, ScriptHash)
interpretAsScript Timelock StandardCrypto
witness =
do
let
text :: String
text = Timelock StandardCrypto -> String
forall a. Show a => a -> String
show Timelock StandardCrypto
witness
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
(String
"TimelockConstr " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
text)
SimpleScript SimpleScriptV2
-> (SimpleScript SimpleScriptV2, ScriptHash)
toScript
(SimpleScript SimpleScriptV2
-> (SimpleScript SimpleScriptV2, ScriptHash))
-> Maybe (SimpleScript SimpleScriptV2)
-> Maybe (SimpleScript SimpleScriptV2, ScriptHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (SimpleScript SimpleScriptV2)
toSimpleScriptV2 String
text
toScript :: API.SimpleScript API.SimpleScriptV2
-> (API.SimpleScript API.SimpleScriptV2, API.ScriptHash)
toScript :: SimpleScript SimpleScriptV2
-> (SimpleScript SimpleScriptV2, ScriptHash)
toScript SimpleScript SimpleScriptV2
script =
let
script' :: Script SimpleScriptV2
script' = SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
API.SimpleScript SimpleScriptVersion SimpleScriptV2
API.SimpleScriptV2 SimpleScript SimpleScriptV2
script
in
(
SimpleScript SimpleScriptV2
script
, Script SimpleScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
API.hashScript Script SimpleScriptV2
script'
)
toSimpleScriptV2 :: String
-> Maybe (API.SimpleScript API.SimpleScriptV2)
toSimpleScriptV2 :: String -> Maybe (SimpleScript SimpleScriptV2)
toSimpleScriptV2 =
Timelock -> Maybe (SimpleScript SimpleScriptV2)
rewriteScript
(Timelock -> Maybe (SimpleScript SimpleScriptV2))
-> (String -> Timelock)
-> String
-> Maybe (SimpleScript SimpleScriptV2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Timelock
forall a. Read a => String -> a
read
(String -> Timelock) -> (String -> String) -> String -> Timelock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace String
"TimelockConstr " String
""
(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace String
"fromList " String
""
rewriteScript :: Timelock -> Maybe (API.SimpleScript API.SimpleScriptV2)
rewriteScript :: Timelock -> Maybe (SimpleScript SimpleScriptV2)
rewriteScript (Signature (KeyHash String
h)) = Hash PaymentKey -> SimpleScript SimpleScriptV2
forall lang. Hash PaymentKey -> SimpleScript lang
API.RequireSignature (Hash PaymentKey -> SimpleScript SimpleScriptV2)
-> Maybe (Hash PaymentKey) -> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (Hash PaymentKey)
readSignature String
h
rewriteScript (AllOf StrictSeq Timelock
Empty ) = SimpleScript SimpleScriptV2 -> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2))
-> SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2)
forall a b. (a -> b) -> a -> b
$ [SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2
forall lang. [SimpleScript lang] -> SimpleScript lang
API.RequireAllOf []
rewriteScript (AllOf (StrictSeq [Timelock]
ss) ) = [SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2
forall lang. [SimpleScript lang] -> SimpleScript lang
API.RequireAllOf ([SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2)
-> Maybe [SimpleScript SimpleScriptV2]
-> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Timelock -> Maybe (SimpleScript SimpleScriptV2))
-> [Timelock] -> Maybe [SimpleScript SimpleScriptV2]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Timelock -> Maybe (SimpleScript SimpleScriptV2)
rewriteScript [Timelock]
ss
rewriteScript (AnyOf StrictSeq Timelock
Empty ) = SimpleScript SimpleScriptV2 -> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2))
-> SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2)
forall a b. (a -> b) -> a -> b
$ [SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2
forall lang. [SimpleScript lang] -> SimpleScript lang
API.RequireAnyOf []
rewriteScript (AnyOf (StrictSeq [Timelock]
ss) ) = [SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2
forall lang. [SimpleScript lang] -> SimpleScript lang
API.RequireAnyOf ([SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2)
-> Maybe [SimpleScript SimpleScriptV2]
-> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Timelock -> Maybe (SimpleScript SimpleScriptV2))
-> [Timelock] -> Maybe [SimpleScript SimpleScriptV2]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Timelock -> Maybe (SimpleScript SimpleScriptV2)
rewriteScript [Timelock]
ss
rewriteScript (MOfN Int
i StrictSeq Timelock
Empty ) = SimpleScript SimpleScriptV2 -> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2))
-> SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2)
forall a b. (a -> b) -> a -> b
$ Int -> [SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2
forall lang. Int -> [SimpleScript lang] -> SimpleScript lang
API.RequireMOf Int
i []
rewriteScript (MOfN Int
i (StrictSeq [Timelock]
ss)) = Int -> [SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2
forall lang. Int -> [SimpleScript lang] -> SimpleScript lang
API.RequireMOf Int
i ([SimpleScript SimpleScriptV2] -> SimpleScript SimpleScriptV2)
-> Maybe [SimpleScript SimpleScriptV2]
-> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Timelock -> Maybe (SimpleScript SimpleScriptV2))
-> [Timelock] -> Maybe [SimpleScript SimpleScriptV2]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Timelock -> Maybe (SimpleScript SimpleScriptV2)
rewriteScript [Timelock]
ss
rewriteScript (TimeStart (SlotNo Word64
t) ) = SimpleScript SimpleScriptV2 -> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2))
-> (SlotNo -> SimpleScript SimpleScriptV2)
-> SlotNo
-> Maybe (SimpleScript SimpleScriptV2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocksSupported SimpleScriptV2
-> SlotNo -> SimpleScript SimpleScriptV2
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
API.RequireTimeAfter TimeLocksSupported SimpleScriptV2
API.TimeLocksInSimpleScriptV2 (SlotNo -> Maybe (SimpleScript SimpleScriptV2))
-> SlotNo -> Maybe (SimpleScript SimpleScriptV2)
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
API.SlotNo Word64
t
rewriteScript (TimeExpire (SlotNo Word64
t)) = SimpleScript SimpleScriptV2 -> Maybe (SimpleScript SimpleScriptV2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV2))
-> (SlotNo -> SimpleScript SimpleScriptV2)
-> SlotNo
-> Maybe (SimpleScript SimpleScriptV2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocksSupported SimpleScriptV2
-> SlotNo -> SimpleScript SimpleScriptV2
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
API.RequireTimeBefore TimeLocksSupported SimpleScriptV2
API.TimeLocksInSimpleScriptV2 (SlotNo -> Maybe (SimpleScript SimpleScriptV2))
-> SlotNo -> Maybe (SimpleScript SimpleScriptV2)
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
API.SlotNo Word64
t
readSignature :: String -> Maybe (API.Hash API.PaymentKey)
readSignature :: String -> Maybe (Hash PaymentKey)
readSignature = AsType (Hash PaymentKey) -> ByteString -> Maybe (Hash PaymentKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
API.deserialiseFromRawBytesHex (AsType PaymentKey -> AsType (Hash PaymentKey)
forall a. AsType a -> AsType (Hash a)
API.AsHash AsType PaymentKey
API.AsPaymentKey) (ByteString -> Maybe (Hash PaymentKey))
-> (String -> ByteString) -> String -> Maybe (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack
data Timelock =
Signature KeyHash
| AllOf (StrictSeq Timelock)
| AnyOf (StrictSeq Timelock)
| MOfN Int (StrictSeq Timelock)
| TimeStart SlotNo
| TimeExpire SlotNo
deriving (ReadPrec [Timelock]
ReadPrec Timelock
Int -> ReadS Timelock
ReadS [Timelock]
(Int -> ReadS Timelock)
-> ReadS [Timelock]
-> ReadPrec Timelock
-> ReadPrec [Timelock]
-> Read Timelock
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Timelock]
$creadListPrec :: ReadPrec [Timelock]
readPrec :: ReadPrec Timelock
$creadPrec :: ReadPrec Timelock
readList :: ReadS [Timelock]
$creadList :: ReadS [Timelock]
readsPrec :: Int -> ReadS Timelock
$creadsPrec :: Int -> ReadS Timelock
Read, Int -> Timelock -> String -> String
[Timelock] -> String -> String
Timelock -> String
(Int -> Timelock -> String -> String)
-> (Timelock -> String)
-> ([Timelock] -> String -> String)
-> Show Timelock
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Timelock] -> String -> String
$cshowList :: [Timelock] -> String -> String
show :: Timelock -> String
$cshow :: Timelock -> String
showsPrec :: Int -> Timelock -> String -> String
$cshowsPrec :: Int -> Timelock -> String -> String
Show)
newtype KeyHash = KeyHash String
deriving (ReadPrec [KeyHash]
ReadPrec KeyHash
Int -> ReadS KeyHash
ReadS [KeyHash]
(Int -> ReadS KeyHash)
-> ReadS [KeyHash]
-> ReadPrec KeyHash
-> ReadPrec [KeyHash]
-> Read KeyHash
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeyHash]
$creadListPrec :: ReadPrec [KeyHash]
readPrec :: ReadPrec KeyHash
$creadPrec :: ReadPrec KeyHash
readList :: ReadS [KeyHash]
$creadList :: ReadS [KeyHash]
readsPrec :: Int -> ReadS KeyHash
$creadsPrec :: Int -> ReadS KeyHash
Read, Int -> KeyHash -> String -> String
[KeyHash] -> String -> String
KeyHash -> String
(Int -> KeyHash -> String -> String)
-> (KeyHash -> String)
-> ([KeyHash] -> String -> String)
-> Show KeyHash
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [KeyHash] -> String -> String
$cshowList :: [KeyHash] -> String -> String
show :: KeyHash -> String
$cshow :: KeyHash -> String
showsPrec :: Int -> KeyHash -> String -> String
$cshowsPrec :: Int -> KeyHash -> String -> String
Show)
newtype SlotNo = SlotNo Word64
deriving (ReadPrec [SlotNo]
ReadPrec SlotNo
Int -> ReadS SlotNo
ReadS [SlotNo]
(Int -> ReadS SlotNo)
-> ReadS [SlotNo]
-> ReadPrec SlotNo
-> ReadPrec [SlotNo]
-> Read SlotNo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SlotNo]
$creadListPrec :: ReadPrec [SlotNo]
readPrec :: ReadPrec SlotNo
$creadPrec :: ReadPrec SlotNo
readList :: ReadS [SlotNo]
$creadList :: ReadS [SlotNo]
readsPrec :: Int -> ReadS SlotNo
$creadsPrec :: Int -> ReadS SlotNo
Read, Int -> SlotNo -> String -> String
[SlotNo] -> String -> String
SlotNo -> String
(Int -> SlotNo -> String -> String)
-> (SlotNo -> String)
-> ([SlotNo] -> String -> String)
-> Show SlotNo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SlotNo] -> String -> String
$cshowList :: [SlotNo] -> String -> String
show :: SlotNo -> String
$cshow :: SlotNo -> String
showsPrec :: Int -> SlotNo -> String -> String
$cshowsPrec :: Int -> SlotNo -> String -> String
Show)
data StrictSeq a =
Empty
| StrictSeq {StrictSeq a -> [a]
fromStrict :: [a]}
deriving (ReadPrec [StrictSeq a]
ReadPrec (StrictSeq a)
Int -> ReadS (StrictSeq a)
ReadS [StrictSeq a]
(Int -> ReadS (StrictSeq a))
-> ReadS [StrictSeq a]
-> ReadPrec (StrictSeq a)
-> ReadPrec [StrictSeq a]
-> Read (StrictSeq a)
forall a. Read a => ReadPrec [StrictSeq a]
forall a. Read a => ReadPrec (StrictSeq a)
forall a. Read a => Int -> ReadS (StrictSeq a)
forall a. Read a => ReadS [StrictSeq a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StrictSeq a]
$creadListPrec :: forall a. Read a => ReadPrec [StrictSeq a]
readPrec :: ReadPrec (StrictSeq a)
$creadPrec :: forall a. Read a => ReadPrec (StrictSeq a)
readList :: ReadS [StrictSeq a]
$creadList :: forall a. Read a => ReadS [StrictSeq a]
readsPrec :: Int -> ReadS (StrictSeq a)
$creadsPrec :: forall a. Read a => Int -> ReadS (StrictSeq a)
Read, Int -> StrictSeq a -> String -> String
[StrictSeq a] -> String -> String
StrictSeq a -> String
(Int -> StrictSeq a -> String -> String)
-> (StrictSeq a -> String)
-> ([StrictSeq a] -> String -> String)
-> Show (StrictSeq a)
forall a. Show a => Int -> StrictSeq a -> String -> String
forall a. Show a => [StrictSeq a] -> String -> String
forall a. Show a => StrictSeq a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [StrictSeq a] -> String -> String
$cshowList :: forall a. Show a => [StrictSeq a] -> String -> String
show :: StrictSeq a -> String
$cshow :: forall a. Show a => StrictSeq a -> String
showsPrec :: Int -> StrictSeq a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> StrictSeq a -> String -> String
Show)