{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
module Plutus.Contract.Secrets(
  Secret
  , SecretArgument (..)
  , mkSecret
  , secretArg
  , extractSecret
  , escape_sha2_256
  , unsafe_escape_secret
  ) where

import Control.Monad
import Data.Aeson as Aeson (FromJSON (..), ToJSON (..), Value (..))
import Data.Aeson.Encoding.Internal (string)
import Data.String
import PlutusTx.Prelude as PlutusTx
import Prelude qualified as Haskell

-- | A secret value. A value of type `Secret a` can't leak onto
-- the blockchain in plain-text unless you use an unsafe function.
-- However, a value of type `Secret a` can end up on the blockchain
-- via one of the escape hatches like `escape_sha2_256`.
newtype Secret a = MkSecret a

{- Note [Secret abstraction]
   A value of type `Secret a` is guaranteed not to leak (without a compiler warning)
   because of type abstraction. Intuitively, the `PlutusTx.Extensions.Secrets` module
   does not export the `MkSecret` constructor so as long as the client code that
   imports `PlutusTx.Extensions.Secrets` does not use some unholy `unsafePerformIO` to
   break the Haskell type system the code is guaranteed not to depend on the actual
   value of a secret without:
     1. Using a safe function like `escape_sha2_256` or
     2. Using an unsafe function like `unsafe_escape_secret` (which has a compiler warning
        attached to it).

   This intuition can be made formally precise (see Algehed and Bernardy 2019).

   As noted above, `unsafe_escape_secret` breaks the abstraction barrier and we need to export
   it for two reasons:
     1. To make the library backwards-compatible. If you have some new hash function you should
        be able to define `escape_my_magic_hash` without having to implement it in this module.
     2. For tests it is sometimes necessary to use `unsafe_escape_secret` to inspect the value
        of a secret.

   See `Plutus.Contracts.SealedBidAuction` or `Plutus.Contract.GameStateMachineWithSecretTypes`
   for examples.
 -}

-- | Secret argments are provided in the endpoint argument types.
--
-- This type guarantees that a `SecretArgument a` that is seen by
-- the endpoint code is a `Secret a` in a way that can not be
-- bypassed by safe code.
data SecretArgument a = UserSide a
                      | EndpointSide (Secret a)
                      deriving Int -> SecretArgument a -> ShowS
[SecretArgument a] -> ShowS
SecretArgument a -> String
(Int -> SecretArgument a -> ShowS)
-> (SecretArgument a -> String)
-> ([SecretArgument a] -> ShowS)
-> Show (SecretArgument a)
forall a. Show a => Int -> SecretArgument a -> ShowS
forall a. Show a => [SecretArgument a] -> ShowS
forall a. Show a => SecretArgument a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretArgument a] -> ShowS
$cshowList :: forall a. Show a => [SecretArgument a] -> ShowS
show :: SecretArgument a -> String
$cshow :: forall a. Show a => SecretArgument a -> String
showsPrec :: Int -> SecretArgument a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SecretArgument a -> ShowS
Haskell.Show

{- Note [Secret arguments]
   When we write endpoint code we would like to specify the argument type
   for an endpoint with code that looks something like this:
   ```
   data MyEndpointArgs = MyEndpointArgs { publicArg :: Int , secretArg :: Secret Int }

   type UserSchema = Endpoint "myendpoint" MyEndpointArgs
                     .\/ ...
   ```
   Which would mean that any endpoint code for `myendpoint` would be guaranteed not to
   leak the `secretArg` in plaintext to the blockchain (or elsewhere for that matter).

   However, the type `MyEndpointArgs` needs to be an instance of the class `ToJSON`
   for this to work out with the `endpoint` function. Consequently, we would need to
   provide a function `toJSON :: Secret a -> Value` that would have to break abstraction
   for the `Secret` type (see [Secret abstraction]) which would be bad.

   The `SecretArgument a` type fixes this by having two constructors `UserSide :: a -> SecretArgument a`
   and `EndpointSide :: Secret a -> SecretArgument a` that ensures that as secrets are submitted
   to endpoint code by the user they are "public", while when the secret reaches the endpoint code it
   has been obscured by a `Secret` wrapper that gives us the guarantee that the secret doesn't leak.

   See `Plutus.Contracts.SealedBidAuction` or `Plutus.Contract.GameStateMachineWithSecretTypes` for examples.
 -}

instance ToJSON a => ToJSON (SecretArgument a) where
  toJSON :: SecretArgument a -> Value
toJSON (UserSide a
a)     = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a
  toJSON (EndpointSide Secret a
_) = Text -> Value
Aeson.String Text
"EndpointSide *****"

  toEncoding :: SecretArgument a -> Encoding
