{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Cardano.Crypto.WalletHD.Encrypted
-- Description : Authenticated v2 encrypted root-key envelopes.
--
-- Keys are stored as CBOR-encoded v2 envelopes: a random 32-byte salt
-- and 24-byte nonce, Argon2id-derived 32-byte wrapping key, and the
-- 64-byte extended secret key encrypted with XChaCha20-Poly1305.
-- The public key and chain code are bound as AEAD additional data so
-- they cannot be silently swapped without detection.
--
-- The plaintext secret key is held exclusively in @sodium_malloc@'d memory
-- ('MLockedSizedBytes') which is locked against swapping and is never moved
-- by the GC.  All public operations are in 'IO'; callers must 'mlsbFinalize'
-- any 'MLockedSizedBytes' they receive when done with it.
module Cardano.Crypto.WalletHD.Encrypted (
  -- * Types
  EncryptedKey,
  XPrvFormat (..),
  XPrvError (..),
  Signature (..),
  DerivationScheme (..),
  DerivationIndex,

  -- * Construction & validation
  encryptedCreate,
  encryptedCreateDirectWithTweak,
  encryptedKey,
  unEncryptedKey,
  encryptedKeyFormat,

  -- * Passphrase operations
  encryptedValidatePassphrase,
  encryptedChangePass,

  -- * Signing & derivation
  encryptedSign,
  encryptedDerivePrivate,
  encryptedDerivePublic,

  -- * Accessors
  encryptedPublic,
  encryptedChainCode,
  encryptedKeyMaterial,

  -- * Test helpers
  withFastKdfForTesting,
  withDeterministicRandomnessForTesting,
) where

import Control.DeepSeq
import Control.Exception (bracket, finally, mask, onException)
import Control.Monad (when)
import Data.Bits (shiftR)
import Data.ByteArray (ByteArrayAccess, withByteArray)
import qualified Data.ByteArray as B
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.Coerce (coerce)
import Data.IORef (
  IORef,
  newIORef,
  readIORef,
  writeIORef,
 )
import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr
import System.IO.Unsafe (unsafePerformIO)

import Codec.CBOR.Decoding (
  Decoder,
  decodeBytes,
  decodeListLenOf,
  decodeWord,
 )
import Codec.CBOR.Encoding (
  encodeBytes,
  encodeListLen,
  encodeWord,
 )
import qualified Codec.CBOR.Read as CBOR
import qualified Codec.CBOR.Write as CBOR

import Cardano.Crypto.Libsodium.MLockedBytes (
  MLockedSizedBytes,
  mlsbFinalize,
  mlsbNewZero,
  mlsbUseAsCPtr,
 )

-- ---------------------------------------------------------------------------
-- Key derivation scheme
-- ---------------------------------------------------------------------------

type DerivationIndex = Word32

data DerivationScheme = DerivationScheme1 | DerivationScheme2
  deriving (Int -> DerivationScheme -> ShowS
[DerivationScheme] -> ShowS
DerivationScheme -> String
(Int -> DerivationScheme -> ShowS)
-> (DerivationScheme -> String)
-> ([DerivationScheme] -> ShowS)
-> Show DerivationScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DerivationScheme -> ShowS
showsPrec :: Int -> DerivationScheme -> ShowS
$cshow :: DerivationScheme -> String
show :: DerivationScheme -> String
$cshowList :: [DerivationScheme] -> ShowS
showList :: [DerivationScheme] -> ShowS
Show, DerivationScheme -> DerivationScheme -> Bool
(DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> Eq DerivationScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivationScheme -> DerivationScheme -> Bool
== :: DerivationScheme -> DerivationScheme -> Bool
$c/= :: DerivationScheme -> DerivationScheme -> Bool
/= :: DerivationScheme -> DerivationScheme -> Bool
Eq, Eq DerivationScheme
Eq DerivationScheme =>
(DerivationScheme -> DerivationScheme -> Ordering)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> Bool)
-> (DerivationScheme -> DerivationScheme -> DerivationScheme)
-> (DerivationScheme -> DerivationScheme -> DerivationScheme)
-> Ord DerivationScheme
DerivationScheme -> DerivationScheme -> Bool
DerivationScheme -> DerivationScheme -> Ordering
DerivationScheme -> DerivationScheme -> DerivationScheme
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DerivationScheme -> DerivationScheme -> Ordering
compare :: DerivationScheme -> DerivationScheme -> Ordering
$c< :: DerivationScheme -> DerivationScheme -> Bool
< :: DerivationScheme -> DerivationScheme -> Bool
$c<= :: DerivationScheme -> DerivationScheme -> Bool
<= :: DerivationScheme -> DerivationScheme -> Bool
$c> :: DerivationScheme -> DerivationScheme -> Bool
> :: DerivationScheme -> DerivationScheme -> Bool
$c>= :: DerivationScheme -> DerivationScheme -> Bool
>= :: DerivationScheme -> DerivationScheme -> Bool
$cmax :: DerivationScheme -> DerivationScheme -> DerivationScheme
max :: DerivationScheme -> DerivationScheme -> DerivationScheme
$cmin :: DerivationScheme -> DerivationScheme -> DerivationScheme
min :: DerivationScheme -> DerivationScheme -> DerivationScheme
Ord, Int -> DerivationScheme
DerivationScheme -> Int
DerivationScheme -> [DerivationScheme]
DerivationScheme -> DerivationScheme
DerivationScheme -> DerivationScheme -> [DerivationScheme]
DerivationScheme
-> DerivationScheme -> DerivationScheme -> [DerivationScheme]
(DerivationScheme -> DerivationScheme)
-> (DerivationScheme -> DerivationScheme)
-> (Int -> DerivationScheme)
-> (DerivationScheme -> Int)
-> (DerivationScheme -> [DerivationScheme])
-> (DerivationScheme -> DerivationScheme -> [DerivationScheme])
-> (DerivationScheme -> DerivationScheme -> [DerivationScheme])
-> (DerivationScheme
    -> DerivationScheme -> DerivationScheme -> [DerivationScheme])
-> Enum DerivationScheme
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DerivationScheme -> DerivationScheme
succ :: DerivationScheme -> DerivationScheme
$cpred :: DerivationScheme -> DerivationScheme
pred :: DerivationScheme -> DerivationScheme
$ctoEnum :: Int -> DerivationScheme
toEnum :: Int -> DerivationScheme
$cfromEnum :: DerivationScheme -> Int
fromEnum :: DerivationScheme -> Int
$cenumFrom :: DerivationScheme -> [DerivationScheme]
enumFrom :: DerivationScheme -> [DerivationScheme]
$cenumFromThen :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
enumFromThen :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
$cenumFromTo :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
enumFromTo :: DerivationScheme -> DerivationScheme -> [DerivationScheme]
$cenumFromThenTo :: DerivationScheme
-> DerivationScheme -> DerivationScheme -> [DerivationScheme]
enumFromThenTo :: DerivationScheme
-> DerivationScheme -> DerivationScheme -> [DerivationScheme]
Enum, DerivationScheme
DerivationScheme -> DerivationScheme -> Bounded DerivationScheme
forall a. a -> a -> Bounded a
$cminBound :: DerivationScheme
minBound :: DerivationScheme
$cmaxBound :: DerivationScheme
maxBound :: DerivationScheme
Bounded)

-- ---------------------------------------------------------------------------
-- Size constants
-- ---------------------------------------------------------------------------

legacyKeySize, publicKeySize, ccSize, signatureSize :: Int
legacyKeySize :: Int
legacyKeySize = Int
64
publicKeySize :: Int
publicKeySize = Int
32
ccSize :: Int
ccSize = Int
32
signatureSize :: Int
signatureSize = Int
64

type PublicKey = ByteString
type ChainCode = ByteString
type Salt = ByteString
type Nonce = ByteString
type Ciphertext = ByteString
type AuthenticationTag = ByteString
type AadContext = ByteString

legacyTotalKeySize :: Int
legacyTotalKeySize :: Int
legacyTotalKeySize = Int
legacyKeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
publicKeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ccSize

-- ---------------------------------------------------------------------------
-- V2 envelope constants
-- ---------------------------------------------------------------------------

v2Version, argon2idId, xchacha20poly1305Id :: Word
v2Version :: Word
v2Version = Word
2
argon2idId :: Word
argon2idId = Word
1
xchacha20poly1305Id :: Word
xchacha20poly1305Id = Word
1

-- ---------------------------------------------------------------------------
-- KDF parameters
-- ---------------------------------------------------------------------------

data KdfParams = KdfParams
  { KdfParams -> Word
kdfMemoryKiB :: !Word
  , KdfParams -> Word
kdfTimeCost :: !Word
  , KdfParams -> Word
kdfParallelism :: !Word
  , KdfParams -> Word
kdfOutputLength :: !Word
  }

productionKdfParams, fastTestKdfParams :: KdfParams
productionKdfParams :: KdfParams
productionKdfParams = Word -> Word -> Word -> Word -> KdfParams
KdfParams Word
131072 Word
3 Word
4 Word
32
fastTestKdfParams :: KdfParams
fastTestKdfParams = Word -> Word -> Word -> Word -> KdfParams
KdfParams Word
4096 Word
1 Word
1 Word
32

runtimeKdfParamsRef :: IORef KdfParams
runtimeKdfParamsRef :: IORef KdfParams
runtimeKdfParamsRef = IO (IORef KdfParams) -> IORef KdfParams
forall a. IO a -> a
unsafePerformIO (KdfParams -> IO (IORef KdfParams)
forall a. a -> IO (IORef a)
newIORef KdfParams
productionKdfParams)
{-# NOINLINE runtimeKdfParamsRef #-}

productionArgonMemoryKiB
  , productionArgonTimeCost
  , productionArgonParallelism
  , productionArgonOutputLength ::
    Word
productionArgonMemoryKiB :: Word
productionArgonMemoryKiB = KdfParams -> Word
kdfMemoryKiB KdfParams
productionKdfParams
productionArgonTimeCost :: Word
productionArgonTimeCost = KdfParams -> Word
kdfTimeCost KdfParams
productionKdfParams
productionArgonParallelism :: Word
productionArgonParallelism = KdfParams -> Word
kdfParallelism KdfParams
productionKdfParams
productionArgonOutputLength :: Word
productionArgonOutputLength = KdfParams -> Word
kdfOutputLength KdfParams
productionKdfParams

saltSize, nonceSize, tagSize :: Int
saltSize :: Int
saltSize = Int
32
nonceSize :: Int
nonceSize = Int
24
tagSize :: Int
tagSize = Int
16

-- ---------------------------------------------------------------------------
-- Random-mode override (for testing)
-- ---------------------------------------------------------------------------

data RandomMode = SystemRandom | DeterministicRandom !Word64

randomModeRef :: IORef RandomMode
randomModeRef :: IORef RandomMode
randomModeRef = IO (IORef RandomMode) -> IORef RandomMode
forall a. IO a -> a
unsafePerformIO (RandomMode -> IO (IORef RandomMode)
forall a. a -> IO (IORef a)
newIORef RandomMode
SystemRandom)
{-# NOINLINE randomModeRef #-}

readRuntimeKdfParams :: IO KdfParams
readRuntimeKdfParams :: IO KdfParams
readRuntimeKdfParams = IORef KdfParams -> IO KdfParams
forall a. IORef a -> IO a
readIORef IORef KdfParams
runtimeKdfParamsRef

-- | Reduce Argon2id cost for fast tests while keeping all v2 envelope
-- structure intact.
withFastKdfForTesting :: IO a -> IO a
withFastKdfForTesting :: forall a. IO a -> IO a
withFastKdfForTesting = IO KdfParams -> (KdfParams -> IO ()) -> (KdfParams -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO KdfParams
install KdfParams -> IO ()
restore ((KdfParams -> IO a) -> IO a)
-> (IO a -> KdfParams -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> KdfParams -> IO a
forall a b. a -> b -> a
const
  where
    install :: IO KdfParams
install = do
      KdfParams
original <- IORef KdfParams -> IO KdfParams
forall a. IORef a -> IO a
readIORef IORef KdfParams
runtimeKdfParamsRef
      IORef KdfParams -> KdfParams -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef KdfParams
runtimeKdfParamsRef KdfParams
fastTestKdfParams
      KdfParams -> IO KdfParams
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KdfParams
original
    restore :: KdfParams -> IO ()
restore KdfParams
original = IORef KdfParams -> KdfParams -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef KdfParams
runtimeKdfParamsRef KdfParams
original

-- | Replace system randomness with a deterministic counter for reproducible
-- test output.
withDeterministicRandomnessForTesting :: IO a -> IO a
withDeterministicRandomnessForTesting :: forall a. IO a -> IO a
withDeterministicRandomnessForTesting = IO RandomMode
-> (RandomMode -> IO ()) -> (RandomMode -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO RandomMode
install RandomMode -> IO ()
restore ((RandomMode -> IO a) -> IO a)
-> (IO a -> RandomMode -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> RandomMode -> IO a
forall a b. a -> b -> a
const
  where
    install :: IO RandomMode
install = do
      RandomMode
original <- IORef RandomMode -> IO RandomMode
forall a. IORef a -> IO a
readIORef IORef RandomMode
randomModeRef
      IORef RandomMode -> RandomMode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef RandomMode
randomModeRef (Word64 -> RandomMode
DeterministicRandom Word64
0)
      RandomMode -> IO RandomMode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RandomMode
original
    restore :: RandomMode -> IO ()
restore RandomMode
original = IORef RandomMode -> RandomMode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef RandomMode
randomModeRef RandomMode
original

-- ---------------------------------------------------------------------------
-- Public types
-- ---------------------------------------------------------------------------

newtype Signature = Signature ByteString
  deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Signature -> ()
(Signature -> ()) -> NFData Signature
forall a. (a -> ()) -> NFData a
$crnf :: Signature -> ()
rnf :: Signature -> ()
NFData, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show)

data XPrvFormat = LegacyV1 | EnvelopeV2
  deriving (XPrvFormat -> XPrvFormat -> Bool
(XPrvFormat -> XPrvFormat -> Bool)
-> (XPrvFormat -> XPrvFormat -> Bool) -> Eq XPrvFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPrvFormat -> XPrvFormat -> Bool
== :: XPrvFormat -> XPrvFormat -> Bool
$c/= :: XPrvFormat -> XPrvFormat -> Bool
/= :: XPrvFormat -> XPrvFormat -> Bool
Eq, Int -> XPrvFormat -> ShowS
[XPrvFormat] -> ShowS
XPrvFormat -> String
(Int -> XPrvFormat -> ShowS)
-> (XPrvFormat -> String)
-> ([XPrvFormat] -> ShowS)
-> Show XPrvFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XPrvFormat -> ShowS
showsPrec :: Int -> XPrvFormat -> ShowS
$cshow :: XPrvFormat -> String
show :: XPrvFormat -> String
$cshowList :: [XPrvFormat] -> ShowS
showList :: [XPrvFormat] -> ShowS
Show)

data XPrvError
  = XPrvDecodeError
  | XPrvUnsupportedVersion
  | XPrvUnsupportedKdf
  | XPrvUnsupportedCipher
  | XPrvInvalidKdfParams
  | XPrvInvalidSaltLength
  | XPrvInvalidNonceLength
  | XPrvInvalidTagLength
  | XPrvInvalidCiphertextLength
  | XPrvAuthenticationFailed
  | XPrvInvalidSecretKey
  | XPrvInvalidPublicKey
  | XPrvInvalidChainCode
  | XPrvPublicKeyMismatch
  | XPrvInternalError
  deriving (XPrvError -> XPrvError -> Bool
(XPrvError -> XPrvError -> Bool)
-> (XPrvError -> XPrvError -> Bool) -> Eq XPrvError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPrvError -> XPrvError -> Bool
== :: XPrvError -> XPrvError -> Bool
$c/= :: XPrvError -> XPrvError -> Bool
/= :: XPrvError -> XPrvError -> Bool
Eq, Int -> XPrvError -> ShowS
[XPrvError] -> ShowS
XPrvError -> String
(Int -> XPrvError -> ShowS)
-> (XPrvError -> String)
-> ([XPrvError] -> ShowS)
-> Show XPrvError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XPrvError -> ShowS
showsPrec :: Int -> XPrvError -> ShowS
$cshow :: XPrvError -> String
show :: XPrvError -> String
$cshowList :: [XPrvError] -> ShowS
showList :: [XPrvError] -> ShowS
Show)

newtype EncryptedKey = EncryptedKey ByteString
  deriving (Int -> EncryptedKey -> ShowS
[EncryptedKey] -> ShowS
EncryptedKey -> String
(Int -> EncryptedKey -> ShowS)
-> (EncryptedKey -> String)
-> ([EncryptedKey] -> ShowS)
-> Show EncryptedKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncryptedKey -> ShowS
showsPrec :: Int -> EncryptedKey -> ShowS
$cshow :: EncryptedKey -> String
show :: EncryptedKey -> String
$cshowList :: [EncryptedKey] -> ShowS
showList :: [EncryptedKey] -> ShowS
Show, EncryptedKey -> EncryptedKey -> Bool
(EncryptedKey -> EncryptedKey -> Bool)
-> (EncryptedKey -> EncryptedKey -> Bool) -> Eq EncryptedKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncryptedKey -> EncryptedKey -> Bool
== :: EncryptedKey -> EncryptedKey -> Bool
$c/= :: EncryptedKey -> EncryptedKey -> Bool
/= :: EncryptedKey -> EncryptedKey -> Bool
Eq, EncryptedKey -> ()
(EncryptedKey -> ()) -> NFData EncryptedKey
forall a. (a -> ()) -> NFData a
$crnf :: EncryptedKey -> ()
rnf :: EncryptedKey -> ()
NFData, EncryptedKey -> Int
(EncryptedKey -> Int)
-> (forall p a. EncryptedKey -> (Ptr p -> IO a) -> IO a)
-> (forall p. EncryptedKey -> Ptr p -> IO ())
-> ByteArrayAccess EncryptedKey
forall p. EncryptedKey -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. EncryptedKey -> (Ptr p -> IO a) -> IO a
$clength :: EncryptedKey -> Int
length :: EncryptedKey -> Int
$cwithByteArray :: forall p a. EncryptedKey -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. EncryptedKey -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. EncryptedKey -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. EncryptedKey -> Ptr p -> IO ()
ByteArrayAccess)

-- ---------------------------------------------------------------------------
-- V2 envelope data
-- ---------------------------------------------------------------------------

data V2Envelope = V2Envelope
  { V2Envelope -> ByteString
v2Salt :: !Salt
  , V2Envelope -> ByteString
v2Nonce :: !Nonce
  , V2Envelope -> ByteString
v2PublicKey :: !PublicKey
  , V2Envelope -> ByteString
v2ChainCode :: !ChainCode
  , V2Envelope -> ByteString
v2Ciphertext :: !Ciphertext
  , V2Envelope -> ByteString
v2Tag :: !AuthenticationTag
  }
  deriving (V2Envelope -> V2Envelope -> Bool
(V2Envelope -> V2Envelope -> Bool)
-> (V2Envelope -> V2Envelope -> Bool) -> Eq V2Envelope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: V2Envelope -> V2Envelope -> Bool
== :: V2Envelope -> V2Envelope -> Bool
$c/= :: V2Envelope -> V2Envelope -> Bool
/= :: V2Envelope -> V2Envelope -> Bool
Eq, Int -> V2Envelope -> ShowS
[V2Envelope] -> ShowS
V2Envelope -> String
(Int -> V2Envelope -> ShowS)
-> (V2Envelope -> String)
-> ([V2Envelope] -> ShowS)
-> Show V2Envelope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> V2Envelope -> ShowS
showsPrec :: Int -> V2Envelope -> ShowS
$cshow :: V2Envelope -> String
show :: V2Envelope -> String
$cshowList :: [V2Envelope] -> ShowS
showList :: [V2Envelope] -> ShowS
Show)

-- | Key material with the secret key in @sodium_malloc@'d locked memory.
-- The caller who receives a 'KeyMaterial' from a 'decryptKeyMaterial'-style
-- call is responsible for calling 'mlsbFinalize' on 'kmSecretKey' when done.
data KeyMaterial = KeyMaterial
  { KeyMaterial -> MLockedSizedBytes 64
kmSecretKey :: !(MLockedSizedBytes 64)
  , KeyMaterial -> ByteString
kmPublicKey :: !PublicKey
  , KeyMaterial -> ByteString
kmChainCode :: !ChainCode
  }

-- FFI pointer newtypes
newtype SecretKeyPtr = SecretKeyPtr (Ptr Word8)
newtype MasterKeyPtr = MasterKeyPtr (Ptr Word8)
newtype PublicKeyPtr = PublicKeyPtr (Ptr Word8)
newtype ChainCodePtr = ChainCodePtr (Ptr Word8)
newtype EncryptedKeyPtr = EncryptedKeyPtr (Ptr Word8)
newtype SignaturePtr = SignaturePtr (Ptr Word8)
newtype PassPhrasePtr = PassPhrasePtr (Ptr Word8)
newtype SaltPtr = SaltPtr (Ptr Word8)
newtype NoncePtr = NoncePtr (Ptr Word8)
newtype TagPtr = TagPtr (Ptr Word8)
newtype CiphertextPtr = CiphertextPtr (Ptr Word8)
newtype WrappingKeyPtr = WrappingKeyPtr (Ptr Word8)

type CDerivationScheme = CInt

-- ---------------------------------------------------------------------------
-- Public API
-- ---------------------------------------------------------------------------

encryptedKey :: ByteString -> Either XPrvError EncryptedKey
encryptedKey :: ByteString -> Either XPrvError EncryptedKey
encryptedKey ByteString
bs = ByteString -> EncryptedKey
EncryptedKey ByteString
bs EncryptedKey
-> Either XPrvError () -> Either XPrvError EncryptedKey
forall a b. a -> Either XPrvError b -> Either XPrvError a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Either XPrvError ()
validateSerializedKey ByteString
bs

encryptedKeyFormat :: EncryptedKey -> XPrvFormat
encryptedKeyFormat :: EncryptedKey -> XPrvFormat
encryptedKeyFormat (EncryptedKey ByteString
bs)
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
legacyTotalKeySize = XPrvFormat
LegacyV1
  | Bool
otherwise = XPrvFormat
EnvelopeV2

unEncryptedKey :: EncryptedKey -> ByteString
unEncryptedKey :: EncryptedKey -> ByteString
unEncryptedKey (EncryptedKey ByteString
e) = ByteString
e

encryptedCreate ::
  (ByteArrayAccess passphrase, ByteArrayAccess secret, ByteArrayAccess cc) =>
  secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate :: forall passphrase secret cc.
(ByteArrayAccess passphrase, ByteArrayAccess secret,
 ByteArrayAccess cc) =>
secret -> passphrase -> cc -> IO (Either XPrvError EncryptedKey)
encryptedCreate secret
sec passphrase
pass cc
cc
  | secret -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length secret
sec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 = Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
XPrvInvalidSecretKey)
  | cc -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length cc
cc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ccSize = Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
XPrvInvalidChainCode)
  | Bool
otherwise = do
      Either XPrvError KeyMaterial
emat <- secret -> cc -> IO (Either XPrvError KeyMaterial)
forall secret cc.
(ByteArrayAccess secret, ByteArrayAccess cc) =>
secret -> cc -> IO (Either XPrvError KeyMaterial)
legacyMaterialFromSecret secret
sec cc
cc
      case Either XPrvError KeyMaterial
emat of
        Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
        Right KeyMaterial
mat ->
          IO (Either XPrvError EncryptedKey)
-> IO () -> IO (Either XPrvError EncryptedKey)
forall a b. IO a -> IO b -> IO a
finally (passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass KeyMaterial
mat) (MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
mat))
{-# NOINLINE encryptedCreate #-}

encryptedCreateDirectWithTweak ::
  (ByteArrayAccess passphrase, ByteArrayAccess secret) =>
  secret -> passphrase -> IO (Either XPrvError EncryptedKey)
encryptedCreateDirectWithTweak :: forall passphrase secret.
(ByteArrayAccess passphrase, ByteArrayAccess secret) =>
secret -> passphrase -> IO (Either XPrvError EncryptedKey)
encryptedCreateDirectWithTweak secret
sec passphrase
pass
  | secret -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length secret
sec Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
96 = Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
XPrvInvalidSecretKey)
  | Bool
otherwise = do
      Either XPrvError KeyMaterial
emat <- secret -> IO (Either XPrvError KeyMaterial)
forall secret.
ByteArrayAccess secret =>
secret -> IO (Either XPrvError KeyMaterial)
legacyMaterialFromMasterKey secret
sec
      case Either XPrvError KeyMaterial
emat of
        Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
        Right KeyMaterial
mat ->
          IO (Either XPrvError EncryptedKey)
-> IO () -> IO (Either XPrvError EncryptedKey)
forall a b. IO a -> IO b -> IO a
finally (passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass KeyMaterial
mat) (MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
mat))
{-# NOINLINE encryptedCreateDirectWithTweak #-}

encryptedValidatePassphrase ::
  ByteArrayAccess passphrase =>
  EncryptedKey -> passphrase -> IO (Either XPrvError ())
encryptedValidatePassphrase :: forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError ())
encryptedValidatePassphrase EncryptedKey
ekey passphrase
pass = do
  Either XPrvError KeyMaterial
emat <- EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
decryptKeyMaterial EncryptedKey
ekey passphrase
pass
  case Either XPrvError KeyMaterial
emat of
    Left XPrvError
err -> Either XPrvError () -> IO (Either XPrvError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError ()
forall a b. a -> Either a b
Left XPrvError
err)
    Right KeyMaterial
mat -> do
      MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
mat)
      Either XPrvError () -> IO (Either XPrvError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either XPrvError ()
forall a b. b -> Either a b
Right ())

encryptedChangePass ::
  (ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
  oldPassPhrase -> newPassPhrase -> EncryptedKey -> IO (Either XPrvError EncryptedKey)
encryptedChangePass :: forall oldPassPhrase newPassPhrase.
(ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
oldPassPhrase
-> newPassPhrase
-> EncryptedKey
-> IO (Either XPrvError EncryptedKey)
encryptedChangePass oldPassPhrase
oldPass newPassPhrase
newPass EncryptedKey
ekey =
  ((forall a. IO a -> IO a) -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (Either XPrvError EncryptedKey))
 -> IO (Either XPrvError EncryptedKey))
-> ((forall a. IO a -> IO a) -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    Either XPrvError KeyMaterial
emat <- IO (Either XPrvError KeyMaterial)
-> IO (Either XPrvError KeyMaterial)
forall a. IO a -> IO a
restore (EncryptedKey -> oldPassPhrase -> IO (Either XPrvError KeyMaterial)
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
decryptKeyMaterial EncryptedKey
ekey oldPassPhrase
oldPass)
    case Either XPrvError KeyMaterial
emat of
      Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
      Right KeyMaterial
mat ->
        IO (Either XPrvError EncryptedKey)
-> IO (Either XPrvError EncryptedKey)
forall a. IO a -> IO a
restore (newPassPhrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial newPassPhrase
newPass KeyMaterial
mat) IO (Either XPrvError EncryptedKey)
-> IO () -> IO (Either XPrvError EncryptedKey)
forall a b. IO a -> IO b -> IO a
`finally` MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
mat)

encryptedSign ::
  (ByteArrayAccess passphrase, ByteArrayAccess msg) =>
  EncryptedKey -> passphrase -> msg -> IO (Either XPrvError Signature)
encryptedSign :: forall passphrase msg.
(ByteArrayAccess passphrase, ByteArrayAccess msg) =>
EncryptedKey
-> passphrase -> msg -> IO (Either XPrvError Signature)
encryptedSign EncryptedKey
ekey passphrase
pass msg
msg =
  ((forall a. IO a -> IO a) -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (Either XPrvError Signature))
 -> IO (Either XPrvError Signature))
-> ((forall a. IO a -> IO a) -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    Either XPrvError KeyMaterial
emat <- IO (Either XPrvError KeyMaterial)
-> IO (Either XPrvError KeyMaterial)
forall a. IO a -> IO a
restore (EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
decryptKeyMaterial EncryptedKey
ekey passphrase
pass)
    case Either XPrvError KeyMaterial
emat of
      Left XPrvError
err -> Either XPrvError Signature -> IO (Either XPrvError Signature)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError Signature
forall a b. a -> Either a b
Left XPrvError
err)
      Right KeyMaterial
mat ->
        IO (Either XPrvError Signature) -> IO (Either XPrvError Signature)
forall a. IO a -> IO a
restore
          ( KeyMaterial
-> (Ptr Word8 -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall r. KeyMaterial -> (Ptr Word8 -> IO r) -> IO r
withLegacyStruct KeyMaterial
mat ((Ptr Word8 -> IO (Either XPrvError Signature))
 -> IO (Either XPrvError Signature))
-> (Ptr Word8 -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
legPtr -> do
              (CDerivationScheme
status, ByteString
sig) <-
                Int
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ByteString)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ByteString)
B.allocRet Int
signatureSize ((Ptr Any -> IO CDerivationScheme)
 -> IO (CDerivationScheme, ByteString))
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Any
outSig ->
                  msg -> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. msg -> (Ptr p -> IO a) -> IO a
withByteArray msg
msg ((Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
msgPtr ->
                    EncryptedKeyPtr
-> Ptr Word8
-> DerivationIndex
-> SignaturePtr
-> IO CDerivationScheme
wallet_encrypted_sign
                      (Ptr Word8 -> EncryptedKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
legPtr)
                      Ptr Word8
msgPtr
                      (Int -> DerivationIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DerivationIndex) -> Int -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ msg -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length msg
msg)
                      (Ptr Any -> SignaturePtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
outSig)
              Either XPrvError Signature -> IO (Either XPrvError Signature)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0 then XPrvError -> Either XPrvError Signature
forall a b. a -> Either a b
Left XPrvError
XPrvInternalError else Signature -> Either XPrvError Signature
forall a b. b -> Either a b
Right (ByteString -> Signature
Signature ByteString
sig))
          )
          IO (Either XPrvError Signature)
-> IO () -> IO (Either XPrvError Signature)
forall a b. IO a -> IO b -> IO a
`finally` MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
mat)

