{-# LANGUAGE AllowAmbiguousTypes          #-}
{-# LANGUAGE DeriveAnyClass               #-}
{-# LANGUAGE NoGeneralisedNewtypeDeriving #-}

module ZkFold.Base.Protocol.NonInteractiveProof.Prover where

import           Control.DeepSeq                          (NFData)
import           Data.Aeson
import           Data.Aeson.Types
import           Data.ByteString                          (ByteString)
import qualified Data.ByteString.Base64                   as B64
import qualified Data.ByteString.Char8                    as BS
import           Data.Swagger
import qualified Data.Text                                as T
import           GHC.Generics                             (Generic)
import           Optics                                   ((&))
import           Prelude
import           Test.QuickCheck                          (Arbitrary (..), generate, vectorOf)

import           ZkFold.Base.Data.ByteString
import           ZkFold.Base.Protocol.NonInteractiveProof (NonInteractiveProof (..))

newtype ProofBytes = ProofBytes
  { ProofBytes -> ByteString
fromWitnessBytes :: ByteString }
  deriving (Int -> ProofBytes -> ShowS
[ProofBytes] -> ShowS
ProofBytes -> String
(Int -> ProofBytes -> ShowS)
-> (ProofBytes -> String)
-> ([ProofBytes] -> ShowS)
-> Show ProofBytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProofBytes -> ShowS
showsPrec :: Int -> ProofBytes -> ShowS
$cshow :: ProofBytes -> String
show :: ProofBytes -> String
$cshowList :: [ProofBytes] -> ShowS
showList :: [ProofBytes] -> ShowS
Show, ProofBytes -> ProofBytes -> Bool
(ProofBytes -> ProofBytes -> Bool)
-> (ProofBytes -> ProofBytes -> Bool) -> Eq ProofBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProofBytes -> ProofBytes -> Bool
== :: ProofBytes -> ProofBytes -> Bool
$c/= :: ProofBytes -> ProofBytes -> Bool
/= :: ProofBytes -> ProofBytes -> Bool
Eq, (forall x. ProofBytes -> Rep ProofBytes x)
-> (forall x. Rep ProofBytes x -> ProofBytes) -> Generic ProofBytes
forall x. Rep ProofBytes x -> ProofBytes
forall x. ProofBytes -> Rep ProofBytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProofBytes -> Rep ProofBytes x
from :: forall x. ProofBytes -> Rep ProofBytes x
$cto :: forall x. Rep ProofBytes x -> ProofBytes
to :: forall x. Rep ProofBytes x -> ProofBytes
Generic, ProofBytes -> ()
(ProofBytes -> ()) -> NFData ProofBytes
forall a. (a -> ()) -> NFData a
$crnf :: ProofBytes -> ()
rnf :: ProofBytes -> ()
NFData)

instance ToJSON ProofBytes where
    toJSON :: ProofBytes -> Value
toJSON (ProofBytes ByteString
b) = Text -> Value
String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString
b

instance FromJSON ProofBytes where
    parseJSON :: Value -> Parser ProofBytes
parseJSON = String -> (Text -> Parser ProofBytes) -> Value -> Parser ProofBytes
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Bytes of proof" ((Text -> Parser ProofBytes) -> Value -> Parser ProofBytes)
-> (Text -> Parser ProofBytes) -> Value -> Parser ProofBytes
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Either String ByteString)
-> Text -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text
t of
            Left String
err -> String -> Parser ProofBytes
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
err
            Right ByteString
bs -> ProofBytes -> Parser ProofBytes
forall a. a -> Parser a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ProofBytes -> Parser ProofBytes)
-> ProofBytes -> Parser ProofBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ProofBytes
ProofBytes ByteString
bs

instance ToSchema ProofBytes where
  declareNamedSchema :: Proxy ProofBytes -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ProofBytes
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Proof bytes") Schema
byteSchema

data ProveAPIResult = ProveAPISuccess ProofBytes | ProveAPIErrorSetup | ProveAPIErrorWitness
    deriving (Int -> ProveAPIResult -> ShowS
[ProveAPIResult] -> ShowS
ProveAPIResult -> String
(Int -> ProveAPIResult -> ShowS)
-> (ProveAPIResult -> String)
-> ([ProveAPIResult] -> ShowS)
-> Show ProveAPIResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProveAPIResult -> ShowS
showsPrec :: Int -> ProveAPIResult -> ShowS
$cshow :: ProveAPIResult -> String
show :: ProveAPIResult -> String
$cshowList :: [ProveAPIResult] -> ShowS
showList :: [ProveAPIResult] -> ShowS
Show, ProveAPIResult -> ProveAPIResult -> Bool
(ProveAPIResult -> ProveAPIResult -> Bool)
-> (ProveAPIResult -> ProveAPIResult -> Bool) -> Eq ProveAPIResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProveAPIResult -> ProveAPIResult -> Bool
== :: ProveAPIResult -> ProveAPIResult -> Bool
$c/= :: ProveAPIResult -> ProveAPIResult -> Bool
/= :: ProveAPIResult -> ProveAPIResult -> Bool
Eq, (forall x. ProveAPIResult -> Rep ProveAPIResult x)
-> (forall x. Rep ProveAPIResult x -> ProveAPIResult)
-> Generic ProveAPIResult
forall x. Rep ProveAPIResult x -> ProveAPIResult
forall x. ProveAPIResult -> Rep ProveAPIResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProveAPIResult -> Rep ProveAPIResult x
from :: forall x. ProveAPIResult -> Rep ProveAPIResult x
$cto :: forall x. Rep ProveAPIResult x -> ProveAPIResult
to :: forall x. Rep ProveAPIResult x -> ProveAPIResult
Generic, ProveAPIResult -> ()
(ProveAPIResult -> ()) -> NFData ProveAPIResult
forall a. (a -> ()) -> NFData a
$crnf :: ProveAPIResult -> ()
rnf :: ProveAPIResult -> ()
NFData)

instance ToJSON ProveAPIResult where
  toJSON :: ProveAPIResult -> Value
toJSON (ProveAPISuccess ProofBytes
bs) = [Pair] -> Value
object
    [ Key
"status" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"success" :: String)
    , Key
"data" Key -> ProofBytes -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProofBytes
bs
    ]
  toJSON ProveAPIResult