toEncoding (UserSide a
a)     = a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding a
a
  toEncoding (EndpointSide Secret a
_) = String -> Encoding
forall a. String -> Encoding' a
string String
"EndpointSide *****"

instance FromJSON a => FromJSON (SecretArgument a) where
  parseJSON :: Value -> Parser (SecretArgument a)
parseJSON = (a -> SecretArgument a) -> Parser a -> Parser (SecretArgument a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Secret a -> SecretArgument a
forall a. Secret a -> SecretArgument a
EndpointSide (Secret a -> SecretArgument a)
-> (a -> Secret a) -> a -> SecretArgument a
forall b c a. (b -> c) -> (a -> b) -> a -> c
Haskell.. a -> Secret a
forall a. a -> Secret a
mkSecret) (Parser a -> Parser (SecretArgument a))
-> (Value -> Parser a) -> Value -> Parser (SecretArgument a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
Haskell.. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON

instance Haskell.Show (Secret a) where
  show :: Secret a -> String
show (MkSecret a
_) = String
"*****"

instance Haskell.Functor Secret where
  fmap :: (a -> b) -> Secret a -> Secret b
fmap a -> b
f (MkSecret a
a) = b -> Secret b
forall a. a -> Secret a
MkSecret (a -> b
f a
a)

instance PlutusTx.Functor Secret where
  fmap :: (a -> b) -> Secret a -> Secret b
fmap a -> b
f (MkSecret a
a) = b -> Secret b
forall a. a -> Secret a
MkSecret (a -> b
f a
a)

instance Haskell.Applicative Secret where
  pure :: a -> Secret a
pure = a -> Secret a
forall a. a -> Secret a
mkSecret
  (MkSecret a -> b
f) <*> :: Secret (a -> b) -> Secret a -> Secret b
<*> (MkSecret a
a) = b -> Secret b
forall a. a -> Secret a
MkSecret (a -> b
f a
a)

instance PlutusTx.Applicative Secret where
  pure :: a -> Secret a
pure = a -> Secret a
forall a. a -> Secret a
MkSecret
  (MkSecret a -> b
f) <*> :: Secret (a -> b) -> Secret a -> Secret b
<*> (MkSecret a
a) = b -> Secret b
forall a. a -> Secret a
MkSecret (a -> b
f a
a)

instance Monad Secret where
  MkSecret a
a >>= :: Secret a -> (a -> Secret b) -> Secret b
>>= a -> Secret b
f = a -> Secret b
f a
a

instance IsString s => IsString (Secret s) where
  fromString :: String -> Secret s
fromString = s -> Secret s
forall a. a -> Secret a
MkSecret (s -> Secret s) -> (String -> s) -> String -> Secret s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString

instance IsString s => IsString (SecretArgument s) where
  fromString :: String -> SecretArgument s
fromString = s -> SecretArgument s
forall a. a -> SecretArgument a
UserSide (s -> SecretArgument s)
-> (String -> s) -> String -> SecretArgument s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString

-- | Turn a public value into a secret value
mkSecret :: a -> Secret a
mkSecret :: a -> Secret a
mkSecret = a -> Secret a
forall a. a -> Secret a
MkSecret

-- | Construct a secret argument
secretArg :: a -> SecretArgument a
secretArg :: a -> SecretArgument a
secretArg = a -> SecretArgument a
forall a. a -> SecretArgument a
UserSide

-- | Extract a secret value from a secret argument
extractSecret :: SecretArgument a -> Secret a
extractSecret :: SecretArgument a -> Secret a
extractSecret (UserSide a
a)     = a -> Secret a
forall a. a -> Secret a
mkSecret a
a
extractSecret (EndpointSide Secret a
s) = Secret a
s

-- | Take the sha2_256 hash of a secret value. The result of this
-- function can be used on the blockchain.
{-# INLINABLE escape_sha2_256 #-}
escape_sha2_256 :: Secret BuiltinByteString -> BuiltinByteString
escape_sha2_256 :: Secret BuiltinByteString -> BuiltinByteString
escape_sha2_256 = BuiltinByteString -> BuiltinByteString
sha2_256 (BuiltinByteString -> BuiltinByteString)
-> (Secret BuiltinByteString -> BuiltinByteString)
-> Secret BuiltinByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Secret BuiltinByteString -> BuiltinByteString
forall a. Secret a -> a
unsafe_escape_secret

{-# WARNING unsafe_escape_secret "[Requires Review] An escape hatch is being created. This should only be used in trusted code." #-}
unsafe_escape_secret :: Secret a -> a
unsafe_escape_secret :: Secret a -> a
unsafe_escape_secret (MkSecret a
a) = a
a