encryptedDerivePrivate ::
  ByteArrayAccess passphrase =>
  DerivationScheme ->
  EncryptedKey ->
  passphrase ->
  DerivationIndex ->
  IO (Either XPrvError EncryptedKey)
encryptedDerivePrivate :: forall passphrase.
ByteArrayAccess passphrase =>
DerivationScheme
-> EncryptedKey
-> passphrase
-> DerivationIndex
-> IO (Either XPrvError EncryptedKey)
encryptedDerivePrivate DerivationScheme
dscheme EncryptedKey
ekey passphrase
pass DerivationIndex
childIndex =
  ((forall a. IO a -> IO a) -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO (Either XPrvError EncryptedKey))
 -> IO (Either XPrvError EncryptedKey))
-> ((forall a. IO a -> IO a) -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    Either XPrvError KeyMaterial
emat <- IO (Either XPrvError KeyMaterial)
-> IO (Either XPrvError KeyMaterial)
forall a. IO a -> IO a
restore (EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
decryptKeyMaterial EncryptedKey
ekey passphrase
pass)
    case Either XPrvError KeyMaterial
emat of
      Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
      Right KeyMaterial
parentMat ->
        ( do
            Either XPrvError KeyMaterial
echildMat <- IO (Either XPrvError KeyMaterial)
-> IO (Either XPrvError KeyMaterial)
forall a. IO a -> IO a
restore (DerivationScheme
-> KeyMaterial
-> DerivationIndex
-> IO (Either XPrvError KeyMaterial)
legacyDerivePrivate DerivationScheme
dscheme KeyMaterial
parentMat DerivationIndex
childIndex)
            case Either XPrvError KeyMaterial
echildMat of
              Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
              Right KeyMaterial
childMat ->
                IO (Either XPrvError EncryptedKey)
-> IO (Either XPrvError EncryptedKey)
forall a. IO a -> IO a
restore (passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass KeyMaterial
childMat) IO (Either XPrvError EncryptedKey)
-> IO () -> IO (Either XPrvError EncryptedKey)
forall a b. IO a -> IO b -> IO a
`finally` MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
childMat)
        )
          IO (Either XPrvError EncryptedKey)
