add better server error messages, cbor vs raw hex

agora/Agora/Aeson/Orphans.hs

@@ -20,6 +20,7 @@ import Data.Text.Encoding qualified as T
 
 import PlutusLedgerApi.V1 qualified as Plutus
 import PlutusLedgerApi.V1.Bytes qualified as Plutus
+import PlutusLedgerApi.V1.Scripts qualified as Plutus
 import PlutusLedgerApi.V1.Value qualified as Plutus
 
 --------------------------------------------------------------------------------
@@ -109,6 +110,15 @@ deriving via
   instance
     (Aeson.FromJSON Plutus.ValidatorHash)
 
+deriving via
+  (AsBase16Bytes Plutus.ScriptHash)
+  instance
+    (Aeson.ToJSON Plutus.ScriptHash)
+deriving via
+  (AsBase16Bytes Plutus.ScriptHash)
+  instance
+    (Aeson.FromJSON Plutus.ScriptHash)
+
 deriving via
   (AsBase16Bytes Plutus.BuiltinByteString)
   instance

agora/Agora/ScriptInfo.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 {- |
 Module     : Agora.ScriptInfo
 Maintainer : emi@haskell.fyi
@@ -7,8 +9,6 @@ Exportable script bundles for off-chain consumption.
 -}
 module Agora.ScriptInfo (
   -- * Types
-  PolicyInfo (..),
-  ValidatorInfo (..),
   ScriptInfo (..),
 
   -- * Introduction functions
@@ -17,100 +17,71 @@ module Agora.ScriptInfo (
 ) where
 
 import Agora.Aeson.Orphans ()
+import Cardano.Binary qualified as CBOR
+import Codec.Serialise qualified as Codec
 import Data.Aeson qualified as Aeson
+import Data.ByteString.Base16 qualified as Base16
+import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Short qualified as SBS
+import Data.Text (Text)
 import GHC.Generics qualified as GHC
-import Plutarch.Api.V1 (PMintingPolicy, PValidator, mintingPolicySymbol, mkMintingPolicy, mkValidator, validatorHash)
+import Plutarch.Api.V1 (PMintingPolicy, PValidator, mkMintingPolicy, mkValidator, scriptHash)
 import PlutusLedgerApi.V1 (
-  BuiltinByteString,
-  CurrencySymbol,
-  MintingPolicy,
+  MintingPolicy (getMintingPolicy),
   Script,
-  Validator,
-  ValidatorHash,
+  Validator (getValidator),
  )
-
--- | Bundle containing a 'Script' and its hash.
-data ScriptInfo = ScriptInfo
-  { script :: Script
-  -- ^ The validator script.
-  , hash :: BuiltinByteString
-  -- ^ Hash of the script.
-  }
-  deriving stock (Show, Eq, GHC.Generic)
-  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
+import PlutusLedgerApi.V1.Scripts (ScriptHash)
 
 {- | Bundle containing a 'Validator' and its hash.
 
-     @since 0.1.0
+     @since 0.2.0
 -}
-data ValidatorInfo = ValidatorInfo
-  { script :: Validator
-  -- ^ The validator script.
-  , hash :: ValidatorHash
+data ScriptInfo = ScriptInfo
+  { cborHex :: Text
+  -- ^ The validator script encoded as cbor hex.
+  , rawHex :: Text
+  -- ^ The validator script encoded as raw hex.
+  , hash :: ScriptHash
   -- ^ Hash of the validator.
   }
   deriving stock
-    ( -- | @since 0.1.0
+    ( -- | @since 0.2.0
       Show
-    , -- | @since 0.1.0
+    , -- | @since 0.2.0
       Eq
-    , -- | @since 0.1.0
+    , -- | @since 0.2.0
       GHC.Generic
     )
   deriving anyclass
-    ( -- | @since 0.1.0
+    ( -- | @since 0.2.0
       Aeson.ToJSON
-    , -- | @since 0.1.0
+    , -- | @since 0.2.0
       Aeson.FromJSON
     )
 
-{- | Create a 'ValidatorInfo' given a Plutarch term.
+mkScriptInfo :: Script -> ScriptInfo
+mkScriptInfo script =
+  let scriptRaw = LBS.toStrict $ Codec.serialise script
+      scriptCBOR = CBOR.serialize' $ SBS.toShort scriptRaw
+   in ScriptInfo
+        { cborHex = Base16.encodeBase16 scriptCBOR
+        , rawHex = Base16.encodeBase16 scriptRaw
+        , hash = scriptHash script
+        }
 
-     @since 0.1.0
+{- | Create a 'ScriptInfo' given a Plutarch term of a policy.
+
+     @since 0.2.0
 -}
-mkValidatorInfo :: ClosedTerm PValidator -> ValidatorInfo
-mkValidatorInfo term =
-  ValidatorInfo
-    { script = validator
-    , hash = validatorHash validator
-    }
-  where
-    validator = mkValidator term
-
-{- | Bundle containing a 'MintingPolicy' and its symbol.
-
-     @since 0.1.0
--}
-data PolicyInfo = PolicyInfo
-  { policy :: MintingPolicy
-  -- ^ The minting policy.
-  , currencySymbol :: CurrencySymbol
-  -- ^ The symbol given by the minting policy.
-  }
-  deriving stock
-    ( -- | @since 0.1.0
-      Show
-    , -- | @since 0.1.0
-      Eq
-    , -- | @since 0.1.0
-      GHC.Generic
-    )
-  deriving anyclass
-    ( -- | @since 0.1.0
-      Aeson.ToJSON
-    , -- | @since 0.1.0
-      Aeson.FromJSON
-    )
-
-{- | Create a 'PolicyInfo' given a Plutarch term.
-
-     @since 0.1.0
--}
-mkPolicyInfo :: ClosedTerm PMintingPolicy -> PolicyInfo
+mkPolicyInfo :: ClosedTerm PMintingPolicy -> ScriptInfo
 mkPolicyInfo term =
-  PolicyInfo
-    { policy = policy
-    , currencySymbol = mintingPolicySymbol policy
-    }
-  where
-    policy = mkMintingPolicy term
+  mkScriptInfo (getMintingPolicy $ mkMintingPolicy term)
+
+{- | Create a 'ScriptInfo' given a Plutarch term of a validator.
+
+     @since 0.2.0
+-}
+mkValidatorInfo :: ClosedTerm PValidator -> ScriptInfo
+mkValidatorInfo term =
+  mkScriptInfo (getValidator $ mkValidator term)