{-# LANGUAGE ScopedTypeVariables #-}

module Test.Cardano.Crypto.Wallet.RoundTripSpec (tests) where

import qualified Data.ByteString as BS
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Test.QuickCheck.Monadic (monadicIO, run)

import Cardano.Crypto.WalletHD.Encrypted
import Test.Cardano.Crypto.WalletHD.Arbitrary ()

emptyPass :: BS.ByteString
emptyPass :: ByteString
emptyPass = ByteString
BS.empty

testPass :: BS.ByteString
testPass :: ByteString
testPass = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x42

testSeed :: BS.ByteString
testSeed :: ByteString
testSeed = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x02

testCC :: BS.ByteString
testCC :: ByteString
testCC = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0xAB

tests :: Spec
tests :: Spec
tests = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"RoundTrip" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encryptedCreate produces EnvelopeV2 format" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate ByteString
testSeed ByteString
testPass ByteString
testCC
    case Either XPrvError EncryptedKey
res of
      Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"encryptedCreate failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
      Right EncryptedKey
key -> EncryptedKey -> XPrvFormat
encryptedKeyFormat EncryptedKey
key XPrvFormat -> XPrvFormat -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` XPrvFormat
EnvelopeV2

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"validateXPrvPassphrase succeeds with correct passphrase" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate ByteString
testSeed ByteString
testPass ByteString
testCC
    case Either XPrvError EncryptedKey
res of
      Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"encryptedCreate failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
      Right EncryptedKey
key -> do
        Either XPrvError ()
r <- EncryptedKey -> ByteString -> IO (Either XPrvError ())
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError ())
encryptedValidatePassphrase EncryptedKey
key ByteString
testPass
        Either XPrvError ()
r Either XPrvError () -> Either XPrvError () -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` () -> Either XPrvError ()
forall a b. b -> Either a b
Right ()

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"validateXPrvPassphrase fails with wrong passphrase" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate ByteString
testSeed ByteString
testPass ByteString
testCC
    case Either XPrvError EncryptedKey
res of
      Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"encryptedCreate failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
      Right EncryptedKey
key -> do
        Either XPrvError ()
r <- EncryptedKey -> ByteString -> IO (Either XPrvError ())
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError ())
encryptedValidatePassphrase EncryptedKey
key (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x00)
        Either XPrvError ()