-> IO () -> IO (Either XPrvError EncryptedKey)
forall a b. IO a -> IO b -> IO a
`finally` MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
parentMat)

encryptedDerivePublic ::
  DerivationScheme ->
  (PublicKey, ChainCode) ->
  DerivationIndex ->
  (PublicKey, ChainCode)
encryptedDerivePublic :: DerivationScheme
-> (ByteString, ByteString)
-> DerivationIndex
-> (ByteString, ByteString)
encryptedDerivePublic DerivationScheme
dscheme (ByteString
pub, ByteString
cc) DerivationIndex
childIndex
  | DerivationIndex
childIndex DerivationIndex -> DerivationIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= DerivationIndex
0x80000000 =
      String -> (ByteString, ByteString)
forall a. HasCallStack => String -> a
error String
"encryptedDerivePublic: cannot derive hardened key from public key"
  | Bool
otherwise = IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ do
      (ByteString
newCC, ByteString
newPub) <-
        Int -> (Ptr Any -> IO ByteString) -> IO (ByteString, ByteString)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ByteString)
B.allocRet Int
publicKeySize ((Ptr Any -> IO ByteString) -> IO (ByteString, ByteString))
-> (Ptr Any -> IO ByteString) -> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Any
outPub ->
          Int -> (Ptr Any -> IO ()) -> IO ByteString
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
ccSize ((Ptr Any -> IO ()) -> IO ByteString)
-> (Ptr Any -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Any
outCc ->
            ByteString -> (Ptr Any -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray ByteString
pub ((Ptr Any -> IO ()) -> IO ()) -> (Ptr Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ppub ->
              ByteString -> (Ptr Any -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray ByteString
cc ((Ptr Any -> IO ()) -> IO ()) -> (Ptr Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Any
pcc -> do
                CDerivationScheme
r <-
                  PublicKeyPtr
-> ChainCodePtr
-> DerivationIndex
-> PublicKeyPtr
-> ChainCodePtr
-> CDerivationScheme
-> IO CDerivationScheme
wallet_encrypted_derive_public
                    (Ptr Any -> PublicKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
ppub)
                    (Ptr Any -> ChainCodePtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
pcc)
                    DerivationIndex
childIndex
                    (Ptr Any -> PublicKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
outPub)
                    (Ptr Any -> ChainCodePtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
outCc)
                    (DerivationScheme -> CDerivationScheme
dschemeToC DerivationScheme
dscheme)
                if CDerivationScheme
r CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
                  then String -> IO ()
forall a. HasCallStack => String -> a
error String
"encryptedDerivePublic: hardened index check failed"
                  else () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (ByteString, ByteString) -> IO (ByteString, ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
newPub, ByteString
newCC)

encryptedPublic :: EncryptedKey -> ByteString
encryptedPublic :: EncryptedKey -> ByteString
encryptedPublic (EncryptedKey ByteString
ekey) =
  case EncryptedKey -> XPrvFormat
encryptedKeyFormat (ByteString -> EncryptedKey
EncryptedKey ByteString
ekey) of
    XPrvFormat
LegacyV1 -> Int -> Int -> ByteString -> ByteString
forall c. ByteArray c => Int -> Int -> c -> c
sub Int
legacyKeySize Int
publicKeySize ByteString
ekey
    XPrvFormat
EnvelopeV2 -> (XPrvError -> ByteString)
-> (V2Envelope -> ByteString)
-> Either XPrvError V2Envelope
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> XPrvError -> ByteString
forall a b. a -> b -> a
const ByteString
forall {a}. a
badEnvelope) V2Envelope -> ByteString
v2PublicKey (ByteString -> Either XPrvError V2Envelope
decodeV2Envelope ByteString
ekey)
  where
    badEnvelope :: a
badEnvelope = String -> a
forall a. HasCallStack => String -> a
error String
"encryptedPublic: invalid v2 envelope"

encryptedChainCode :: EncryptedKey -> ByteString
encryptedChainCode :: EncryptedKey -> ByteString
encryptedChainCode (EncryptedKey ByteString
ekey) =
  case EncryptedKey -> XPrvFormat
encryptedKeyFormat (ByteString -> EncryptedKey
EncryptedKey ByteString
ekey) of
    XPrvFormat
LegacyV1 -> Int -> Int -> ByteString -> ByteString
forall c. ByteArray c => Int -> Int -> c -> c
sub (Int
legacyKeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
publicKeySize) Int
ccSize ByteString
ekey
    XPrvFormat
EnvelopeV2 -> (XPrvError -> ByteString)
-> (V2Envelope -> ByteString)
-> Either XPrvError V2Envelope
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> XPrvError -> ByteString
forall a b. a -> b -> a
const ByteString
forall {a}. a
badEnvelope) V2Envelope -> ByteString
v2ChainCode (ByteString -> Either XPrvError V2Envelope
decodeV2Envelope ByteString
ekey)
  where
    badEnvelope :: a
badEnvelope = String -> a
forall a. HasCallStack => String -> a
error String
"encryptedChainCode: invalid v2 envelope"

-- | Decrypt a v2 'EncryptedKey' and return the 64-byte extended ed25519
-- scalar in locked memory.  The caller must 'mlsbFinalize' the result when
-- done with it.
encryptedKeyMaterial ::
  ByteArrayAccess passphrase =>
  EncryptedKey -> passphrase -> IO (Either XPrvError (MLockedSizedBytes 64))
encryptedKeyMaterial :: forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey
-> passphrase -> IO (Either XPrvError (MLockedSizedBytes 64))
encryptedKeyMaterial EncryptedKey
ekey passphrase
pass = do
  Either XPrvError KeyMaterial
emat <- EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
decryptKeyMaterial EncryptedKey
ekey passphrase
pass
  case Either XPrvError KeyMaterial
emat of
    Left XPrvError
err -> Either XPrvError (MLockedSizedBytes 64)
-> IO (Either XPrvError (MLockedSizedBytes 64))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError (MLockedSizedBytes 64)
forall a b. a -> Either a b
Left XPrvError
err)
    Right KeyMaterial
mat -> Either XPrvError (MLockedSizedBytes 64)
-> IO (Either XPrvError (MLockedSizedBytes 64))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MLockedSizedBytes 64 -> Either XPrvError (MLockedSizedBytes 64)
forall a b. b -> Either a b
Right (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
mat))

-- ---------------------------------------------------------------------------
-- Internal: serialization validation
-- ---------------------------------------------------------------------------

validateSerializedKey :: ByteString -> Either XPrvError ()
validateSerializedKey :: ByteString -> Either XPrvError ()
validateSerializedKey ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
legacyTotalKeySize = () -> Either XPrvError ()
forall a b. b -> Either a b
Right ()
  | Bool
otherwise = ByteString -> Either XPrvError V2Envelope
decodeV2Envelope ByteString
bs Either XPrvError V2Envelope
-> Either XPrvError () -> Either XPrvError ()
forall a b.
Either XPrvError a -> Either XPrvError b -> Either XPrvError b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either XPrvError ()
forall a. a -> Either XPrvError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- ---------------------------------------------------------------------------
-- Internal: CBOR V2 envelope codec
-- ---------------------------------------------------------------------------

decodeV2Envelope :: ByteString -> Either XPrvError V2Envelope
decodeV2Envelope :: ByteString -> Either XPrvError V2Envelope
decodeV2Envelope ByteString
bs =
  case (forall s. Decoder s V2Envelope)
-> ByteString -> Either DeserialiseFailure (ByteString, V2Envelope)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes Decoder s V2Envelope
forall s. Decoder s V2Envelope
decodeEnvelope (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
    Right (ByteString
rest, V2Envelope
envelope)
      | ByteString -> Bool
BL.null ByteString
rest -> V2Envelope -> Either XPrvError V2Envelope
forall a b. b -> Either a b
Right V2Envelope
envelope
    Either DeserialiseFailure (ByteString, V2Envelope)
_ -> XPrvError -> Either XPrvError V2Envelope
forall a b. a -> Either a b
Left XPrvError
XPrvDecodeError

decodeEnvelope :: Decoder s V2Envelope
decodeEnvelope :: forall s. Decoder s V2Envelope
decodeEnvelope = do
  Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
9
  Word
version <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
version Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
v2Version) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvUnsupportedVersion)
  Word