ProveAPIErrorSetup = [Pair] -> Value
object
    [ Key
"status" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"error" :: String)
    , Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"Setup error" :: String)
    ]
  toJSON ProveAPIResult
ProveAPIErrorWitness = [Pair] -> Value
object
    [Key
"status" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"error" :: String)
    , Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"Witness error" :: String)
    ]

instance FromJSON ProveAPIResult where
  parseJSON :: Value -> Parser ProveAPIResult
parseJSON = String
-> (Object -> Parser ProveAPIResult)
-> Value
-> Parser ProveAPIResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProveAPIResult" ((Object -> Parser ProveAPIResult)
 -> Value -> Parser ProveAPIResult)
-> (Object -> Parser ProveAPIResult)
-> Value
-> Parser ProveAPIResult
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status" Parser String -> (Parser String -> Parser String) -> Parser String
forall a b. a -> (a -> b) -> b
& forall a. a -> a
id @(Parser String) Parser String
-> (String -> Parser ProveAPIResult) -> Parser ProveAPIResult
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      String
"success" -> ProofBytes -> ProveAPIResult
ProveAPISuccess (ProofBytes -> ProveAPIResult)
-> Parser ProofBytes -> Parser ProveAPIResult
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser ProofBytes
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
      String
"error" -> Object
v Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message" Parser String -> (Parser String -> Parser String) -> Parser String
forall a b. a -> (a -> b) -> b
& forall a. a -> a
id @(Parser String) Parser String
-> (String -> Parser ProveAPIResult) -> Parser ProveAPIResult
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        String
"Setup error" -> ProveAPIResult -> Parser ProveAPIResult
forall a. a -> Parser a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ProveAPIResult
ProveAPIErrorSetup
        String
"Witness error" -> ProveAPIResult -> Parser ProveAPIResult
forall a. a -> Parser a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ProveAPIResult
ProveAPIErrorWitness
        String
_ -> String -> Parser ProveAPIResult
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Unknown error message"
      String
_ -> String -> Parser ProveAPIResult
forall a. String -> Parser a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Unknown status"

instance ToSchema ProveAPIResult where
  declareNamedSchema :: Proxy ProveAPIResult -> Declare (Definitions Schema) NamedSchema
declareNamedSchema = SchemaOptions
-> Proxy ProveAPIResult -> Declare (Definitions Schema) NamedSchema
forall a.
(Generic a, GToSchema (Rep a)) =>
SchemaOptions
-> Proxy a -> Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaUnrestricted SchemaOptions
defaultSchemaOptions

proveAPI
    :: forall a core
    . (NonInteractiveProof a core
    , Binary (SetupProve a)
    , Binary (Witness a)
    , Binary (Input a)
    , Binary (Proof a))
    => ByteString
    -> ByteString
    -> ProveAPIResult
proveAPI :: forall {k} a (core :: k).
(NonInteractiveProof a core, Binary (SetupProve a),
 Binary (Witness a), Binary (Input a), Binary (Proof a)) =>
