Add functions for working with booleans, and more synonyms to built in functions

Plutarch/Bool.hs

@@ -1,4 +1,17 @@
-module Plutarch.Bool (PBool (..), PEq (..), POrd (..), pif, pif') where
+module Plutarch.Bool (
+  PBool (..),
+  PEq (..),
+  POrd (..),
+  pif,
+  pif',
+  pnot,
+  (#&&),
+  (#||),
+  por,
+  pand,
+  pand',
+  por',
+) where
 
 import Plutarch (PlutusType (PInner, pcon', pmatch'), punsafeBuiltin, punsafeConstant)
 import Plutarch.Prelude
@@ -35,3 +48,43 @@ pif :: Term s PBool -> Term s a -> Term s a -> Term s a
 pif b case_true case_false = pmatch b $ \case
   PTrue -> case_true
   PFalse -> case_false
+
+-- | Boolean negation for 'PBool' terms.
+pnot :: Term s (PBool :--> PBool)
+pnot = phoistAcyclic $ plam $ \x -> pif x (pcon PFalse) $ pcon PTrue
+
+-- | Lazily evaluated boolean and for 'PBool' terms.
+infixr 3 #&&
+
+(#&&) :: Term s PBool -> Term s PBool -> Term s PBool
+x #&& y = pand # pdelay x # pdelay y
+
+-- | Lazily evaluated boolean or for 'PBool' terms.
+infixr 2 #||
+
+(#||) :: Term s PBool -> Term s PBool -> Term s PBool
+x #|| y = por # pdelay x # pdelay y
+
+-- | Hoisted, Plutarch level, lazily evaluated boolean and function.
+pand :: Term s (PDelayed PBool :--> PDelayed PBool :--> PBool)
+pand = phoistAcyclic $
+  plam $
+    \x y -> pif' # pforce x # (pif' # pforce y # pcon PTrue # pcon PFalse) # pcon PFalse
+
+-- | Hoisted, Plutarch level, strictly evaluated boolean and function.
+pand' :: Term s (PBool :--> PBool :--> PBool)
+pand' = phoistAcyclic $
+  plam $
+    \x y -> pif' # x # (pif' # y # pcon PTrue # pcon PFalse) # pcon PFalse
+
+-- | Hoisted, Plutarch level, lazily evaluated boolean or function.
+por :: Term s (PDelayed PBool :--> PDelayed PBool :--> PBool)
+por = phoistAcyclic $
+  plam $
+    \x y -> pif' # pforce x # pcon PTrue #$ pif' # pforce y # pcon PTrue # pcon PFalse
+
+-- | Hoisted, Plutarch level, strictly evaluated boolean or function.
+por' :: Term s (PBool :--> PBool :--> PBool)
+por' = phoistAcyclic $
+  plam $
+    \x y -> pif' # x # pcon PTrue #$ pif' # y # pcon PTrue # pcon PFalse

Plutarch/ByteString.hs

@@ -1,4 +1,12 @@
-module Plutarch.ByteString (PByteString, phexByteStr, pbyteStr) where
+module Plutarch.ByteString (
+  PByteString,
+  phexByteStr,
+  pbyteStr,
+  pconsBS,
+  psliceBS,
+  plengthBS,
+  pindexBS,
+) where
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -7,6 +15,7 @@ import Data.Word (Word8)
 import GHC.Stack (HasCallStack)
 import Plutarch (punsafeBuiltin, punsafeConstant)
 import Plutarch.Bool (PEq, POrd, (#<), (#<=), (#==))
+import Plutarch.Integer (PInteger)
 import Plutarch.Prelude
 import qualified PlutusCore as PLC
 
@@ -37,6 +46,29 @@ phexByteStr = punsafeConstant . PLC.Some . PLC.ValueOf PLC.DefaultUniByteString
 pbyteStr :: ByteString -> Term s PByteString
 pbyteStr = punsafeConstant . PLC.Some . PLC.ValueOf PLC.DefaultUniByteString
 
+-----------------------------------------------------------
+-- The following functions should be import qualified. --
+-----------------------------------------------------------
+
+-- | Prepend a byte, represented by a non negative 'PInteger', to a 'PBytestring'.
+pconsBS :: Term s (PInteger :--> PByteString :--> PByteString)
+pconsBS = punsafeBuiltin PLC.ConsByteString
+
+{- | Slice a 'PByteString' with given start and end indices.
+
+>>> (pslice # 1 # 3 phexByteStr "4102afde5b2a") #== phexByteStr "02afde"
+-}
+psliceBS :: Term s (PInteger :--> PInteger :--> PByteString :--> PByteString)
+psliceBS = punsafeBuiltin PLC.SliceByteString
+
+-- | Find the length of a 'PByteString'.
+plengthBS :: Term s (PByteString :--> PInteger)
+plengthBS = punsafeBuiltin PLC.LengthOfByteString
+
+-- | 'PByteString' indexing function.
+pindexBS :: Term s (PByteString :--> PInteger :--> PInteger)
+pindexBS = punsafeBuiltin PLC.IndexByteString
+
 hexDigitToWord8 :: HasCallStack => Char -> Word8
 hexDigitToWord8 = f . toLower
   where

Plutarch/Crypto.hs

@@ -0,0 +1,35 @@
+module Plutarch.Crypto (
+  PPubKey,
+  PMessage,
+  PSignature,
+  psha2_256,
+  psha3_256,
+  pblake2b_256,
+  pverifySignature,
+) where
+
+import Plutarch (punsafeBuiltin)
+import Plutarch.Bool (PBool)
+import Plutarch.ByteString (PByteString)
+import Plutarch.Prelude
+import qualified PlutusCore as PLC
+
+type PPubKey = PByteString
+type PMessage = PByteString
+type PSignature = PByteString
+
+-- | Hash a 'PByteString' using SHA-256.
+psha2_256 :: Term s (PByteString :--> PByteString)
+psha2_256 = punsafeBuiltin PLC.Sha2_256
+
+-- | Hash a 'PByteString' using SHA3-256.
+psha3_256 :: Term s (PByteString :--> PByteString)
+psha3_256 = punsafeBuiltin PLC.Sha3_256
+
+-- | Hash a 'PByteString' using Blake2B-256.
+pblake2b_256 :: Term s (PByteString :--> PByteString)
+pblake2b_256 = punsafeBuiltin PLC.Blake2b_256
+
+-- | Verify the signature against the public key and message.
+pverifySignature :: Term s (PPubKey :--> PMessage :--> PSignature :--> PBool)
+pverifySignature = punsafeBuiltin PLC.VerifySignature

Plutarch/Integer.hs

@@ -1,4 +1,4 @@
-module Plutarch.Integer (PInteger) where
+module Plutarch.Integer (PInteger, PIntegral (..)) where
 
 import Plutarch (punsafeBuiltin, punsafeConstant)
 import Plutarch.Bool (PEq, POrd, pif, (#<), (#<=), (#==))
@@ -7,6 +7,18 @@ import qualified PlutusCore as PLC
 
 data PInteger s
 
+class PIntegral a where
+  pdiv :: Term s (a :--> a :--> a)
+  pmod :: Term s (a :--> a :--> a)
+  pquot :: Term s (a :--> a :--> a)
+  prem :: Term s (a :--> a :--> a)
+
+instance PIntegral PInteger where
+  pdiv = punsafeBuiltin PLC.DivideInteger
+  pmod = punsafeBuiltin PLC.ModInteger
+  pquot = punsafeBuiltin PLC.QuotientInteger
+  prem = punsafeBuiltin PLC.RemainderInteger
+
 instance PEq PInteger where
   x #== y = punsafeBuiltin PLC.EqualsInteger # x # y
 

Plutarch/String.hs

@@ -1,9 +1,10 @@
-module Plutarch.String (PString, pfromText) where
+module Plutarch.String (PString, pfromText, pencodeUtf8, pdecodeUtf8) where
 
 import Data.String (IsString, fromString)
 import qualified Data.Text as Txt
 import Plutarch (punsafeBuiltin, punsafeConstant)
-import Plutarch.Bool (PEq (..))
+import Plutarch.Bool (PEq, (#==))
+import Plutarch.ByteString (PByteString)
 import Plutarch.Prelude
 import qualified PlutusCore as PLC
 
@@ -23,3 +24,11 @@ instance Semigroup (Term s PString) where
 
 instance Monoid (Term s PString) where
   mempty = punsafeConstant . PLC.Some $ PLC.ValueOf PLC.DefaultUniString Txt.empty
+
+-- | Encode a 'PString' using UTF-8.
+pencodeUtf8 :: Term s (PString :--> PByteString)
+pencodeUtf8 = punsafeBuiltin PLC.EncodeUtf8
+
+-- | Decode a 'PByteString' using UTF-8.
+pdecodeUtf8 :: Term s (PByteString :--> PString)
+pdecodeUtf8 = punsafeBuiltin PLC.DecodeUtf8

Plutarch/Unit.hs

@@ -1,6 +1,7 @@
 module Plutarch.Unit (PUnit (..)) where
 
-import Plutarch (POpaque, PlutusType (PInner, pcon', pmatch'), punsafeConstant)
+import Plutarch (POpaque, PlutusType (PInner, pcon', pmatch'), Term, pcon, punsafeConstant)
+import Plutarch.Bool (PBool (PFalse, PTrue), PEq, POrd, (#<), (#<=), (#==))
 import qualified PlutusCore as PLC
 
 data PUnit s = PUnit
@@ -9,3 +10,16 @@ instance PlutusType PUnit where
   type PInner PUnit _ = POpaque
   pcon' PUnit = punsafeConstant . PLC.Some $ PLC.ValueOf PLC.DefaultUniUnit ()
   pmatch' _ f = f PUnit
+
+instance PEq PUnit where
+  _ #== _ = pcon PTrue
+
+instance POrd PUnit where
+  _ #<= _ = pcon PTrue
+  _ #< _ = pcon PFalse
+
+instance Semigroup (Term s PUnit) where
+  _ <> _ = pcon PUnit
+
+instance Monoid (Term s PUnit) where
+  mempty = pcon PUnit

examples/Main.hs

@@ -6,11 +6,12 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 import qualified Data.Aeson as Aeson
+import qualified Data.ByteString as BS
 import Data.Maybe (fromJust)
 import Plutarch (ClosedTerm, POpaque, compile, popaque, printScript, printTerm, punsafeBuiltin, punsafeCoerce, punsafeConstant)
-import Plutarch.Bool (PBool (PTrue), pif, (#==))
+import Plutarch.Bool (PBool (PFalse, PTrue), pif, pnot, (#&&), (#<), (#<=), (#==), (#||))
 import Plutarch.Builtin (PBuiltinList, PBuiltinPair, PData, pdataLiteral)
-import Plutarch.ByteString (phexByteStr)
+import Plutarch.ByteString (pbyteStr, pconsBS, phexByteStr, pindexBS, plengthBS, psliceBS)
 import Plutarch.Either (PEither (PLeft, PRight))
 import Plutarch.Evaluate (evaluateScript)
 import Plutarch.Integer (PInteger)
@@ -111,7 +112,17 @@ plutarchTests =
     , testCase "uglyDouble" $ (printTerm uglyDouble) @?= "(program 1.0.0 (\\i0 -> addInteger i1 i1))"
     , testCase "1 + 2 == 3" $ equal (1 + 2 :: Term s PInteger) (3 :: Term s PInteger)
     , testCase "fails: perror" $ fails perror
-    , testCase "() == ()" $ expect $ pmatch (pcon PUnit) (\case PUnit -> pcon PTrue)
+    , testCase "pnot" $ do
+        (pnot #$ pcon PTrue) `equal` pcon PFalse
+        (pnot #$ pcon PFalse) `equal` pcon PTrue
+    , testCase "() == ()" $ do
+        expect $ pmatch (pcon PUnit) (\case PUnit -> pcon PTrue)
+        expect $ pcon PUnit #== pcon PUnit
+        pcon PUnit `equal` pcon PUnit
+    , testCase "() < () == False" $ do
+        expect $ pnot #$ pcon PUnit #< pcon PUnit
+    , testCase "() <= () == True" $ do
+        expect $ pcon PUnit #<= pcon PUnit
     , testCase "0x02af == 0x02af" $ expect $ phexByteStr "02af" #== phexByteStr "02af"
     , testCase "\"foo\" == \"foo\"" $ expect $ "foo" #== ("foo" :: Term s PString)
     , testCase "PByteString :: mempty <> a == a <> mempty == a" $ do
@@ -127,8 +138,39 @@ plutarchTests =
         expect $
           ("ab" <> "cd") #== ("abcd" :: Term s PString)
     , testCase "PByteString mempty" $ expect $ mempty #== phexByteStr ""
+    , testCase "pconsByteStr" $
+        let xs = "5B1F"; b = "41"
+         in (pconsBS # fromInteger (readByte b) # phexByteStr xs) `equal` phexByteStr (b <> xs)
+    , testCase "plengthByteStr" $ do
+        (plengthBS # phexByteStr "012f") `equal` (2 :: Term s PInteger)
+        expect $ (plengthBS # phexByteStr "012f") #== 2
+        let xs = phexByteStr "48fCd1"
+        (plengthBS #$ pconsBS # 91 # xs)
+          `equal` (1 + plengthBS # xs)
+    , testCase "pindexByteStr" $
+        (pindexBS # phexByteStr "4102af" # 1) `equal` (0x02 :: Term s PInteger)
+    , testCase "psliceByteStr" $
+        (psliceBS # 1 # 3 # phexByteStr "4102afde5b2a") `equal` phexByteStr "02afde"
+    , testCase "pbyteStr - phexByteStr relation" $ do
+        let a = ["42", "ab", "df", "c9"]
+        pbyteStr (BS.pack $ map readByte a) `equal` phexByteStr (concat a)
     , testCase "PString mempty" $ expect $ mempty #== ("" :: Term s PString)
-    , testCase "pfromText \"abc\" `equal` \"abc\"" $ equal (pfromText "abc") ("abc" :: Term s PString)
+    , testCase "pfromText \"abc\" == \"abc\"" $ do
+        pfromText "abc" `equal` ("abc" :: Term s PString)
+        expect $ pfromText "foo" #== "foo"
+    , testCase "#&& - boolean and; #|| - boolean or" $ do
+        let ptrue = pcon PTrue
+            pfalse = pcon PFalse
+        -- AND tests
+        expect $ ptrue #&& ptrue
+        expect $ pnot #$ ptrue #&& pfalse
+        expect $ pnot #$ pfalse #&& ptrue
+        expect $ pnot #$ pfalse #&& pfalse
+        -- OR tests
+        expect $ ptrue #|| ptrue
+        expect $ ptrue #|| pfalse
+        expect $ pfalse #|| ptrue
+        expect $ pnot #$ pfalse #|| pfalse
     , testCase "ScriptPurpose literal" $
         let d :: ScriptPurpose
             d = Minting dummyCurrency
@@ -170,21 +212,21 @@ uplcTests =
               punsafeConstant . PLC.Some $
                 PLC.ValueOf (PLC.DefaultUniApply PLC.DefaultUniProtoList PLC.DefaultUniInteger) [1]
             l' :: Term _ (PBuiltinList PInteger) =
-              (pforce $ punsafeBuiltin PLC.MkCons) # (2 :: Term _ PInteger) # l
+              pforce (punsafeBuiltin PLC.MkCons) # (2 :: Term _ PInteger) # l
          in equal' l' "(program 1.0.0 [2,1])"
     , testCase "[2,1]" $
         let l :: Term _ (PBuiltinList PInteger) =
               punsafeConstant . PLC.Some $
                 PLC.ValueOf (PLC.DefaultUniApply PLC.DefaultUniProtoList PLC.DefaultUniInteger) [1]
             l' :: Term _ (PBuiltinList PInteger) =
-              (pforce $ punsafeBuiltin PLC.MkCons) # (2 :: Term _ PInteger) # l
+              pforce (punsafeBuiltin PLC.MkCons) # (2 :: Term _ PInteger) # l
          in equal' l' "(program 1.0.0 [2,1])"
     , testCase "fails: True:[1]" $
         let l :: Term _ (PBuiltinList POpaque) =
               punsafeConstant . PLC.Some $
                 PLC.ValueOf (PLC.DefaultUniApply PLC.DefaultUniProtoList PLC.DefaultUniInteger) [1]
             l' :: Term _ (PBuiltinList POpaque) =
-              (pforce $ punsafeBuiltin PLC.MkCons) # (pcon PTrue) # l
+              pforce (punsafeBuiltin PLC.MkCons) # pcon PTrue # l
          in fails l'
     , testCase "(2,1)" $
         let p :: Term _ (PBuiltinPair PInteger PInteger) =
@@ -198,10 +240,18 @@ uplcTests =
          in equal' p "(program 1.0.0 (1, 2))"
     , testCase "fails: MkPair 1 2" $
         let p :: Term _ (PBuiltinPair PInteger PInteger) =
-              (punsafeBuiltin PLC.MkPairData) # (1 :: Term _ PInteger) # (2 :: Term _ PInteger)
+              punsafeBuiltin PLC.MkPairData # (1 :: Term _ PInteger) # (2 :: Term _ PInteger)
          in fails p
     ]
 
+{- | Interpret a byte.
+
+>>> readByte "41"
+65
+-}
+readByte :: Num a => String -> a
+readByte a = fromInteger $ read $ "0x" <> a
+
 dummyCurrency :: CurrencySymbol
 dummyCurrency =
   CurrencySymbol . fromJust . Aeson.decode $

plutarch.cabal

@@ -87,6 +87,7 @@ library
     Plutarch.Evaluate
     Plutarch.Maybe
     Plutarch.Unit
+    Plutarch.Crypto
   build-depends:
     , base
     , plutus-core
@@ -108,6 +109,7 @@ test-suite examples
   other-modules:
   build-depends:
     , base
+    , bytestring
     , plutarch
     , tasty
     , tasty-hunit