kdfId <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
kdfId Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
argon2idId) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvUnsupportedKdf)
  Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
4
  Word
memoryKiB <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Word
timeCost <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Word
parallelism <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Word
outputLength <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( Word
memoryKiB Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonMemoryKiB
        Bool -> Bool -> Bool
|| Word
timeCost Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonTimeCost
        Bool -> Bool -> Bool
|| Word
parallelism Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonParallelism
        Bool -> Bool -> Bool
|| Word
outputLength Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonOutputLength
    )
    (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidKdfParams)
  ByteString
salt <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
salt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
saltSize) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidSaltLength)
  Word
cipherId <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
cipherId Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
xchacha20poly1305Id) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvUnsupportedCipher)
  ByteString
nonce <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
nonce Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nonceSize) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidNonceLength)
  ByteString
aad <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  ByteString
ciphertext <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
ciphertext Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
legacyKeySize) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidCiphertextLength)
  ByteString
tag <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
tagSize) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidTagLength)
  (ByteString
pub, ByteString
cc) <- (XPrvError -> Decoder s (ByteString, ByteString))
-> ((ByteString, ByteString) -> Decoder s (ByteString, ByteString))
-> Either XPrvError (ByteString, ByteString)
-> Decoder s (ByteString, ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either XPrvError -> Decoder s (ByteString, ByteString)
forall s a. XPrvError -> Decoder s a
failDecoder (ByteString, ByteString) -> Decoder s (ByteString, ByteString)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError (ByteString, ByteString)
 -> Decoder s (ByteString, ByteString))