ByteString -> ByteString -> ProveAPIResult
proveAPI ByteString
bsS ByteString
bsW =
    let mS :: Maybe (SetupProve a)
mS = ByteString -> Maybe (SetupProve a)
forall a. Binary a => ByteString -> Maybe a
fromByteString ByteString
bsS
        mW :: Maybe (Witness a)
mW = ByteString -> Maybe (Witness a)
forall a. Binary a => ByteString -> Maybe a
fromByteString ByteString
bsW
    in case (Maybe (SetupProve a)
mS, Maybe (Witness a)
mW) of
        (Maybe (SetupProve a)
Nothing, Maybe (Witness a)
_)     -> ProveAPIResult
ProveAPIErrorSetup
        (Maybe (SetupProve a)
_, Maybe (Witness a)
Nothing)     -> ProveAPIResult
ProveAPIErrorWitness
        (Just SetupProve a
s, Just Witness a
w) -> ProofBytes -> ProveAPIResult
ProveAPISuccess (ProofBytes -> ProveAPIResult)
-> (ByteString -> ProofBytes) -> ByteString -> ProveAPIResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ProofBytes
ProofBytes (ByteString -> ProveAPIResult) -> ByteString -> ProveAPIResult
forall a b. (a -> b) -> a -> b
$ (Input a, Proof a) -> ByteString
forall a. Binary a => a -> ByteString
toByteString ((Input a, Proof a) -> ByteString)
-> (Input a, Proof a) -> ByteString
forall a b. (a -> b) -> a -> b
$ forall a (core :: k).
NonInteractiveProof a core =>
SetupProve a -> Witness a -> (Input a, Proof a)
forall {k} a (core :: k).
NonInteractiveProof a core =>
SetupProve a -> Witness a -> (Input a, Proof a)
prove @a @core SetupProve a
s Witness a
w

testVector :: forall a core .
    NonInteractiveProof a core =>
    Arbitrary a =>
    Arbitrary (Witness a) =>
    Binary (SetupProve a) =>
    Binary (Input a) =>
    Binary (Proof a) =>
    Int -> IO [(ByteString, ByteString, ByteString)]
testVector :: forall {k} a (core :: k).
(NonInteractiveProof a core, Arbitrary a, Arbitrary (Witness a),
 Binary (SetupProve a), Binary (Input a), Binary (Proof a)) =>
Int -> IO [(ByteString, ByteString, ByteString)]
testVector Int
n = Gen [(ByteString, ByteString, ByteString)]
-> IO [(ByteString, ByteString, ByteString)]
forall a. Gen a -> IO a
generate (Gen [(ByteString, ByteString, ByteString)]
 -> IO [(ByteString, ByteString, ByteString)])
-> (Gen (ByteString, ByteString, ByteString)
    -> Gen [(ByteString, ByteString, ByteString)])
-> Gen (ByteString, ByteString, ByteString)
-> IO [(ByteString, ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Gen (ByteString, ByteString, ByteString)
-> Gen [(ByteString, ByteString, ByteString)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Gen (ByteString, ByteString, ByteString)
 -> IO [(ByteString, ByteString, ByteString)])
-> Gen (ByteString, ByteString, ByteString)
-> IO [(ByteString, ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ (,)
    (a -> Witness a -> (a, Witness a))
-> Gen a -> Gen (Witness a -> (a, Witness a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @a
    Gen (Witness a -> (a, Witness a))
-> Gen (Witness a) -> Gen (a, Witness a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary @(Witness a)
    Gen (a, Witness a)
-> ((a, Witness a) -> Gen (ByteString, ByteString, ByteString))
-> Gen (ByteString, ByteString, ByteString)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
a, Witness a
w) -> do
        let s :: SetupProve a
s = forall a (core :: k).
NonInteractiveProof a core =>
a -> SetupProve a
forall {k} a (core :: k).
NonInteractiveProof a core =>
a -> SetupProve a
setupProve @a @core a
a
        let (Input a
i, Proof a
p) = forall a (core :: k).
NonInteractiveProof a core =>
SetupProve a -> Witness a -> (Input a, Proof a)
forall {k} a (core :: k).
NonInteractiveProof a core =>
SetupProve a -> Witness a -> (Input a, Proof a)
prove @a @core SetupProve a
s Witness a
w
        (ByteString, ByteString, ByteString)
-> Gen (ByteString, ByteString, ByteString)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (SetupProve a -> ByteString
forall a. Binary a => a -> ByteString
toByteString SetupProve a
s, Input a -> ByteString
forall a. Binary a => a -> ByteString
toByteString Input a
i, Proof a -> ByteString
forall a. Binary a => a -> ByteString
toByteString Proof a
p)