friendly and idiomatic Haskell API (#16)

* Add high level Haskell API

* do not split parameters

* provide separate rust function for hash parameters

* address comments from review

* fix typo in comment

.github/workflows/ci.yml

@@ -47,8 +47,8 @@ jobs:
       - name: Set up Haskell
         uses: haskell-actions/setup@v2
         with:
-          ghc-version: '9.2.5'  
-          cabal-version: '3.6.2.0'
+          ghc-version: '9.10.1'  
+          cabal-version: 'latest'
 
       - name: Build with Cabal
         run: cabal build

plonk-verify.cabal

@@ -1,22 +1,7 @@
 cabal-version: 3.0
 name: plonk-verify
 version: 0.1.0
-
--- A short (one-line) description of the package.
--- synopsis:
-
--- A longer description of the package.
--- description:
-
 license: MIT
-
--- The package author(s).
--- author:
-
--- An email address to which users can send suggestions, bug reports, and
--- patches.
--- maintainer:
-
 copyright: Copyright (c) 2024 Argument Computer Corporation
 
 extra-doc-files:
@@ -46,9 +31,17 @@ library
     default-language: Haskell2010
     hs-source-dirs: src
     exposed-modules:
-        PlonkVerify
+        PlonkBn254.Verify
+        PlonkBn254.Utils.EmbedVMKeys
     build-depends:
-        base
+        , base
+        , base16-bytestring >=0.1.1.7
+        , bytestring >=0.11.2
+        , directory >=1.3
+        , filepath >=1.4
+        , template-haskell >=2.16
+        , temporary >=1.3
+        , vector >=0.12
     frameworks:
         CoreFoundation
         Security
@@ -63,7 +56,10 @@ test-suite tests
     main-is: Main.hs
     hs-source-dirs: tests
     build-depends:
-        , plonk-verify
         , aeson >=2.2
         , base
+        , base16-bytestring >=0.1.1.7
+        , bytestring >=0.11.2
         , hspec >=2.11
+        , plonk-verify
+        , text >=2.1

src/PlonkBn254/Utils/EmbedVMKeys.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- |
+-- Module: PlonkBn254.Utils.EmbedVMKeys
+-- Copyright: Copyright © 2024 Kadena LLC.
+-- License: MIT
+-- Maintainer: Lars Kuhtz <[email protected]>
+-- Stability: experimental
+--
+module PlonkBn254.Utils.EmbedVMKeys
+( embedVMKeys
+) where
+
+import Control.Monad
+
+import Data.ByteString qualified as B
+import Data.Functor
+import Data.List qualified as L
+import Data.Vector qualified as V
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+import System.Directory
+import System.FilePath
+
+-- internal modules
+
+import PlonkBn254.Verify
+
+-- -------------------------------------------------------------------------- --
+-- Embed VM Keys
+
+-- | Running this slice produces @[(FilePath, VMKey)]@.
+--
+-- It does not recurse into subdirectories and ignores any files that do
+-- not have the suffix @.bin@.
+--
+-- The file path is the (relative) file name within the given directory.
+--
+embedVMKeys :: String -> FilePath -> Code Q [(FilePath, VMKey)]
+embedVMKeys suffix fp = embedIO $ readVMKeyDir suffix fp
+
+readVMKeyDir :: String -> FilePath -> IO [(FilePath, VMKey)]
+readVMKeyDir suffix fp = do
+    paths <- listFiles suffix fp
+    forM paths $ \p -> do
+        vk <- VMKey <$> B.readFile (fp </> p)
+        return (stripSuffix p, vk)
+  where
+    stripSuffix x = take (length x - length suffix - 1) x
+
+-- | The returned paths are relative to the given directory
+--
+listFiles :: String -> FilePath -> IO [FilePath]
+listFiles suffix r = listDirectory r
+    >>= filterM (doesFileExist . (r </>))
+    >>= filterM (fmap readable . getPermissions . (r </>))
+    <&> filter (L.isSuffixOf ("." <> suffix))
+
+-- -------------------------------------------------------------------------- --
+-- File embedding
+
+embedIO :: Lift a => IO a -> Code Q a
+embedIO action = runIO action `bindCode` liftTyped
+
+-- -------------------------------------------------------------------------- --
+-- Orphan Lift instances
+--
+-- Requires template-haskell >=2.16
+
+instance (Lift a) => Lift (V.Vector a) where
+    lift v = [| V.fromListN n' v' |]
+      where
+        n' = V.length v
+        v' = V.toList v
+    liftTyped = Code . unsafeTExpCoerce . lift
+

src/PlonkBn254/Verify.hs

@@ -0,0 +1,157 @@
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | This library is not tied to a particular VM key. But it provides tools that
+-- help users to manage VM keys in their applications.
+
+module PlonkBn254.Verify
+( VMKey(..)
+, Proof(..)
+, ProgramId(..)
+, PublicParameter(..)
+, PublicParameterHash(..)
+, mkPublicParameterHash
+, verify
+, verifyPrehashed
+) where
+
+import Data.ByteString qualified as B
+import Data.ByteString.Base16 qualified as B16
+import Data.ByteString.Short qualified as BS
+
+import Foreign.C.String
+import Foreign.C.Types
+
+import Language.Haskell.TH.Syntax (Lift)
+
+import System.IO.Temp
+import Data.Bits
+
+-- -------------------------------------------------------------------------- --
+-- Plonk Verifier FFI
+
+foreign import ccall safe "__c_verify_plonk_bn254"
+    verify_plonk_bn254 :: CString -> CString -> CString -> CString -> IO (CUInt)
+
+foreign import ccall safe "__c_verify_plonk_bn254_prehashed"
+    verify_plonk_bn254_prehashed :: CString -> CString -> CString -> CString -> IO (CUInt)
+
+-- -------------------------------------------------------------------------- --
+-- API Types
+
+-- | The VM key identifies the circuit of the VM that is used to execute and
+-- proof the program. Intuitively, one can think of the key as a version
+-- identifier of the VM.
+--
+-- When the VM circuit is updated the key changes. Applications should record
+-- what key a proofs depends on for verification. The module "EmbedVMKeys"
+-- provides tools for embedding existing keys from files into applications
+-- binaries.
+--
+newtype VMKey = VMKey
+    { _vmKey :: B.ByteString }
+    deriving (Show, Eq, Ord)
+    deriving (Lift)
+
+-- | The actual proof. This is opaque cryptographic object that allows the
+-- verifier to establish that a program was executed with a particular list of
+-- public parameters in the context of the VM that is idendified with a
+-- particular VM key.
+--
+newtype Proof = Proof
+    { _proof :: BS.ShortByteString }
+    deriving (Show, Eq, Ord)
+
+-- | A unique identifier of a program.
+--
+newtype ProgramId = ProgramId
+    { _programId :: BS.ShortByteString }
+    deriving (Show, Eq, Ord)
+
+-- | The public parameters of a program invocation.
+--
+newtype PublicParameter = PublicParameter
+    { _publicParameter :: BS.ShortByteString }
+    deriving (Show, Eq, Ord)
+
+-- | The hash of the public parameters of a program invocation.
+--
+newtype PublicParameterHash = PublicParameterHash
+    { _publicParameterHash :: BS.ShortByteString }
+    deriving (Show, Eq, Ord)
+
+-- | Helper function that checks some invariants on the format of public
+-- parameters digest. It is valid only for Plonk over curve BN254.
+--
+mkPublicParameterHash :: BS.ShortByteString -> Either String PublicParameterHash
+mkPublicParameterHash bytes
+    | BS.length bytes /= 32 = Left $ "wrong length; expected: 32, actual: " <> show (BS.length bytes)
+    | BS.head bytes .&. 0xe0 /= 0 = Left "first three bit are not set to 0"
+    | otherwise = Right $ PublicParameterHash bytes
+
+-- -------------------------------------------------------------------------- --
+-- Plonk Verifier API
+
+-- | Verify the claim that the program with the given id was invoked with the
+-- given list of public parameters.
+--
+verify
+    :: VMKey
+        -- ^ The VM key in bytes. This key represents the particular version of
+        -- the verifier. It must match the respective version of the prover that
+        -- was used to generate the proof. Otherwise verification fails.
+    -> Proof
+        -- ^ The proof object for the invocation of program with the respective
+        -- public parameters.
+    -> ProgramId
+        -- ^ The program identifier. A program is valid only in the context of a
+        -- particular VM key. It also the number and types of public parameters
+        -- are well defined.
+    -> PublicParameter
+        -- ^ The public parameters of the program execution. The encoding of the
+        -- parameters depends on the program.
+    -> IO Bool
+verify (VMKey vk) (Proof proof) (ProgramId pid) (PublicParameter params) = do
+    withSystemTempDirectory "plonk-verifier" $ \path -> do
+        B.writeFile (path <> "/" <> "vk.bin") vk
+        withCString path $ \cpath ->
+            useAsHexCString (proof) $ \cproof ->
+                useAsHexCString pid $ \cpid ->
+                    useAsHexCString params $ \cparams ->
+                        (== 1) <$> verify_plonk_bn254 cpath cproof cpid cparams
+  where
+    useAsHexCString = B.useAsCString . B16.encode . BS.fromShort
+
+-- | Verify the claim that the program with the given id was invoked with the
+-- list of public parameters with the given digest.
+--
+verifyPrehashed
+    :: VMKey
+        -- ^ The VM key in bytes. This key represents the particular version of
+        -- the verifier. It must match the respective version of the prover that
+        -- was used to generate the proof. Otherwise verification fails.
+    -> Proof
+        -- ^ The proof object for the invocation of program with the respective
+        -- public parameters.
+    -> ProgramId
+        -- ^ The program identifier. A program is valid only in the context of a
+        -- particular VM key. It also the number and types of public parameters
+        -- are well defined.
+    -> PublicParameterHash
+        -- ^ The digest of the public parameters as computed by
+        -- 'hashPublicParameters'.
+    -> IO Bool
+verifyPrehashed (VMKey vk) (Proof proof) (ProgramId pid) (PublicParameterHash paramHash) = do
+    withSystemTempDirectory "plonk-verifier" $ \path -> do
+        B.writeFile (path <> "/" <> "vk.bin") vk
+        withCString path $ \cpath ->
+            useAsHexCString (proof) $ \cproof ->
+                useAsHexCString pid $ \cpid ->
+                    useAsHexCString paramHash $ \cparamHash ->
+                        (== 1) <$> verify_plonk_bn254_prehashed cpath cproof cpid cparamHash
+  where
+    useAsHexCString = B.useAsCString . B16.encode . BS.fromShort
+