-> Either XPrvError (ByteString, ByteString)
-> Decoder s (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either XPrvError (ByteString, ByteString)
decodeAad ByteString
aad
  V2Envelope -> Decoder s V2Envelope
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (V2Envelope -> Decoder s V2Envelope)
-> V2Envelope -> Decoder s V2Envelope
forall a b. (a -> b) -> a -> b
$
    V2Envelope
      { v2Salt :: ByteString
v2Salt = ByteString
salt
      , v2Nonce :: ByteString
v2Nonce = ByteString
nonce
      , v2PublicKey :: ByteString
v2PublicKey = ByteString
pub
      , v2ChainCode :: ByteString
v2ChainCode = ByteString
cc
      , v2Ciphertext :: ByteString
v2Ciphertext = ByteString
ciphertext
      , v2Tag :: ByteString
v2Tag = ByteString
tag
      }

encodeV2Envelope :: V2Envelope -> ByteString
encodeV2Envelope :: V2Envelope -> ByteString
encodeV2Envelope V2Envelope
envelope =
  Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
9
      , Word -> Encoding
encodeWord Word
v2Version
      , Word -> Encoding
encodeWord Word
argon2idId
      , Word -> Encoding
encodeListLen Word
4
      , Word -> Encoding
encodeWord Word
productionArgonMemoryKiB
      , Word -> Encoding
encodeWord Word
productionArgonTimeCost
      , Word -> Encoding
encodeWord Word
productionArgonParallelism
      , Word -> Encoding
encodeWord Word
productionArgonOutputLength
      , ByteString -> Encoding
encodeBytes (V2Envelope -> ByteString
v2Salt V2Envelope
envelope)
      , Word -> Encoding
encodeWord Word
xchacha20poly1305Id
      , ByteString -> Encoding
encodeBytes (V2Envelope -> ByteString
v2Nonce V2Envelope
envelope)
      , ByteString -> Encoding
encodeBytes (ByteString -> ByteString -> ByteString
encodeAad (V2Envelope -> ByteString
v2PublicKey V2Envelope
envelope) (V2Envelope -> ByteString
v2ChainCode V2Envelope
envelope))
      , ByteString -> Encoding
encodeBytes (V2Envelope -> ByteString
v2Ciphertext V2Envelope
envelope)
      , ByteString -> Encoding
encodeBytes (V2Envelope -> ByteString
v2Tag V2Envelope
envelope)
      ]

encodeAad :: PublicKey -> ChainCode -> AadContext
encodeAad :: ByteString -> ByteString -> ByteString
encodeAad ByteString
pub ByteString
cc =
  Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
8
      , Word -> Encoding
encodeWord Word
v2Version
      , Word -> Encoding
encodeWord Word
argon2idId
      , Word -> Encoding
encodeListLen Word
4
      , Word -> Encoding
encodeWord Word
productionArgonMemoryKiB
      , Word -> Encoding
encodeWord Word
productionArgonTimeCost
      , Word -> Encoding
encodeWord Word
productionArgonParallelism
      , Word -> Encoding
encodeWord Word
productionArgonOutputLength
      , Word -> Encoding
encodeWord Word
xchacha20poly1305Id
      , Word -> Encoding
encodeWord Word
1
      , Word -> Encoding
encodeWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
legacyKeySize)
      , ByteString -> Encoding
encodeBytes ByteString
pub
      , ByteString -> Encoding
encodeBytes ByteString
cc
      ]

decodeAad :: AadContext -> Either XPrvError (PublicKey, ChainCode)
decodeAad :: ByteString -> Either XPrvError (ByteString, ByteString)
decodeAad ByteString
bs =
  case (forall s. Decoder s (ByteString, ByteString))
-> ByteString
-> Either DeserialiseFailure (ByteString, (ByteString, ByteString))
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes Decoder s (ByteString, ByteString)
forall s. Decoder s (ByteString, ByteString)
decodeAadFields (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
    Right (ByteString
rest, (ByteString, ByteString)
result)
      | ByteString -> Bool
BL.null ByteString
rest -> (ByteString, ByteString)
-> Either XPrvError (ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString, ByteString)
result
    Either DeserialiseFailure (ByteString, (ByteString, ByteString))
_ -> XPrvError -> Either XPrvError (ByteString, ByteString)
forall a b. a -> Either a b
Left XPrvError
XPrvDecodeError

decodeAadFields :: Decoder s (PublicKey, ChainCode)
decodeAadFields :: forall s. Decoder s (ByteString, ByteString)
decodeAadFields = do
  Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
8
  Word
version <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
version Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
v2Version) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvUnsupportedVersion)
  Word
kdfId <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
kdfId Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
argon2idId) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvUnsupportedKdf)
  Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
4
  Word
memoryKiB <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Word
timeCost <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Word
parallelism <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Word
outputLength <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( Word
memoryKiB Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonMemoryKiB
        Bool -> Bool -> Bool
|| Word
timeCost Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonTimeCost
        Bool -> Bool -> Bool
|| Word
parallelism Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonParallelism
        Bool -> Bool -> Bool
|| Word
outputLength Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
productionArgonOutputLength
    )
    (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidKdfParams)
  Word
cipherId <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
cipherId Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
xchacha20poly1305Id) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvUnsupportedCipher)
  Word
payloadKind <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
payloadKind Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
1) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvDecodeError)
  Word
payloadLen <- Decoder s Word
forall s. Decoder s Word
decodeWord
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
payloadLen Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
legacyKeySize) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidCiphertextLength)
  ByteString
pub <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  ByteString
cc <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
pub Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
publicKeySize) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidPublicKey)
  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
cc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ccSize) (XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidChainCode)
  (ByteString, ByteString) -> Decoder s (ByteString, ByteString)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
pub, ByteString
cc)

-- ---------------------------------------------------------------------------
-- Internal: v2 encrypt / decrypt
-- ---------------------------------------------------------------------------

decryptKeyMaterial ::
  ByteArrayAccess passphrase =>
  EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
decryptKeyMaterial :: forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
decryptKeyMaterial EncryptedKey
ekey passphrase
pass =
  case EncryptedKey -> XPrvFormat
encryptedKeyFormat EncryptedKey
ekey of
    XPrvFormat
LegacyV1 -> Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError KeyMaterial
forall a b. a -> Either a b
Left XPrvError
XPrvDecodeError)
    XPrvFormat
EnvelopeV2 -> EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
v2Decrypt EncryptedKey
ekey passphrase
pass

v2Decrypt ::
  ByteArrayAccess passphrase =>
  EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
v2Decrypt :: forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError KeyMaterial)
v2Decrypt (EncryptedKey ByteString
bs) passphrase
pass =
  case ByteString -> Either XPrvError V2Envelope
decodeV2Envelope ByteString
bs of
    Left XPrvError
err -> Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError KeyMaterial
forall a b. a -> Either a b
Left XPrvError
err)
    Right V2Envelope