r Either XPrvError () -> Either XPrvError () -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` XPrvError -> Either XPrvError ()
forall a b. a -> Either a b
Left XPrvError
XPrvAuthenticationFailed

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encryptedChangePass preserves public key" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate ByteString
testSeed ByteString
testPass ByteString
testCC
    case Either XPrvError EncryptedKey
res of
      Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"encryptedCreate failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
      Right EncryptedKey
key -> do
        let newPass :: ByteString
newPass = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0xFF
        Either XPrvError EncryptedKey
res' <- ByteString
-> ByteString -> EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall oldPassPhrase newPassPhrase.
(ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
oldPassPhrase
-> newPassPhrase
-> EncryptedKey
-> IO (Either XPrvError EncryptedKey)
encryptedChangePass ByteString
testPass ByteString
newPass EncryptedKey
key
        case Either XPrvError EncryptedKey
res' of
          Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"changePass failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
          Right EncryptedKey
key' -> EncryptedKey -> ByteString
encryptedPublic EncryptedKey
key ByteString -> ByteString -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` EncryptedKey -> ByteString
encryptedPublic EncryptedKey
key'

  String -> (EncryptedKey -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"encryptedChangePass roundtrip preserves public key" ((EncryptedKey -> Property) -> Spec)
-> (EncryptedKey -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$
    \(EncryptedKey
key :: EncryptedKey) -> PropertyM IO Property -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO Property -> Property)
-> PropertyM IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
      let newPass :: ByteString
newPass = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0xFF
      Either XPrvError EncryptedKey
res1 <- IO (Either XPrvError EncryptedKey)
-> PropertyM IO (Either XPrvError EncryptedKey)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (IO (Either XPrvError EncryptedKey)
 -> PropertyM IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
-> PropertyM IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString -> EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall oldPassPhrase newPassPhrase.
(ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
oldPassPhrase
-> newPassPhrase
-> EncryptedKey
-> IO (Either XPrvError EncryptedKey)
encryptedChangePass ByteString
emptyPass ByteString
newPass EncryptedKey
key
      case Either XPrvError EncryptedKey
res1 of
        Left XPrvError
err -> Property -> PropertyM IO Property
forall a. a -> PropertyM IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> PropertyM IO Property)
-> Property -> PropertyM IO Property
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"changePass failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err) Bool
False
        Right EncryptedKey
key' -> do
          Either XPrvError EncryptedKey
res2 <- IO (Either XPrvError EncryptedKey)
-> PropertyM IO (Either XPrvError EncryptedKey)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (IO (Either XPrvError EncryptedKey)
 -> PropertyM IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
-> PropertyM IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString -> EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall oldPassPhrase newPassPhrase.
(ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
oldPassPhrase
-> newPassPhrase
-> EncryptedKey
-> IO (Either XPrvError EncryptedKey)
encryptedChangePass ByteString
newPass ByteString
emptyPass EncryptedKey
key'
          case Either XPrvError EncryptedKey
res2 of
            Left XPrvError
err -> Property -> PropertyM IO Property
forall a. a -> PropertyM IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> PropertyM IO Property)
-> Property -> PropertyM IO Property
forall a b. (a -> b) -> a -> b
$ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"change back failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err) Bool
False
            Right EncryptedKey
key'' -> Property -> PropertyM IO Property
forall a. a -> PropertyM IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncryptedKey -> ByteString
encryptedPublic EncryptedKey
key ByteString -> ByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EncryptedKey -> ByteString
encryptedPublic EncryptedKey
key'')

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encryptedDerivePrivate and encryptedDerivePublic are consistent" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate ByteString
testSeed ByteString
testPass ByteString
testCC
    case Either XPrvError EncryptedKey
res of
      Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"encryptedCreate failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
      Right EncryptedKey
key -> do
        let pub :: ByteString
pub = EncryptedKey -> ByteString
encryptedPublic EncryptedKey
key
            cc :: ByteString
cc = EncryptedKey -> ByteString
encryptedChainCode EncryptedKey
key
            idx :: DerivationIndex
idx = DerivationIndex
0
        Either XPrvError EncryptedKey
res' <- DerivationScheme
-> EncryptedKey
-> ByteString
-> DerivationIndex
-> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
DerivationScheme
-> EncryptedKey
-> passphrase
-> DerivationIndex
-> IO (Either XPrvError EncryptedKey)
encryptedDerivePrivate DerivationScheme
DerivationScheme2 EncryptedKey
key ByteString
testPass DerivationIndex
idx
        case Either XPrvError EncryptedKey
res' of
          Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"derivePrivate failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
          Right EncryptedKey
child ->
            let (ByteString
derivedPub, ByteString
_) = DerivationScheme
-> (ByteString, ByteString)
-> DerivationIndex
-> (ByteString, ByteString)
encryptedDerivePublic DerivationScheme
DerivationScheme2 (ByteString
pub, ByteString
cc) DerivationIndex
idx
             in EncryptedKey -> ByteString
encryptedPublic EncryptedKey
child ByteString -> ByteString -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` ByteString
derivedPub

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encryptedDerivePublic is consistent for both schemes" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate ByteString
testSeed ByteString
testPass ByteString
testCC
    case Either XPrvError EncryptedKey
res of
      Left XPrvError
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"encryptedCreate failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err
      Right EncryptedKey
key -> do
        let pub :: ByteString
pub = EncryptedKey -> ByteString
encryptedPublic EncryptedKey
key
            cc :: ByteString
cc = EncryptedKey -> ByteString
encryptedChainCode EncryptedKey
key
            (ByteString
pub1, ByteString
_) = DerivationScheme
-> (ByteString, ByteString)
-> DerivationIndex
-> (ByteString, ByteString)
encryptedDerivePublic DerivationScheme
DerivationScheme1 (ByteString
pub, ByteString
cc) DerivationIndex
0
            (ByteString
pub2, ByteString
_) = DerivationScheme
-> (ByteString, ByteString)
-> DerivationIndex
-> (ByteString, ByteString)
encryptedDerivePublic DerivationScheme
DerivationScheme2 (ByteString
pub, ByteString
cc) DerivationIndex
0
        ByteString
pub1 ByteString -> ByteString -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldNotBe` ByteString
pub2

  String -> (EncryptedKey -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"encryptedKey . unEncryptedKey is identity" ((EncryptedKey -> Property) -> Spec)
-> (EncryptedKey -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$
    \(EncryptedKey
key :: EncryptedKey) ->
      case ByteString -> Either XPrvError EncryptedKey
encryptedKey (EncryptedKey -> ByteString
unEncryptedKey EncryptedKey
key) of
        Left XPrvError
err -> String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"re-parse failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ XPrvError -> String
forall a. Show a => a -> String
show XPrvError
err) Bool
False
        Right EncryptedKey
key' -> EncryptedKey -> ByteString
unEncryptedKey EncryptedKey
key ByteString -> ByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EncryptedKey -> ByteString
unEncryptedKey EncryptedKey
key'

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encryptedCreate with seed too short fails" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate (Int -> Word8 -> ByteString
BS.replicate Int
16 Word8
0x01) ByteString
testPass ByteString
testCC
    Either XPrvError EncryptedKey
res Either XPrvError EncryptedKey
-> Either XPrvError EncryptedKey -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
XPrvInvalidSecretKey

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encryptedCreate with chain code wrong size fails" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    Either XPrvError EncryptedKey
res <- ByteString
-> ByteString -> ByteString -> IO (Either XPrvError EncryptedKey)
forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate ByteString
testSeed ByteString
testPass (Int -> Word8 -> ByteString
BS.replicate Int
16 Word8
0xAB)
    Either XPrvError EncryptedKey
res Either XPrvError EncryptedKey
-> Either XPrvError EncryptedKey -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
XPrvInvalidChainCode