envelope -> do
      Either XPrvError ScrubbedBytes
eWrappingKey <- passphrase -> ByteString -> IO (Either XPrvError ScrubbedBytes)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> ByteString -> IO (Either XPrvError ScrubbedBytes)
deriveWrappingKey passphrase
pass (V2Envelope -> ByteString
v2Salt V2Envelope
envelope)
      case Either XPrvError ScrubbedBytes
eWrappingKey of
        Left XPrvError
err -> Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError KeyMaterial
forall a b. a -> Either a b
Left XPrvError
err)
        Right ScrubbedBytes
wrappingKey -> do
          let aad :: ByteString
aad = ByteString -> ByteString -> ByteString
encodeAad (V2Envelope -> ByteString
v2PublicKey V2Envelope
envelope) (V2Envelope -> ByteString
v2ChainCode V2Envelope
envelope)
          MLockedSizedBytes 64
ptextMlsb <- (IO (MLockedSizedBytes 64)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
m (MLockedSizedBytes n)
mlsbNewZero :: IO (MLockedSizedBytes 64))
          CDerivationScheme
status <-
            MLockedSizedBytes 64
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes 64
ptextMlsb ((Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptextPtr ->
              ByteString
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray (V2Envelope -> ByteString
v2Ciphertext V2Envelope
envelope) ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ct ->
                ByteString
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray (V2Envelope -> ByteString
v2Tag V2Envelope
envelope) ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
tg ->
                  ByteString
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray ByteString
aad ((Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ad ->
                    ByteString
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray (V2Envelope -> ByteString
v2Nonce V2Envelope
envelope) ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
np ->
                      ScrubbedBytes
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
wrappingKey ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
kp ->
                        SecretKeyPtr
-> CiphertextPtr
-> CULLong
-> TagPtr
-> Ptr Word8
-> CULLong
-> NoncePtr
-> WrappingKeyPtr
-> IO CDerivationScheme
wallet_sodium_xchacha20poly1305_decrypt
                          (Ptr Word8 -> SecretKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
ptextPtr)
                          (Ptr Any -> CiphertextPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
ct)
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length (V2Envelope -> ByteString
v2Ciphertext V2Envelope
envelope))
                          (Ptr Any -> TagPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
tg)
                          Ptr Word8
ad
                          (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
aad)
                          (Ptr Any -> NoncePtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
np)
                          (Ptr Any -> WrappingKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
kp)
          if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
            then do
              MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize MLockedSizedBytes 64
ptextMlsb
              Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError KeyMaterial
forall a b. a -> Either a b
Left XPrvError
XPrvAuthenticationFailed)
            else do
              let mat :: KeyMaterial
mat = MLockedSizedBytes 64 -> ByteString -> ByteString -> KeyMaterial
KeyMaterial MLockedSizedBytes 64
ptextMlsb (V2Envelope -> ByteString
v2PublicKey V2Envelope
envelope) (V2Envelope -> ByteString
v2ChainCode V2Envelope
envelope)
              Either XPrvError ()
eVal <- KeyMaterial -> IO (Either XPrvError ())
validateKeyMaterial KeyMaterial
mat IO (Either XPrvError ()) -> IO () -> IO (Either XPrvError ())
forall a b. IO a -> IO b -> IO a
`onException` MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize MLockedSizedBytes 64
ptextMlsb
              case Either XPrvError ()
eVal of
                Left XPrvError
err -> do
                  MLockedSizedBytes 64 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize MLockedSizedBytes 64
ptextMlsb
                  Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError KeyMaterial
forall a b. a -> Either a b
Left XPrvError
err)
                Right () -> Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMaterial -> Either XPrvError KeyMaterial
forall a b. b -> Either a b
Right KeyMaterial
mat)

wrapKeyMaterial ::
  ByteArrayAccess passphrase =>
  passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial :: forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> KeyMaterial -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass KeyMaterial
material = do
  Either XPrvError ()
eVal <- KeyMaterial -> IO (Either XPrvError ())
validateKeyMaterial KeyMaterial
material
  case Either XPrvError ()
eVal of
    Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
    Right () -> do
      Either XPrvError ByteString
eSalt <- Int -> IO (Either XPrvError ByteString)
randomBytesIO Int
saltSize
      Either XPrvError ByteString
eNonce <- Int -> IO (Either XPrvError ByteString)
randomBytesIO Int
nonceSize
      case (,) (ByteString -> ByteString -> (ByteString, ByteString))
-> Either XPrvError ByteString
-> Either XPrvError (ByteString -> (ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either XPrvError ByteString
eSalt Either XPrvError (ByteString -> (ByteString, ByteString))
-> Either XPrvError ByteString
-> Either XPrvError (ByteString, ByteString)
forall a b.
Either XPrvError (a -> b)
-> Either XPrvError a -> Either XPrvError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either XPrvError ByteString
eNonce of
        Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
        Right (ByteString
salt, ByteString
nonce) -> do
          Either XPrvError ScrubbedBytes
eWrappingKey <- passphrase -> ByteString -> IO (Either XPrvError ScrubbedBytes)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> ByteString -> IO (Either XPrvError ScrubbedBytes)
deriveWrappingKey passphrase
pass ByteString
salt
          case Either XPrvError ScrubbedBytes
eWrappingKey of
            Left XPrvError
err -> Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
err)
            Right ScrubbedBytes
wrappingKey -> do
              let aad :: ByteString
aad = ByteString -> ByteString -> ByteString
encodeAad (KeyMaterial -> ByteString
kmPublicKey KeyMaterial
material) (KeyMaterial -> ByteString
kmChainCode KeyMaterial
material)
              MLockedSizedBytes 64
-> (Ptr Word8 -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
material) ((Ptr Word8 -> IO (Either XPrvError EncryptedKey))
 -> IO (Either XPrvError EncryptedKey))
-> (Ptr Word8 -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
skPtr -> do
                ((CDerivationScheme
status, ByteString
tag), ByteString
ciphertext) <-
                  Int
-> (Ptr Any -> IO (CDerivationScheme, ByteString))
-> IO ((CDerivationScheme, ByteString), ByteString)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ByteString)
B.allocRet Int
legacyKeySize ((Ptr Any -> IO (CDerivationScheme, ByteString))
 -> IO ((CDerivationScheme, ByteString), ByteString))
-> (Ptr Any -> IO (CDerivationScheme, ByteString))
-> IO ((CDerivationScheme, ByteString), ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Any
outCipher ->
                    Int
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ByteString)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ByteString)
B.allocRet Int
tagSize ((Ptr Any -> IO CDerivationScheme)
 -> IO (CDerivationScheme, ByteString))
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Any
outTag ->
                      ByteString
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray ByteString
aad ((Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ad ->
                        ByteString
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray ByteString
nonce ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
np ->
                          ScrubbedBytes
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
withByteArray ScrubbedBytes
wrappingKey ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
kp ->
                            CiphertextPtr
-> TagPtr
-> SecretKeyPtr
-> CULLong
-> Ptr Word8
-> CULLong
-> NoncePtr
-> WrappingKeyPtr
-> IO CDerivationScheme
wallet_sodium_xchacha20poly1305_encrypt
                              (Ptr Any -> CiphertextPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
outCipher)
                              (Ptr Any -> TagPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
outTag)
                              (Ptr Word8 -> SecretKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
skPtr)
                              (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
legacyKeySize)
                              Ptr Word8
ad
                              (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
aad)
                              (Ptr Any -> NoncePtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
np)
                              (Ptr Any -> WrappingKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
kp)
                if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
                  then Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError EncryptedKey
forall a b. a -> Either a b
Left XPrvError
XPrvInternalError)
                  else
                    Either XPrvError EncryptedKey -> IO (Either XPrvError EncryptedKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError EncryptedKey
 -> IO (Either XPrvError EncryptedKey))
-> Either XPrvError EncryptedKey
-> IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$
                      EncryptedKey -> Either XPrvError EncryptedKey
forall a b. b -> Either a b
Right (EncryptedKey -> Either XPrvError EncryptedKey)
-> EncryptedKey -> Either XPrvError EncryptedKey
forall a b. (a -> b) -> a -> b
$
                        ByteString -> EncryptedKey
EncryptedKey (ByteString -> EncryptedKey) -> ByteString -> EncryptedKey
forall a b. (a -> b) -> a -> b
$
                          V2Envelope -> ByteString
encodeV2Envelope (V2Envelope -> ByteString) -> V2Envelope -> ByteString
forall a b. (a -> b) -> a -> b
$
                            ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> V2Envelope
V2Envelope ByteString
salt ByteString
nonce (KeyMaterial -> ByteString
kmPublicKey KeyMaterial
material) (KeyMaterial -> ByteString
kmChainCode KeyMaterial
material) ByteString
ciphertext ByteString
tag

validateKeyMaterial :: KeyMaterial -> IO (Either XPrvError ())
validateKeyMaterial :: KeyMaterial -> IO (Either XPrvError ())
validateKeyMaterial KeyMaterial
mat =
  KeyMaterial
-> (Ptr Word8 -> IO (Either XPrvError ()))
-> IO (Either XPrvError ())
forall r. KeyMaterial -> (Ptr Word8 -> IO r) -> IO r
withLegacyStruct KeyMaterial
mat ((Ptr Word8 -> IO (Either XPrvError ()))
 -> IO (Either XPrvError ()))
-> (Ptr Word8 -> IO (Either XPrvError ()))
-> IO (Either XPrvError ())
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
inPtr ->
    IO (MLockedSizedBytes 128)
-> (MLockedSizedBytes 128 -> IO ())
-> (MLockedSizedBytes 128 -> IO (Either XPrvError ()))
-> IO (Either XPrvError ())
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO (MLockedSizedBytes 128)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
m (MLockedSizedBytes n)
mlsbNewZero :: IO (MLockedSizedBytes 128)) MLockedSizedBytes 128 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize ((MLockedSizedBytes 128 -> IO (Either XPrvError ()))
 -> IO (Either XPrvError ()))
-> (MLockedSizedBytes 128 -> IO (Either XPrvError ()))
-> IO (Either XPrvError ())
forall a b. (a -> b) -> a -> b
$ \MLockedSizedBytes 128
outMlsb -> do
      CDerivationScheme
r <-
        MLockedSizedBytes 128
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes 128
outMlsb ((Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr ->
          EncryptedKeyPtr -> EncryptedKeyPtr -> IO CDerivationScheme
wallet_encrypted_decrypt (Ptr Word8 -> EncryptedKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
inPtr) (Ptr Word8 -> EncryptedKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
outPtr)
      Either XPrvError () -> IO (Either XPrvError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if CDerivationScheme
r CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0 then XPrvError -> Either XPrvError ()
forall a b. a -> Either a b
Left XPrvError
XPrvPublicKeyMismatch else () -> Either XPrvError ()
forall a b. b -> Either a b
Right ())

-- ---------------------------------------------------------------------------
-- Internal: locked memory helpers
-- ---------------------------------------------------------------------------

-- | Build a temporary 128-byte locked buffer (ekey || pkey || cc) from
-- 'KeyMaterial' and pass a pointer to it to the action.  The buffer is zeroed
-- and freed when the action returns (normally or via exception).
withLegacyStruct :: KeyMaterial -> (Ptr Word8 -> IO r) -> IO r
withLegacyStruct :: forall r. KeyMaterial -> (Ptr Word8 -> IO r) -> IO r
withLegacyStruct KeyMaterial
mat Ptr Word8 -> IO r
action =
  IO (MLockedSizedBytes 128)
-> (MLockedSizedBytes 128 -> IO ())
-> (MLockedSizedBytes 128 -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO (MLockedSizedBytes 128)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
m (MLockedSizedBytes n)
mlsbNewZero :: IO (MLockedSizedBytes 128)) MLockedSizedBytes 128 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize ((MLockedSizedBytes 128 -> IO r) -> IO r)
-> (MLockedSizedBytes 128 -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \MLockedSizedBytes 128
mlsb ->
    MLockedSizedBytes 128 -> (Ptr Word8 -> IO r) -> IO r
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes 128
mlsb ((Ptr Word8 -> IO r) -> IO r) -> (Ptr Word8 -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base -> do
      MLockedSizedBytes 64 -> (Ptr Word8 -> IO ()) -> IO ()
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr (KeyMaterial -> MLockedSizedBytes 64
kmSecretKey KeyMaterial
mat) ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
skPtr ->
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
base Ptr Word8
skPtr Int
64
      ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen (KeyMaterial -> ByteString
kmPublicKey KeyMaterial
mat) ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
pkPtr, Int
_) ->
        Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr Word8
base Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (Ptr CChar -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
pkPtr) Int
32
      ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen (KeyMaterial -> ByteString
kmChainCode KeyMaterial
mat) ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ccPtr, Int
_) ->
        Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr Word8
base Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96) (Ptr CChar -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ccPtr) Int
32
      Ptr Word8 -> IO r
action Ptr Word8
base

-- | Call a C function that writes a 128-byte @encrypted_key@ struct to the
-- pointer it receives, then split the result into 'KeyMaterial'.  On failure
-- (non-zero return) returns 'Left onFailure'.  The caller owns the
-- 'MLockedSizedBytes 64' in the returned 'KeyMaterial' and must finalize it.
withEncryptedKeyOutput ::
  XPrvError ->
  (Ptr Word8 -> IO CInt) ->
  IO (Either XPrvError KeyMaterial)
withEncryptedKeyOutput :: XPrvError
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (Either XPrvError KeyMaterial)
withEncryptedKeyOutput XPrvError
onFailure Ptr Word8 -> IO CDerivationScheme
action =
  IO (MLockedSizedBytes 128)
-> (MLockedSizedBytes 128 -> IO ())
-> (MLockedSizedBytes 128 -> IO (Either XPrvError KeyMaterial))
-> IO (Either XPrvError KeyMaterial)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO (MLockedSizedBytes 128)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
m (MLockedSizedBytes n)
mlsbNewZero :: IO (MLockedSizedBytes 128)) MLockedSizedBytes 128 -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize ((MLockedSizedBytes 128 -> IO (Either XPrvError KeyMaterial))
 -> IO (Either XPrvError KeyMaterial))
-> (MLockedSizedBytes 128 -> IO (Either XPrvError KeyMaterial))
-> IO (Either XPrvError KeyMaterial)
forall a b. (a -> b) -> a -> b
$ \MLockedSizedBytes 128
outMlsb -> do
    CDerivationScheme
r <- MLockedSizedBytes 128
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes 128
outMlsb ((Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> Ptr Word8 -> IO CDerivationScheme
action Ptr Word8
ptr
    if CDerivationScheme
r CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
      then Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError KeyMaterial
forall a b. a -> Either a b
Left XPrvError
onFailure)
      else MLockedSizedBytes 128
-> (Ptr Word8 -> IO (Either XPrvError KeyMaterial))
-> IO (Either XPrvError KeyMaterial)
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes 128
outMlsb ((Ptr Word8 -> IO (Either XPrvError KeyMaterial))
 -> IO (Either XPrvError KeyMaterial))
-> (Ptr Word8 -> IO (Either XPrvError KeyMaterial))
-> IO (Either XPrvError KeyMaterial)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base -> do
        MLockedSizedBytes 64
sk <- (IO (MLockedSizedBytes 64)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
m (MLockedSizedBytes n)
mlsbNewZero :: IO (MLockedSizedBytes 64))
        MLockedSizedBytes 64 -> (Ptr Word8 -> IO ()) -> IO ()
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes 64
sk ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
skPtr -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
skPtr Ptr Word8
base Int
64
        ByteString
pub <- CStringLen -> IO ByteString
BS.packCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
base Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64), Int
32)
        ByteString
cc <- CStringLen -> IO ByteString
BS.packCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
base Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96), Int
32)
        Either XPrvError KeyMaterial -> IO (Either XPrvError KeyMaterial)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMaterial -> Either XPrvError KeyMaterial
forall a b. b -> Either a b
Right (MLockedSizedBytes 64 -> ByteString -> ByteString -> KeyMaterial
KeyMaterial MLockedSizedBytes 64
sk ByteString
pub ByteString
cc))

-- ---------------------------------------------------------------------------
-- Internal: key-material construction (using C/ed25519)
-- ---------------------------------------------------------------------------

legacyMaterialFromSecret ::
  (ByteArrayAccess secret, ByteArrayAccess cc) =>
  secret -> cc -> IO (Either XPrvError KeyMaterial)
legacyMaterialFromSecret :: forall secret cc.
(ByteArrayAccess secret, ByteArrayAccess cc) =>
secret -> cc -> IO (Either XPrvError KeyMaterial)
legacyMaterialFromSecret secret
sec cc
cc =
  XPrvError
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (Either XPrvError KeyMaterial)
withEncryptedKeyOutput XPrvError
XPrvInvalidSecretKey ((Ptr Word8 -> IO CDerivationScheme)
 -> IO (Either XPrvError KeyMaterial))
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (Either XPrvError KeyMaterial)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr ->
    secret -> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. secret -> (Ptr p -> IO a) -> IO a
withByteArray secret
sec ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
psec ->
      cc -> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. cc -> (Ptr p -> IO a) -> IO a
withByteArray cc
cc ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
pcc ->
        SecretKeyPtr
-> ChainCodePtr -> EncryptedKeyPtr -> IO CDerivationScheme
wallet_encrypted_from_secret (Ptr Any -> SecretKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
psec) (Ptr Any -> ChainCodePtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
pcc) (Ptr Word8 -> EncryptedKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
outPtr)

legacyMaterialFromMasterKey ::
  ByteArrayAccess secret => secret -> IO (Either XPrvError KeyMaterial)
legacyMaterialFromMasterKey :: forall secret.
ByteArrayAccess secret =>
secret -> IO (Either XPrvError KeyMaterial)
legacyMaterialFromMasterKey secret
sec =
  XPrvError
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (Either XPrvError KeyMaterial)
withEncryptedKeyOutput XPrvError
XPrvInvalidSecretKey ((Ptr Word8 -> IO CDerivationScheme)
 -> IO (Either XPrvError KeyMaterial))
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (Either XPrvError KeyMaterial)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr ->
    secret
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. secret -> (Ptr p -> IO a) -> IO a
withByteArray secret
sec ((Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Word8 -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
psec ->
      MasterKeyPtr -> EncryptedKeyPtr -> IO CDerivationScheme
wallet_encrypted_new_from_mkg (Ptr Word8 -> MasterKeyPtr
MasterKeyPtr Ptr Word8
psec) (Ptr Word8 -> EncryptedKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
outPtr)

legacyDerivePrivate ::
  DerivationScheme -> KeyMaterial -> DerivationIndex -> IO (Either XPrvError KeyMaterial)
legacyDerivePrivate :: DerivationScheme
-> KeyMaterial
-> DerivationIndex
-> IO (Either XPrvError KeyMaterial)
legacyDerivePrivate DerivationScheme
dscheme KeyMaterial
parent DerivationIndex
childIndex =
  KeyMaterial
-> (Ptr Word8 -> IO (Either XPrvError KeyMaterial))
-> IO (Either XPrvError KeyMaterial)
forall r. KeyMaterial -> (Ptr Word8 -> IO r) -> IO r
withLegacyStruct KeyMaterial
parent ((Ptr Word8 -> IO (Either XPrvError KeyMaterial))
 -> IO (Either XPrvError KeyMaterial))
-> (Ptr Word8 -> IO (Either XPrvError KeyMaterial))
-> IO (Either XPrvError KeyMaterial)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
inPtr ->
    XPrvError
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (Either XPrvError KeyMaterial)
withEncryptedKeyOutput XPrvError
XPrvInternalError ((Ptr Word8 -> IO CDerivationScheme)
 -> IO (Either XPrvError KeyMaterial))
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (Either XPrvError KeyMaterial)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr ->
      EncryptedKeyPtr
-> DerivationIndex
-> EncryptedKeyPtr
-> CDerivationScheme
-> IO CDerivationScheme
wallet_encrypted_derive_private
        (Ptr Word8 -> EncryptedKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
inPtr)
        DerivationIndex
childIndex
        (Ptr Word8 -> EncryptedKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Word8
outPtr)
        (DerivationScheme -> CDerivationScheme
dschemeToC DerivationScheme
dscheme)

-- ---------------------------------------------------------------------------
-- Internal: KDF and random bytes
-- ---------------------------------------------------------------------------

deriveWrappingKey ::
  ByteArrayAccess passphrase =>
  passphrase -> ByteString -> IO (Either XPrvError B.ScrubbedBytes)
deriveWrappingKey :: forall passphrase.
ByteArrayAccess passphrase =>
passphrase -> ByteString -> IO (Either XPrvError ScrubbedBytes)
deriveWrappingKey passphrase
pass ByteString
salt
  | ByteString -> Int
BS.length ByteString
salt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
saltSize = Either XPrvError ScrubbedBytes
-> IO (Either XPrvError ScrubbedBytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError ScrubbedBytes
forall a b. a -> Either a b
Left XPrvError
XPrvInvalidSaltLength)
  | Bool
otherwise = do
      KdfParams
params <- IO KdfParams
readRuntimeKdfParams
      let outputLen :: Int
outputLen = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (KdfParams -> Word
kdfOutputLength KdfParams
params)
          memBytes :: Word64
memBytes = Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (KdfParams -> Word
kdfMemoryKiB KdfParams
params) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1024 :: Word64
      (CDerivationScheme
status, ScrubbedBytes
key) <-
        Int
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ScrubbedBytes)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ScrubbedBytes)
B.allocRet Int
outputLen ((Ptr Any -> IO CDerivationScheme)
 -> IO (CDerivationScheme, ScrubbedBytes))
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ScrubbedBytes)
forall a b. (a -> b) -> a -> b
$ \Ptr Any
out ->
          passphrase
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. passphrase -> (Ptr p -> IO a) -> IO a
withByteArray passphrase
pass ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ppass ->
            ByteString
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ByteString -> (Ptr p -> IO a) -> IO a
withByteArray ByteString
salt ((Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (Ptr Any -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \Ptr Any
psalt ->
              WrappingKeyPtr
-> CULLong
-> PassPhrasePtr
-> CULLong
-> SaltPtr
-> CULLong
-> CSize
-> IO CDerivationScheme
wallet_sodium_argon2id
                (Ptr Any -> WrappingKeyPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
out)
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
outputLen)
                (Ptr Any -> PassPhrasePtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
ppass)
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong (Int -> CULLong) -> Int -> CULLong
forall a b. (a -> b) -> a -> b
$ passphrase -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length passphrase
pass)
                (Ptr Any -> SaltPtr
forall a b. Coercible a b => a -> b
coerce Ptr Any
psalt)
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @CULLong (Word -> CULLong) -> Word -> CULLong
forall a b. (a -> b) -> a -> b
$ KdfParams -> Word
kdfTimeCost KdfParams
params)
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @CSize Word64
memBytes)
      Either XPrvError ScrubbedBytes
-> IO (Either XPrvError ScrubbedBytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
== CDerivationScheme
0 then ScrubbedBytes -> Either XPrvError ScrubbedBytes
forall a b. b -> Either a b
Right ScrubbedBytes
key else XPrvError -> Either XPrvError ScrubbedBytes
forall a b. a -> Either a b
Left XPrvError
XPrvInternalError)

randomBytesIO :: Int -> IO (Either XPrvError ByteString)
randomBytesIO :: Int -> IO (Either XPrvError ByteString)
randomBytesIO Int
len = do
  RandomMode
mode <- IORef RandomMode -> IO RandomMode
forall a. IORef a -> IO a
readIORef IORef RandomMode
randomModeRef
  case RandomMode
mode of
    RandomMode
SystemRandom -> do
      (CDerivationScheme
status, ByteString
bytes) <- Int
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ByteString)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ByteString)
B.allocRet Int
len ((Ptr Any -> IO CDerivationScheme)
 -> IO (CDerivationScheme, ByteString))
-> (Ptr Any -> IO CDerivationScheme)
-> IO (CDerivationScheme, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Any
out ->
        Ptr Any -> CSize -> IO CDerivationScheme
forall a. Ptr a -> CSize -> IO CDerivationScheme
wallet_sodium_randombytes Ptr Any
out (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
len)
      Either XPrvError ByteString -> IO (Either XPrvError ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError ByteString -> IO (Either XPrvError ByteString))
-> Either XPrvError ByteString -> IO (Either XPrvError ByteString)
forall a b. (a -> b) -> a -> b
$ if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
== CDerivationScheme
0 then ByteString -> Either XPrvError ByteString
forall a b. b -> Either a b
Right ByteString
bytes else XPrvError -> Either XPrvError ByteString
forall a b. a -> Either a b
Left XPrvError
XPrvInternalError
    DeterministicRandom Word64
counter -> do
      let bytes :: ByteString
bytes = Int -> Word64 -> ByteString
deterministicBytes Int
len Word64
counter
      IORef RandomMode -> RandomMode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef RandomMode
randomModeRef (Word64 -> RandomMode
DeterministicRandom (Word64
counter Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1))
      Either XPrvError ByteString -> IO (Either XPrvError ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either XPrvError ByteString
forall a b. b -> Either a b
Right ByteString
bytes)

deterministicBytes :: Int -> Word64 -> ByteString
deterministicBytes :: Int -> Word64 -> ByteString
deterministicBytes Int
len Word64
counter =
  [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$
    Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
len ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$
      [Word8] -> [Word8]
forall a. HasCallStack => [a] -> [a]
cycle
        [ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
counter
        , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
        , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
        , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
        , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
        , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
        , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
        , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
56)
        ]

-- ---------------------------------------------------------------------------
-- Misc helpers
-- ---------------------------------------------------------------------------

sub :: B.ByteArray c => Int -> Int -> c -> c
sub :: forall c. ByteArray c => Int -> Int -> c -> c
sub Int
ofs Int
sz = Int -> c -> c
forall bs. ByteArray bs => Int -> bs -> bs
B.take Int
sz (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> c -> c
forall bs. ByteArray bs => Int -> bs -> bs
B.drop Int
ofs

dschemeToC :: DerivationScheme -> CDerivationScheme
dschemeToC :: DerivationScheme -> CDerivationScheme
dschemeToC DerivationScheme
DerivationScheme1 = CDerivationScheme
1
dschemeToC DerivationScheme
DerivationScheme2 = CDerivationScheme
2

failDecoder :: XPrvError -> Decoder s a
failDecoder :: forall s a. XPrvError -> Decoder s a
failDecoder = String -> Decoder s a
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s a)
-> (XPrvError -> String) -> XPrvError -> Decoder s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrvError -> String
forall a. Show a => a -> String
show

-- ---------------------------------------------------------------------------
-- FFI declarations
-- ---------------------------------------------------------------------------

foreign import ccall "cardano_wallet_encrypted_from_secret"
  wallet_encrypted_from_secret ::
    SecretKeyPtr ->
    ChainCodePtr ->
    EncryptedKeyPtr ->
    IO CInt

foreign import ccall "cardano_wallet_encrypted_new_from_mkg"
  wallet_encrypted_new_from_mkg ::
    MasterKeyPtr ->
    EncryptedKeyPtr ->
    IO CInt

foreign import ccall "cardano_wallet_encrypted_decrypt"
  wallet_encrypted_decrypt ::
    EncryptedKeyPtr ->
    EncryptedKeyPtr ->
    IO CInt

foreign import ccall "cardano_wallet_encrypted_sign"
  wallet_encrypted_sign ::
    EncryptedKeyPtr ->
    Ptr Word8 ->
    Word32 ->
    SignaturePtr ->
    IO CInt

foreign import ccall "cardano_wallet_encrypted_derive_private"
  wallet_encrypted_derive_private ::
    EncryptedKeyPtr ->
    DerivationIndex ->
    EncryptedKeyPtr ->
    CDerivationScheme ->
    IO CInt

foreign import ccall "cardano_wallet_encrypted_derive_public"
  wallet_encrypted_derive_public ::
    PublicKeyPtr ->
    ChainCodePtr ->
    DerivationIndex ->
    PublicKeyPtr ->
    ChainCodePtr ->
    CDerivationScheme ->
    IO CInt

foreign import ccall "wallet_sodium_randombytes"
  wallet_sodium_randombytes :: Ptr a -> CSize -> IO CInt

foreign import ccall "wallet_sodium_argon2id"
  wallet_sodium_argon2id ::
    WrappingKeyPtr ->
    CULLong ->
    PassPhrasePtr ->
    CULLong ->
    SaltPtr ->
    CULLong ->
    CSize ->
    IO CInt

foreign import ccall "wallet_sodium_xchacha20poly1305_encrypt"
  wallet_sodium_xchacha20poly1305_encrypt ::
    CiphertextPtr ->
    TagPtr ->
    SecretKeyPtr ->
    CULLong ->
    Ptr Word8 ->
    CULLong ->
    NoncePtr ->
    WrappingKeyPtr ->
    IO CInt

foreign import ccall "wallet_sodium_xchacha20poly1305_decrypt"
  wallet_sodium_xchacha20poly1305_decrypt ::
    SecretKeyPtr ->
    CiphertextPtr ->
    CULLong ->
    TagPtr ->
    Ptr Word8 ->
    CULLong ->
    NoncePtr ->
    WrappingKeyPtr ->
    IO CInt