{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeData #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- 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,

  -- ** PublicKey
  PublicKey,
  publicKeySize,
  mkPublicKey,
  publicKeyByteArray,
  publicKeyByteString,

  -- ** Encrypted SecretKey
  EncSecretKey,
  encSecretKeySize,
  mkEncSecretKey,
  encSecretKeyByteArray,
  encSecretKeyByteString,

  -- ** ChainCode
  ChainCode,
  chainCodeSize,
  mkChainCode,
  chainCodeByteArray,
  chainCodeByteString,

  -- ** Salt
  Salt,
  saltSize,
  mkSalt,
  saltByteArray,
  saltByteString,

  -- ** Nonce
  Nonce,
  nonceSize,
  mkNonce,
  nonceByteArray,
  nonceByteString,

  -- ** Tag
  Tag,
  tagSize,
  mkTag,
  tagByteArray,
  tagByteString,

  -- ** Envelope
  Envelope (eSalt, eNonce, ePublicKey, eChainCode),
  decodeEncryptedKey,
  encodeEnvelope,
  decodeEnvelope,

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

  -- * Passphrase operations
  encryptedValidatePassphrase,
  encryptedChangePassphrase,

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

  -- * Accessors
  encryptedPublic,
  encryptedChainCode,

  -- * Test helpers
  withFastKdfForTesting,
  withDeterministicRandomnessForTesting,
) where

import Cardano.Crypto.Libsodium.Memory (zeroMem)
import Cardano.Crypto.PinnedSizedBytes (
  PinnedSizedBytes,
  psbCreate,
  psbCreateResult,
  psbCreateResultLen,
  psbFromByteString,
  psbFromByteStringM,
  psbToByteArray,
  psbToByteString,
  psbUseAsCPtr,
 )
import Control.Arrow (first)
import Control.DeepSeq
import Control.Exception (bracket)
import Control.Monad (when)
import Control.Monad.Trans.Fail.String (errorFail)
import Data.Array.Byte (ByteArray)
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.Proxy (Proxy (..))
import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr
import GHC.Stack (HasCallStack)
import GHC.TypeLits
import System.IO.Unsafe (unsafePerformIO)

import Cardano.Binary (toCBOR)
import Cardano.Crypto.Libsodium.MLockedBytes (
  MLockedSizedBytes,
  mlsbFinalize,
  mlsbNew,
  mlsbUseAsCPtr,
 )
import Codec.CBOR.Decoding (
  Decoder,
  decodeBytes,
  decodeListLenOf,
  decodeWord,
 )
import Codec.CBOR.Encoding (
  Encoding,
  encodeBytes,
  encodeInt,
  encodeListLen,
  encodeWord,
 )
import qualified Codec.CBOR.Read as CBOR
import qualified Codec.CBOR.Write as CBOR

-- ---------------------------------------------------------------------------
-- 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
-- ---------------------------------------------------------------------------

signatureSize :: Int
signatureSize :: Int
signatureSize = Int
64

mlsbCreate :: KnownNat n => (MLockedSizedBytes n -> b) -> (b -> IO c) -> IO c
mlsbCreate :: forall (n :: Nat) b c.
KnownNat n =>
(MLockedSizedBytes n -> b) -> (b -> IO c) -> IO c
mlsbCreate MLockedSizedBytes n -> b
mkType b -> IO c
action = IO (MLockedSizedBytes n)
-> (MLockedSizedBytes n -> IO ())
-> (MLockedSizedBytes n -> IO c)
-> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (MLockedSizedBytes n)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
m (MLockedSizedBytes n)
mlsbNew MLockedSizedBytes n -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize (b -> IO c
action (b -> IO c)
-> (MLockedSizedBytes n -> b) -> MLockedSizedBytes n -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLockedSizedBytes n -> b
mkType)

------------------------------------------------------------------------------
-- SECRET_KEY
------------------------------------------------------------------------------

-- TODO: Derive from: `UNENCRYPTED_KEY_SIZE`
type SECRET_KEY_SIZE = 64

secretKeySize :: Int
secretKeySize :: Int
secretKeySize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy ENC_SECRET_KEY_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @SECRET_KEY_SIZE))

-- | Plaintext version of the secret key used for creating signatures
newtype SecretKey = SecretKey {SecretKey -> MLockedSizedBytes ENC_SECRET_KEY_SIZE
_unSecretKey :: MLockedSizedBytes SECRET_KEY_SIZE}

newtype SecretKeyPtr = SecretKeyPtr (Ptr Word8)

withSecretKeyPtr :: SecretKey -> (SecretKeyPtr -> IO a) -> IO a
withSecretKeyPtr :: forall a. SecretKey -> (SecretKeyPtr -> IO a) -> IO a
withSecretKeyPtr (SecretKey MLockedSizedBytes ENC_SECRET_KEY_SIZE
secretKey) SecretKeyPtr -> IO a
action =
  MLockedSizedBytes ENC_SECRET_KEY_SIZE
-> (Ptr Word8 -> IO a) -> IO a
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes ENC_SECRET_KEY_SIZE
secretKey (SecretKeyPtr -> IO a
action (SecretKeyPtr -> IO a)
-> (Ptr Word8 -> SecretKeyPtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> SecretKeyPtr
SecretKeyPtr)
{-# INLINE withSecretKeyPtr #-}

-- Encrypted version (same size as decrypted)
type ENC_SECRET_KEY_SIZE = SECRET_KEY_SIZE

-- | Encrypted version of `SecretKey`
newtype EncSecretKey = EncSecretKey {EncSecretKey -> PinnedSizedBytes ENC_SECRET_KEY_SIZE
unEncSecretKey :: PinnedSizedBytes ENC_SECRET_KEY_SIZE}
  deriving (EncSecretKey -> EncSecretKey -> Bool
(EncSecretKey -> EncSecretKey -> Bool)
-> (EncSecretKey -> EncSecretKey -> Bool) -> Eq EncSecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncSecretKey -> EncSecretKey -> Bool
== :: EncSecretKey -> EncSecretKey -> Bool
$c/= :: EncSecretKey -> EncSecretKey -> Bool
/= :: EncSecretKey -> EncSecretKey -> Bool
Eq, Int -> EncSecretKey -> ShowS
[EncSecretKey] -> ShowS
EncSecretKey -> String
(Int -> EncSecretKey -> ShowS)
-> (EncSecretKey -> String)
-> ([EncSecretKey] -> ShowS)
-> Show EncSecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncSecretKey -> ShowS
showsPrec :: Int -> EncSecretKey -> ShowS
$cshow :: EncSecretKey -> String
show :: EncSecretKey -> String
$cshowList :: [EncSecretKey] -> ShowS
showList :: [EncSecretKey] -> ShowS
Show)

newtype EncSecretKeyPtr = EncSecretKeyPtr (Ptr Word8)

encSecretKeySize :: Int
encSecretKeySize :: Int
encSecretKeySize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy ENC_SECRET_KEY_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @ENC_SECRET_KEY_SIZE))

withEncSecretKeyPtr :: EncSecretKey -> (EncSecretKeyPtr -> IO a) -> IO a
withEncSecretKeyPtr :: forall a. EncSecretKey -> (EncSecretKeyPtr -> IO a) -> IO a
withEncSecretKeyPtr (EncSecretKey PinnedSizedBytes ENC_SECRET_KEY_SIZE
encSecretKey) EncSecretKeyPtr -> IO a
action =
  PinnedSizedBytes ENC_SECRET_KEY_SIZE -> (Ptr Word8 -> IO a) -> IO a
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes ENC_SECRET_KEY_SIZE
encSecretKey (EncSecretKeyPtr -> IO a
action (EncSecretKeyPtr -> IO a)
-> (Ptr Word8 -> EncSecretKeyPtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> EncSecretKeyPtr
EncSecretKeyPtr)
{-# INLINE withEncSecretKeyPtr #-}

mkEncSecretKey :: MonadFail f => ByteString -> f EncSecretKey
mkEncSecretKey :: forall (f :: * -> *). MonadFail f => ByteString -> f EncSecretKey
mkEncSecretKey ByteString
bs = PinnedSizedBytes ENC_SECRET_KEY_SIZE -> EncSecretKey
EncSecretKey (PinnedSizedBytes ENC_SECRET_KEY_SIZE -> EncSecretKey)
-> f (PinnedSizedBytes ENC_SECRET_KEY_SIZE) -> f EncSecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f (PinnedSizedBytes ENC_SECRET_KEY_SIZE)
forall (n :: Nat) (m :: * -> *).
(MonadFail m, KnownNat n) =>
ByteString -> m (PinnedSizedBytes n)
psbFromByteStringM ByteString
bs

encSecretKeyByteArray :: EncSecretKey -> ByteArray
encSecretKeyByteArray :: EncSecretKey -> ByteArray
encSecretKeyByteArray = PinnedSizedBytes ENC_SECRET_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes ENC_SECRET_KEY_SIZE -> ByteArray)
-> (EncSecretKey -> PinnedSizedBytes ENC_SECRET_KEY_SIZE)
-> EncSecretKey
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncSecretKey -> PinnedSizedBytes ENC_SECRET_KEY_SIZE
unEncSecretKey

encSecretKeyByteString :: EncSecretKey -> ByteString
encSecretKeyByteString :: EncSecretKey -> ByteString
encSecretKeyByteString = PinnedSizedBytes ENC_SECRET_KEY_SIZE -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString (PinnedSizedBytes ENC_SECRET_KEY_SIZE -> ByteString)
-> (EncSecretKey -> PinnedSizedBytes ENC_SECRET_KEY_SIZE)
-> EncSecretKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncSecretKey -> PinnedSizedBytes ENC_SECRET_KEY_SIZE
unEncSecretKey

encodeEncSecretKey :: EncSecretKey -> Encoding
encodeEncSecretKey :: EncSecretKey -> Encoding
encodeEncSecretKey = ByteArray -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteArray -> Encoding)
-> (EncSecretKey -> ByteArray) -> EncSecretKey -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes ENC_SECRET_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes ENC_SECRET_KEY_SIZE -> ByteArray)
-> (EncSecretKey -> PinnedSizedBytes ENC_SECRET_KEY_SIZE)
-> EncSecretKey
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncSecretKey -> PinnedSizedBytes ENC_SECRET_KEY_SIZE
unEncSecretKey

decodeEncSecretKey :: Decoder s EncSecretKey
decodeEncSecretKey :: forall s. Decoder s EncSecretKey
decodeEncSecretKey = do
  ByteString
saltBytes <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe EncSecretKey
forall (f :: * -> *). MonadFail f => ByteString -> f EncSecretKey
mkEncSecretKey ByteString
saltBytes of
    Maybe EncSecretKey
Nothing -> XPrvError -> Decoder s EncSecretKey
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidCiphertextLength
    Just EncSecretKey
salt -> EncSecretKey -> Decoder s EncSecretKey
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncSecretKey
salt

------------------------------------------------------------------------------
-- PUBLIC_KEY
------------------------------------------------------------------------------

type PUBLIC_KEY_SIZE = 32

publicKeySize :: Int
publicKeySize :: Int
publicKeySize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy WRAPPING_KEY_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @PUBLIC_KEY_SIZE))

newtype PublicKey = PublicKey {PublicKey -> PinnedSizedBytes WRAPPING_KEY_SIZE
unPublicKey :: PinnedSizedBytes PUBLIC_KEY_SIZE}
  deriving (PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq, Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> String
show :: PublicKey -> String
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show)
newtype PublicKeyPtr = PublicKeyPtr (Ptr Word8)

withPublicKeyPtr :: PublicKey -> (PublicKeyPtr -> IO a) -> IO a
withPublicKeyPtr :: forall a. PublicKey -> (PublicKeyPtr -> IO a) -> IO a
withPublicKeyPtr (PublicKey PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey) PublicKeyPtr -> IO a
action =
  PinnedSizedBytes WRAPPING_KEY_SIZE -> (Ptr Word8 -> IO a) -> IO a
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey (PublicKeyPtr -> IO a
action (PublicKeyPtr -> IO a)
-> (Ptr Word8 -> PublicKeyPtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> PublicKeyPtr
PublicKeyPtr)
{-# INLINE withPublicKeyPtr #-}

mkPublicKey :: MonadFail f => ByteString -> f PublicKey
mkPublicKey :: forall (f :: * -> *). MonadFail f => ByteString -> f PublicKey
mkPublicKey ByteString
bs = PinnedSizedBytes WRAPPING_KEY_SIZE -> PublicKey
PublicKey (PinnedSizedBytes WRAPPING_KEY_SIZE -> PublicKey)
-> f (PinnedSizedBytes WRAPPING_KEY_SIZE) -> f PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f (PinnedSizedBytes WRAPPING_KEY_SIZE)
forall (n :: Nat) (m :: * -> *).
(MonadFail m, KnownNat n) =>
ByteString -> m (PinnedSizedBytes n)
psbFromByteStringM ByteString
bs

publicKeyByteArray :: PublicKey -> ByteArray
publicKeyByteArray :: PublicKey -> ByteArray
publicKeyByteArray = PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray)
-> (PublicKey -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> PublicKey
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PinnedSizedBytes WRAPPING_KEY_SIZE
unPublicKey

publicKeyByteString :: PublicKey -> ByteString
publicKeyByteString :: PublicKey -> ByteString
publicKeyByteString = PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteString)
-> (PublicKey -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> PublicKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PinnedSizedBytes WRAPPING_KEY_SIZE
unPublicKey

encodePublicKey :: PublicKey -> Encoding
encodePublicKey :: PublicKey -> Encoding
encodePublicKey = ByteArray -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteArray -> Encoding)
-> (PublicKey -> ByteArray) -> PublicKey -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray)
-> (PublicKey -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> PublicKey
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PinnedSizedBytes WRAPPING_KEY_SIZE
unPublicKey

------------------------------------------------------------------------------
-- CHAIN_CODE
------------------------------------------------------------------------------

type CHAIN_CODE_SIZE = 32

chainCodeSize :: Int
chainCodeSize :: Int
chainCodeSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy WRAPPING_KEY_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @CHAIN_CODE_SIZE))

newtype ChainCode = ChainCode {ChainCode -> PinnedSizedBytes WRAPPING_KEY_SIZE
unChainCode :: PinnedSizedBytes CHAIN_CODE_SIZE}
  deriving (ChainCode -> ChainCode -> Bool
(ChainCode -> ChainCode -> Bool)
-> (ChainCode -> ChainCode -> Bool) -> Eq ChainCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainCode -> ChainCode -> Bool
== :: ChainCode -> ChainCode -> Bool
$c/= :: ChainCode -> ChainCode -> Bool
/= :: ChainCode -> ChainCode -> Bool
Eq, Int -> ChainCode -> ShowS
[ChainCode] -> ShowS
ChainCode -> String
(Int -> ChainCode -> ShowS)
-> (ChainCode -> String)
-> ([ChainCode] -> ShowS)
-> Show ChainCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainCode -> ShowS
showsPrec :: Int -> ChainCode -> ShowS
$cshow :: ChainCode -> String
show :: ChainCode -> String
$cshowList :: [ChainCode] -> ShowS
showList :: [ChainCode] -> ShowS
Show)
newtype ChainCodePtr = ChainCodePtr (Ptr Word8)

withChainCodePtr :: ChainCode -> (ChainCodePtr -> IO a) -> IO a
withChainCodePtr :: forall a. ChainCode -> (ChainCodePtr -> IO a) -> IO a
withChainCodePtr (ChainCode PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey) ChainCodePtr -> IO a
action =
  PinnedSizedBytes WRAPPING_KEY_SIZE -> (Ptr Word8 -> IO a) -> IO a
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey (ChainCodePtr -> IO a
action (ChainCodePtr -> IO a)
-> (Ptr Word8 -> ChainCodePtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> ChainCodePtr
ChainCodePtr)
{-# INLINE withChainCodePtr #-}

mkChainCode :: MonadFail f => ByteString -> f ChainCode
mkChainCode :: forall (f :: * -> *). MonadFail f => ByteString -> f ChainCode
mkChainCode ByteString
bs = PinnedSizedBytes WRAPPING_KEY_SIZE -> ChainCode
ChainCode (PinnedSizedBytes WRAPPING_KEY_SIZE -> ChainCode)
-> f (PinnedSizedBytes WRAPPING_KEY_SIZE) -> f ChainCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f (PinnedSizedBytes WRAPPING_KEY_SIZE)
forall (n :: Nat) (m :: * -> *).
(MonadFail m, KnownNat n) =>
ByteString -> m (PinnedSizedBytes n)
psbFromByteStringM ByteString
bs

chainCodeByteArray :: ChainCode -> ByteArray
chainCodeByteArray :: ChainCode -> ByteArray
chainCodeByteArray = PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray)
-> (ChainCode -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> ChainCode
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainCode -> PinnedSizedBytes WRAPPING_KEY_SIZE
unChainCode

chainCodeByteString :: ChainCode -> ByteString
chainCodeByteString :: ChainCode -> ByteString
chainCodeByteString = PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteString)
-> (ChainCode -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> ChainCode
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainCode -> PinnedSizedBytes WRAPPING_KEY_SIZE
unChainCode

encodeChainCode :: ChainCode -> Encoding
encodeChainCode :: ChainCode -> Encoding
encodeChainCode = ByteArray -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteArray -> Encoding)
-> (ChainCode -> ByteArray) -> ChainCode -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray)
-> (ChainCode -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> ChainCode
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainCode -> PinnedSizedBytes WRAPPING_KEY_SIZE
unChainCode

------------------------------------------------------------------------------
-- KEY_MATERIAL
------------------------------------------------------------------------------

type data Validity = Validated | Unchecked

-- | Key material with the secret key in @sodium_malloc@'d locked memory.
data KeyMaterial (v :: Validity) = KeyMaterial
  { forall (v :: Validity). KeyMaterial v -> SecretKey
kmSecretKey :: !SecretKey
  , forall (v :: Validity). KeyMaterial v -> PublicKey
kmPublicKey :: !PublicKey
  , forall (v :: Validity). KeyMaterial v -> ChainCode
kmChainCode :: !ChainCode
  }

type KEY_MATERIAL_SIZE = SECRET_KEY_SIZE + PUBLIC_KEY_SIZE + CHAIN_CODE_SIZE

keyMaterialSize :: Int
keyMaterialSize :: Int
keyMaterialSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy 128 -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @KEY_MATERIAL_SIZE))

newtype KeyMaterialBuffer = KeyMaterialBuffer (MLockedSizedBytes KEY_MATERIAL_SIZE)
newtype KeyMaterialPtr = KeyMaterialPtr (Ptr Word8)

allocaKeyMaterialBuffer :: (KeyMaterialPtr -> IO c) -> IO c
allocaKeyMaterialBuffer :: forall c. (KeyMaterialPtr -> IO c) -> IO c
allocaKeyMaterialBuffer KeyMaterialPtr -> IO c
action =
  (MLockedSizedBytes 128 -> KeyMaterialBuffer)
-> (KeyMaterialBuffer -> IO c) -> IO c
forall (n :: Nat) b c.
KnownNat n =>
(MLockedSizedBytes n -> b) -> (b -> IO c) -> IO c
mlsbCreate MLockedSizedBytes 128 -> KeyMaterialBuffer
MLockedSizedBytes KEY_MATERIAL_SIZE -> KeyMaterialBuffer
KeyMaterialBuffer ((KeyMaterialBuffer -> IO c) -> IO c)
-> (KeyMaterialBuffer -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \(KeyMaterialBuffer MLockedSizedBytes KEY_MATERIAL_SIZE
keyMaterialBuffer) ->
    MLockedSizedBytes 128 -> (Ptr Word8 -> IO c) -> IO c
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes 128
MLockedSizedBytes KEY_MATERIAL_SIZE
keyMaterialBuffer (KeyMaterialPtr -> IO c
action (KeyMaterialPtr -> IO c)
-> (Ptr Word8 -> KeyMaterialPtr) -> Ptr Word8 -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> KeyMaterialPtr
KeyMaterialPtr)

-- ---------------------------------------------------------------------------
-- 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
  }

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

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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word Int
wrappingKeySize

-- ---------------------------------------------------------------------------
-- 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
  | XPrvHardenedDerivationUnsupported
  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
-- ---------------------------------------------------------------------------

------------------------------------------------------------------------------
-- SALT
------------------------------------------------------------------------------

type SALT_SIZE = 32

saltSize :: Int
saltSize :: Int
saltSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy WRAPPING_KEY_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @SALT_SIZE))

newtype Salt = Salt {Salt -> PinnedSizedBytes WRAPPING_KEY_SIZE
unSalt :: PinnedSizedBytes SALT_SIZE}
  deriving (Salt -> Salt -> Bool
(Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
/= :: Salt -> Salt -> Bool
Eq, Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> String
(Int -> Salt -> ShowS)
-> (Salt -> String) -> ([Salt] -> ShowS) -> Show Salt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Salt -> ShowS
showsPrec :: Int -> Salt -> ShowS
$cshow :: Salt -> String
show :: Salt -> String
$cshowList :: [Salt] -> ShowS
showList :: [Salt] -> ShowS
Show)
newtype SaltPtr = SaltPtr (Ptr Word8)

withSaltPtr :: Salt -> (SaltPtr -> IO a) -> IO a
withSaltPtr :: forall a. Salt -> (SaltPtr -> IO a) -> IO a
withSaltPtr (Salt PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey) SaltPtr -> IO a
action =
  PinnedSizedBytes WRAPPING_KEY_SIZE -> (Ptr Word8 -> IO a) -> IO a
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey (SaltPtr -> IO a
action (SaltPtr -> IO a) -> (Ptr Word8 -> SaltPtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> SaltPtr
SaltPtr)
{-# INLINE withSaltPtr #-}

mkSalt :: MonadFail f => ByteString -> f Salt
mkSalt :: forall (f :: * -> *). MonadFail f => ByteString -> f Salt
mkSalt ByteString
bs = PinnedSizedBytes WRAPPING_KEY_SIZE -> Salt
Salt (PinnedSizedBytes WRAPPING_KEY_SIZE -> Salt)
-> f (PinnedSizedBytes WRAPPING_KEY_SIZE) -> f Salt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f (PinnedSizedBytes WRAPPING_KEY_SIZE)
forall (n :: Nat) (m :: * -> *).
(MonadFail m, KnownNat n) =>
ByteString -> m (PinnedSizedBytes n)
psbFromByteStringM ByteString
bs

saltByteArray :: Salt -> ByteArray
saltByteArray :: Salt -> ByteArray
saltByteArray = PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray)
-> (Salt -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> Salt
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt -> PinnedSizedBytes WRAPPING_KEY_SIZE
unSalt

saltByteString :: Salt -> ByteString
saltByteString :: Salt -> ByteString
saltByteString = PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteString)
-> (Salt -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> Salt
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt -> PinnedSizedBytes WRAPPING_KEY_SIZE
unSalt

encodeSalt :: Salt -> Encoding
encodeSalt :: Salt -> Encoding
encodeSalt = ByteArray -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteArray -> Encoding) -> (Salt -> ByteArray) -> Salt -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes WRAPPING_KEY_SIZE -> ByteArray)
-> (Salt -> PinnedSizedBytes WRAPPING_KEY_SIZE)
-> Salt
-> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt -> PinnedSizedBytes WRAPPING_KEY_SIZE
unSalt

decodeSalt :: Decoder s Salt
decodeSalt :: forall s. Decoder s Salt
decodeSalt = do
  ByteString
saltBytes <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe Salt
forall (f :: * -> *). MonadFail f => ByteString -> f Salt
mkSalt ByteString
saltBytes of
    Maybe Salt
Nothing -> XPrvError -> Decoder s Salt
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidSaltLength
    Just Salt
salt -> Salt -> Decoder s Salt
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Salt
salt

------------------------------------------------------------------------------
-- NONCE
------------------------------------------------------------------------------

-- TODO: Derive from `crypto_aead_xchacha20poly1305_ietf_NPUBBYTES`
type NONCE_SIZE = 24

nonceSize :: Int
nonceSize :: Int
nonceSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy NONCE_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @NONCE_SIZE))

newtype Nonce = Nonce {Nonce -> PinnedSizedBytes NONCE_SIZE
unNonce :: PinnedSizedBytes NONCE_SIZE}
  deriving (Nonce -> Nonce -> Bool
(Nonce -> Nonce -> Bool) -> (Nonce -> Nonce -> Bool) -> Eq Nonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nonce -> Nonce -> Bool
== :: Nonce -> Nonce -> Bool
$c/= :: Nonce -> Nonce -> Bool
/= :: Nonce -> Nonce -> Bool
Eq, Int -> Nonce -> ShowS
[Nonce] -> ShowS
Nonce -> String
(Int -> Nonce -> ShowS)
-> (Nonce -> String) -> ([Nonce] -> ShowS) -> Show Nonce
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Nonce -> ShowS
showsPrec :: Int -> Nonce -> ShowS
$cshow :: Nonce -> String
show :: Nonce -> String
$cshowList :: [Nonce] -> ShowS
showList :: [Nonce] -> ShowS
Show)
newtype NoncePtr = NoncePtr (Ptr Word8)

withNoncePtr :: Nonce -> (NoncePtr -> IO a) -> IO a
withNoncePtr :: forall a. Nonce -> (NoncePtr -> IO a) -> IO a
withNoncePtr (Nonce PinnedSizedBytes NONCE_SIZE
publicKey) NoncePtr -> IO a
action =
  PinnedSizedBytes NONCE_SIZE -> (Ptr Word8 -> IO a) -> IO a
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes NONCE_SIZE
publicKey (NoncePtr -> IO a
action (NoncePtr -> IO a) -> (Ptr Word8 -> NoncePtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> NoncePtr
NoncePtr)
{-# INLINE withNoncePtr #-}

mkNonce :: MonadFail f => ByteString -> f Nonce
mkNonce :: forall (f :: * -> *). MonadFail f => ByteString -> f Nonce
mkNonce ByteString
bs = PinnedSizedBytes NONCE_SIZE -> Nonce
Nonce (PinnedSizedBytes NONCE_SIZE -> Nonce)
-> f (PinnedSizedBytes NONCE_SIZE) -> f Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f (PinnedSizedBytes NONCE_SIZE)
forall (n :: Nat) (m :: * -> *).
(MonadFail m, KnownNat n) =>
ByteString -> m (PinnedSizedBytes n)
psbFromByteStringM ByteString
bs

nonceByteArray :: Nonce -> ByteArray
nonceByteArray :: Nonce -> ByteArray
nonceByteArray = PinnedSizedBytes NONCE_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes NONCE_SIZE -> ByteArray)
-> (Nonce -> PinnedSizedBytes NONCE_SIZE) -> Nonce -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> PinnedSizedBytes NONCE_SIZE
unNonce

nonceByteString :: Nonce -> ByteString
nonceByteString :: Nonce -> ByteString
nonceByteString = PinnedSizedBytes NONCE_SIZE -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString (PinnedSizedBytes NONCE_SIZE -> ByteString)
-> (Nonce -> PinnedSizedBytes NONCE_SIZE) -> Nonce -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> PinnedSizedBytes NONCE_SIZE
unNonce

encodeNonce :: Nonce -> Encoding
encodeNonce :: Nonce -> Encoding
encodeNonce = ByteArray -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteArray -> Encoding)
-> (Nonce -> ByteArray) -> Nonce -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes NONCE_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes NONCE_SIZE -> ByteArray)
-> (Nonce -> PinnedSizedBytes NONCE_SIZE) -> Nonce -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nonce -> PinnedSizedBytes NONCE_SIZE
unNonce

decodeNonce :: Decoder s Nonce
decodeNonce :: forall s. Decoder s Nonce
decodeNonce = do
  ByteString
nonceBytes <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe Nonce
forall (f :: * -> *). MonadFail f => ByteString -> f Nonce
mkNonce ByteString
nonceBytes of
    Maybe Nonce
Nothing -> XPrvError -> Decoder s Nonce
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidNonceLength
    Just Nonce
nonce -> Nonce -> Decoder s Nonce
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nonce
nonce

------------------------------------------------------------------------------
-- TAG
------------------------------------------------------------------------------

-- TODO: Derive from: `crypto_aead_xchacha20poly1305_ietf_ABYTES`
type TAG_SIZE = 16

tagSize :: Int
tagSize :: Int
tagSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy TAG_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @TAG_SIZE))

newtype Tag = Tag {Tag -> PinnedSizedBytes TAG_SIZE
unTag :: PinnedSizedBytes TAG_SIZE}
  deriving (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
/= :: Tag -> Tag -> Bool
Eq, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tag -> ShowS
showsPrec :: Int -> Tag -> ShowS
$cshow :: Tag -> String
show :: Tag -> String
$cshowList :: [Tag] -> ShowS
showList :: [Tag] -> ShowS
Show)
newtype TagPtr = TagPtr (Ptr Word8)

withTagPtr :: Tag -> (TagPtr -> IO a) -> IO a
withTagPtr :: forall a. Tag -> (TagPtr -> IO a) -> IO a
withTagPtr (Tag PinnedSizedBytes TAG_SIZE
publicKey) TagPtr -> IO a
action =
  PinnedSizedBytes TAG_SIZE -> (Ptr Word8 -> IO a) -> IO a
forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (Ptr Word8 -> m r) -> m r
psbUseAsCPtr PinnedSizedBytes TAG_SIZE
publicKey (TagPtr -> IO a
action (TagPtr -> IO a) -> (Ptr Word8 -> TagPtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> TagPtr
TagPtr)
{-# INLINE withTagPtr #-}

mkTag :: MonadFail f => ByteString -> f Tag
mkTag :: forall (f :: * -> *). MonadFail f => ByteString -> f Tag
mkTag ByteString
bs = PinnedSizedBytes TAG_SIZE -> Tag
Tag (PinnedSizedBytes TAG_SIZE -> Tag)
-> f (PinnedSizedBytes TAG_SIZE) -> f Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f (PinnedSizedBytes TAG_SIZE)
forall (n :: Nat) (m :: * -> *).
(MonadFail m, KnownNat n) =>
ByteString -> m (PinnedSizedBytes n)
psbFromByteStringM ByteString
bs

tagByteArray :: Tag -> ByteArray
tagByteArray :: Tag -> ByteArray
tagByteArray = PinnedSizedBytes TAG_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes TAG_SIZE -> ByteArray)
-> (Tag -> PinnedSizedBytes TAG_SIZE) -> Tag -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> PinnedSizedBytes TAG_SIZE
unTag

tagByteString :: Tag -> ByteString
tagByteString :: Tag -> ByteString
tagByteString = PinnedSizedBytes TAG_SIZE -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString (PinnedSizedBytes TAG_SIZE -> ByteString)
-> (Tag -> PinnedSizedBytes TAG_SIZE) -> Tag -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> PinnedSizedBytes TAG_SIZE
unTag

encodeTag :: Tag -> Encoding
encodeTag :: Tag -> Encoding
encodeTag = ByteArray -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteArray -> Encoding) -> (Tag -> ByteArray) -> Tag -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedSizedBytes TAG_SIZE -> ByteArray
forall (n :: Nat). PinnedSizedBytes n -> ByteArray
psbToByteArray (PinnedSizedBytes TAG_SIZE -> ByteArray)
-> (Tag -> PinnedSizedBytes TAG_SIZE) -> Tag -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> PinnedSizedBytes TAG_SIZE
unTag

decodeTag :: Decoder s Tag
decodeTag :: forall s. Decoder s Tag
decodeTag = do
  ByteString
tagBytes <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe Tag
forall (f :: * -> *). MonadFail f => ByteString -> f Tag
mkTag ByteString
tagBytes of
    Maybe Tag
Nothing -> XPrvError -> Decoder s Tag
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidTagLength
    Just Tag
tag -> Tag -> Decoder s Tag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag
tag

------------------------------------------------------------------------------
-- WRAPPING_KEY
------------------------------------------------------------------------------

-- TODO: Derive from: `crypto_aead_xchacha20poly1305_ietf_KEYBYTES`
type WRAPPING_KEY_SIZE = 32

-- | Plaintext version of the wrapping key used for creating signatures
newtype WrappingKey = WrappingKey {WrappingKey -> MLockedSizedBytes WRAPPING_KEY_SIZE
_unWrappingKey :: MLockedSizedBytes WRAPPING_KEY_SIZE}

newtype WrappingKeyPtr = WrappingKeyPtr (Ptr Word8)

wrappingKeySize :: Int
wrappingKeySize :: Int
wrappingKeySize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy WRAPPING_KEY_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @WRAPPING_KEY_SIZE))

withWrappingKeyPtr :: WrappingKey -> (WrappingKeyPtr -> IO a) -> IO a
withWrappingKeyPtr :: forall a. WrappingKey -> (WrappingKeyPtr -> IO a) -> IO a
withWrappingKeyPtr (WrappingKey MLockedSizedBytes WRAPPING_KEY_SIZE
wrappingKey) WrappingKeyPtr -> IO a
action =
  MLockedSizedBytes WRAPPING_KEY_SIZE -> (Ptr Word8 -> IO a) -> IO a
forall (m :: * -> *) (n :: Nat) r.
MonadST m =>
MLockedSizedBytes n -> (Ptr Word8 -> m r) -> m r
mlsbUseAsCPtr MLockedSizedBytes WRAPPING_KEY_SIZE
wrappingKey (WrappingKeyPtr -> IO a
action (WrappingKeyPtr -> IO a)
-> (Ptr Word8 -> WrappingKeyPtr) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> WrappingKeyPtr
WrappingKeyPtr)
{-# INLINE withWrappingKeyPtr #-}

data Envelope = Envelope
  { Envelope -> Salt
eSalt :: !Salt
  , Envelope -> Nonce
eNonce :: !Nonce
  , Envelope -> PublicKey
ePublicKey :: !PublicKey
  , Envelope -> ChainCode
eChainCode :: !ChainCode
  , Envelope -> EncSecretKey
eEncSecretKey :: !EncSecretKey
  , Envelope -> Tag
eTag :: !Tag
  }
  deriving (Envelope -> Envelope -> Bool
(Envelope -> Envelope -> Bool)
-> (Envelope -> Envelope -> Bool) -> Eq Envelope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Envelope -> Envelope -> Bool
== :: Envelope -> Envelope -> Bool
$c/= :: Envelope -> Envelope -> Bool
/= :: Envelope -> Envelope -> Bool
Eq, Int -> Envelope -> ShowS
[Envelope] -> ShowS
Envelope -> String
(Int -> Envelope -> ShowS)
-> (Envelope -> String) -> ([Envelope] -> ShowS) -> Show Envelope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Envelope -> ShowS
showsPrec :: Int -> Envelope -> ShowS
$cshow :: Envelope -> String
show :: Envelope -> String
$cshowList :: [Envelope] -> ShowS
showList :: [Envelope] -> ShowS
Show)

-- FFI pointer newtypes
newtype MasterKeyPtr = MasterKeyPtr (Ptr Word8)
newtype SignaturePtr = SignaturePtr (Ptr Word8)
newtype PassPhrasePtr = PassPhrasePtr (Ptr Word8)

type CDerivationScheme = CInt

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

-- | Construct `EncryptedKey` from bytes.
mkEncryptedKey :: ByteString -> Either XPrvError EncryptedKey
mkEncryptedKey :: ByteString -> Either XPrvError EncryptedKey
mkEncryptedKey ByteString
bs =
  let eKey :: EncryptedKey
eKey = ByteString -> EncryptedKey
EncryptedKey ByteString
bs
   in EncryptedKey
eKey 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
<$ EncryptedKey -> Either XPrvError ()
validateSerializedKey EncryptedKey
eKey

-- | In order to promote smoother migration from @cardano-crypto@. Use `mkEncryptedKey` instead
encryptedKey :: ByteString -> Either XPrvError EncryptedKey
encryptedKey :: ByteString -> Either XPrvError EncryptedKey
encryptedKey = ByteString -> Either XPrvError EncryptedKey
mkEncryptedKey
{-# DEPRECATED encryptedKey "In favor of `mkEncryptedKey`" #-}

validateSerializedKey :: EncryptedKey -> Either XPrvError ()
validateSerializedKey :: EncryptedKey -> Either XPrvError ()
validateSerializedKey EncryptedKey
eKey =
  case EncryptedKey -> XPrvFormat
encryptedKeyFormat EncryptedKey
eKey of
    XPrvFormat
LegacyV1 -> () -> Either XPrvError ()
forall a b. b -> Either a b
Right ()
    XPrvFormat
EnvelopeV2 -> () () -> Either XPrvError Envelope -> Either XPrvError ()
forall a b. a -> Either XPrvError b -> Either XPrvError a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EncryptedKey -> Either XPrvError Envelope
decodeEncryptedKey EncryptedKey
eKey

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
keyMaterialSize = 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
chainCodeSize = 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 = secret
-> cc
-> (KeyMaterial Validated -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall secret cc a.
(ByteArrayAccess secret, ByteArrayAccess cc) =>
secret
-> cc
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
legacyMaterialFromSecret secret
sec cc
cc (passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass)

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 = secret
-> (KeyMaterial Validated -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall secret a.
ByteArrayAccess secret =>
secret
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
legacyMaterialFromMasterKey secret
sec (passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass)

encryptedValidatePassphrase ::
  ByteArrayAccess passphrase =>
  EncryptedKey -> passphrase -> IO (Either XPrvError ())
encryptedValidatePassphrase :: forall passphrase.
ByteArrayAccess passphrase =>
EncryptedKey -> passphrase -> IO (Either XPrvError ())
encryptedValidatePassphrase EncryptedKey
eKey passphrase
pass =
  EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError ()))
-> IO (Either XPrvError ())
forall passphrase a.
ByteArrayAccess passphrase =>
EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withDecryptedKeyMaterial EncryptedKey
eKey passphrase
pass (\KeyMaterial Validated
_ -> Either XPrvError () -> IO (Either XPrvError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError () -> IO (Either XPrvError ()))
-> Either XPrvError () -> IO (Either XPrvError ())
forall a b. (a -> b) -> a -> b
$ () -> Either XPrvError ()
forall a b. b -> Either a b
Right ())

encryptedChangePassphrase ::
  (ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
  oldPassPhrase -> newPassPhrase -> EncryptedKey -> IO (Either XPrvError EncryptedKey)
encryptedChangePassphrase :: forall oldPassPhrase newPassPhrase.
(ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
oldPassPhrase
-> newPassPhrase
-> EncryptedKey
-> IO (Either XPrvError EncryptedKey)
encryptedChangePassphrase oldPassPhrase
oldPass newPassPhrase
newPass EncryptedKey
eKey =
  EncryptedKey
-> oldPassPhrase
-> (KeyMaterial Validated -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall passphrase a.
ByteArrayAccess passphrase =>
EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withDecryptedKeyMaterial EncryptedKey
eKey oldPassPhrase
oldPass (newPassPhrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial newPassPhrase
newPass)

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 =
  EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall passphrase a.
ByteArrayAccess passphrase =>
EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withDecryptedKeyMaterial EncryptedKey
eKey passphrase
pass ((KeyMaterial Validated -> IO (Either XPrvError Signature))
 -> IO (Either XPrvError Signature))
-> (KeyMaterial Validated -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall a b. (a -> b) -> a -> b
$ \KeyMaterial Validated
keyMaterial ->
    KeyMaterial Validated
-> (KeyMaterialPtr -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall (v :: Validity) r.
KeyMaterial v -> (KeyMaterialPtr -> IO r) -> IO r
withKeyMaterialPtr KeyMaterial Validated
keyMaterial ((KeyMaterialPtr -> IO (Either XPrvError Signature))
 -> IO (Either XPrvError Signature))
-> (KeyMaterialPtr -> IO (Either XPrvError Signature))
-> IO (Either XPrvError Signature)
forall a b. (a -> b) -> a -> b
$ \KeyMaterialPtr
keyMaterialPtr -> do
      (CDerivationScheme
status, ByteString
sig) <-
        Int
-> (Ptr Word8 -> 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 Word8 -> IO CDerivationScheme)
 -> IO (CDerivationScheme, ByteString))
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (CDerivationScheme, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
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 ->
            KeyMaterialPtr
-> Ptr Word8 -> CSize -> SignaturePtr -> IO CDerivationScheme
wallet_sign
              KeyMaterialPtr
keyMaterialPtr
              Ptr Word8
msgPtr
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ msg -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length msg
msg)
              (Ptr Word8 -> SignaturePtr
SignaturePtr Ptr Word8
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))

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 =
  EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall passphrase a.
ByteArrayAccess passphrase =>
EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withDecryptedKeyMaterial EncryptedKey
eKey passphrase
pass ((KeyMaterial Validated -> IO (Either XPrvError EncryptedKey))
 -> IO (Either XPrvError EncryptedKey))
-> (KeyMaterial Validated -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ \KeyMaterial Validated
parentKeyMaterial ->
    DerivationScheme
-> KeyMaterial Validated
-> DerivationIndex
-> (KeyMaterial Validated -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a.
DerivationScheme
-> KeyMaterial Validated
-> DerivationIndex
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
legacyDerivePrivate DerivationScheme
dScheme KeyMaterial Validated
parentKeyMaterial DerivationIndex
childIndex (passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
forall passphrase.
ByteArrayAccess passphrase =>
passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass)

encryptedDerivePublic ::
  DerivationScheme ->
  (PublicKey, ChainCode) ->
  DerivationIndex ->
  Either XPrvError (PublicKey, ChainCode)
encryptedDerivePublic :: DerivationScheme
-> (PublicKey, ChainCode)
-> DerivationIndex
-> Either XPrvError (PublicKey, ChainCode)
encryptedDerivePublic DerivationScheme
dscheme (PublicKey
publicKey, ChainCode
cc) DerivationIndex
childIndex
  | DerivationIndex
childIndex DerivationIndex -> DerivationIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= DerivationIndex
0x80000000 = XPrvError -> Either XPrvError (PublicKey, ChainCode)
forall a b. a -> Either a b
Left XPrvError
XPrvHardenedDerivationUnsupported
  | Bool
otherwise = IO (Either XPrvError (PublicKey, ChainCode))
-> Either XPrvError (PublicKey, ChainCode)
forall a. IO a -> a
unsafePerformIO (IO (Either XPrvError (PublicKey, ChainCode))
 -> Either XPrvError (PublicKey, ChainCode))
-> IO (Either XPrvError (PublicKey, ChainCode))
-> Either XPrvError (PublicKey, ChainCode)
forall a b. (a -> b) -> a -> b
$
      PublicKey
-> (PublicKeyPtr -> IO (Either XPrvError (PublicKey, ChainCode)))
-> IO (Either XPrvError (PublicKey, ChainCode))
forall a. PublicKey -> (PublicKeyPtr -> IO a) -> IO a
withPublicKeyPtr PublicKey
publicKey ((PublicKeyPtr -> IO (Either XPrvError (PublicKey, ChainCode)))
 -> IO (Either XPrvError (PublicKey, ChainCode)))
-> (PublicKeyPtr -> IO (Either XPrvError (PublicKey, ChainCode)))
-> IO (Either XPrvError (PublicKey, ChainCode))
forall a b. (a -> b) -> a -> b
$ \PublicKeyPtr
publicKeyPtr ->
        ChainCode
-> (ChainCodePtr -> IO (Either XPrvError (PublicKey, ChainCode)))
-> IO (Either XPrvError (PublicKey, ChainCode))
forall a. ChainCode -> (ChainCodePtr -> IO a) -> IO a
withChainCodePtr ChainCode
cc ((ChainCodePtr -> IO (Either XPrvError (PublicKey, ChainCode)))
 -> IO (Either XPrvError (PublicKey, ChainCode)))
-> (ChainCodePtr -> IO (Either XPrvError (PublicKey, ChainCode)))
-> IO (Either XPrvError (PublicKey, ChainCode))
forall a b. (a -> b) -> a -> b
$ \ChainCodePtr
chainCodePtr -> do
          (PinnedSizedBytes WRAPPING_KEY_SIZE
pubKeyBytes, (PinnedSizedBytes WRAPPING_KEY_SIZE
ccBytes, CDerivationScheme
r)) <-
            (Ptr Word8
 -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme))
-> IO
     (PinnedSizedBytes WRAPPING_KEY_SIZE,
      (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme))
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m r) -> m (PinnedSizedBytes n, r)
psbCreateResult ((Ptr Word8
  -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme))
 -> IO
      (PinnedSizedBytes WRAPPING_KEY_SIZE,
       (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme)))
-> (Ptr Word8
    -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme))
-> IO
     (PinnedSizedBytes WRAPPING_KEY_SIZE,
      (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
publicKeyPtrOut ->
              (Ptr Word8 -> IO CDerivationScheme)
-> IO (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme)
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m r) -> m (PinnedSizedBytes n, r)
psbCreateResult ((Ptr Word8 -> IO CDerivationScheme)
 -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme))
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (PinnedSizedBytes WRAPPING_KEY_SIZE, CDerivationScheme)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ccOutPtr ->
                PublicKeyPtr
-> ChainCodePtr
-> DerivationIndex
-> PublicKeyPtr
-> ChainCodePtr
-> CDerivationScheme
-> IO CDerivationScheme
wallet_derive_public
                  PublicKeyPtr
publicKeyPtr
                  ChainCodePtr
chainCodePtr
                  DerivationIndex
childIndex
                  (Ptr Word8 -> PublicKeyPtr
PublicKeyPtr Ptr Word8
publicKeyPtrOut)
                  (Ptr Word8 -> ChainCodePtr
ChainCodePtr Ptr Word8
ccOutPtr)
                  (DerivationScheme -> CDerivationScheme
dschemeToC DerivationScheme
dscheme)
          Either XPrvError (PublicKey, ChainCode)
-> IO (Either XPrvError (PublicKey, ChainCode))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError (PublicKey, ChainCode)
 -> IO (Either XPrvError (PublicKey, ChainCode)))
-> Either XPrvError (PublicKey, ChainCode)
-> IO (Either XPrvError (PublicKey, ChainCode))
forall a b. (a -> b) -> a -> b
$
            if CDerivationScheme
r CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
              then XPrvError -> Either XPrvError (PublicKey, ChainCode)
forall a b. a -> Either a b
Left XPrvError
XPrvInternalError
              else (PublicKey, ChainCode) -> Either XPrvError (PublicKey, ChainCode)
forall a b. b -> Either a b
Right (PinnedSizedBytes WRAPPING_KEY_SIZE -> PublicKey
PublicKey PinnedSizedBytes WRAPPING_KEY_SIZE
pubKeyBytes, PinnedSizedBytes WRAPPING_KEY_SIZE -> ChainCode
ChainCode PinnedSizedBytes WRAPPING_KEY_SIZE
ccBytes)

encryptedPublic :: HasCallStack => EncryptedKey -> PublicKey
encryptedPublic :: HasCallStack => EncryptedKey -> PublicKey
encryptedPublic eKey :: EncryptedKey
eKey@(EncryptedKey ByteString
eKeyBytes) =
  case EncryptedKey -> XPrvFormat
encryptedKeyFormat EncryptedKey
eKey of
    XPrvFormat
LegacyV1 -> Fail PublicKey -> PublicKey
forall a. HasCallStack => Fail a -> a
errorFail (Fail PublicKey -> PublicKey) -> Fail PublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Fail PublicKey
forall (f :: * -> *). MonadFail f => ByteString -> f PublicKey
mkPublicKey (ByteString -> Fail PublicKey) -> ByteString -> Fail PublicKey
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString -> ByteString
forall c. ByteArray c => Int -> Int -> c -> c
sub Int
secretKeySize Int
publicKeySize ByteString
eKeyBytes
    XPrvFormat
EnvelopeV2 -> (XPrvError -> PublicKey)
-> (Envelope -> PublicKey)
-> Either XPrvError Envelope
-> PublicKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PublicKey -> XPrvError -> PublicKey
forall a b. a -> b -> a
const PublicKey
forall {a}. a
badEnvelope) Envelope -> PublicKey
ePublicKey (EncryptedKey -> Either XPrvError Envelope
decodeEncryptedKey EncryptedKey
eKey)
  where
    badEnvelope :: a
badEnvelope = String -> a
forall a. HasCallStack => String -> a
error String
"encryptedPublic: invalid v2 envelope"

encryptedChainCode :: HasCallStack => EncryptedKey -> ChainCode
encryptedChainCode :: HasCallStack => EncryptedKey -> ChainCode
encryptedChainCode eKey :: EncryptedKey
eKey@(EncryptedKey ByteString
eKeyBytes) =
  case EncryptedKey -> XPrvFormat
encryptedKeyFormat EncryptedKey
eKey of
    XPrvFormat
LegacyV1 ->
      Fail ChainCode -> ChainCode
forall a. HasCallStack => Fail a -> a
errorFail (Fail ChainCode -> ChainCode) -> Fail ChainCode -> ChainCode
forall a b. (a -> b) -> a -> b
$ ByteString -> Fail ChainCode
forall (f :: * -> *). MonadFail f => ByteString -> f ChainCode
mkChainCode (ByteString -> Fail ChainCode) -> ByteString -> Fail ChainCode
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString -> ByteString
forall c. ByteArray c => Int -> Int -> c -> c
sub (Int
secretKeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
publicKeySize) Int
chainCodeSize ByteString
eKeyBytes
    XPrvFormat
EnvelopeV2 -> (XPrvError -> ChainCode)
-> (Envelope -> ChainCode)
-> Either XPrvError Envelope
-> ChainCode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ChainCode -> XPrvError -> ChainCode
forall a b. a -> b -> a
const ChainCode
forall {a}. a
badEnvelope) Envelope -> ChainCode
eChainCode (EncryptedKey -> Either XPrvError Envelope
decodeEncryptedKey EncryptedKey
eKey)
  where
    badEnvelope :: a
badEnvelope = String -> a
forall a. HasCallStack => String -> a
error String
"encryptedChainCode: invalid v2 envelope"

-- ---------------------------------------------------------------------------
-- CBOR V2 envelope codec
-- ---------------------------------------------------------------------------

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

decodeEnvelope :: Decoder s Envelope
decodeEnvelope :: forall s. Decoder s Envelope
decodeEnvelope = do
  Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
5
  Salt
salt <- Decoder s Salt
forall s. Decoder s Salt
decodeSalt
  Nonce
nonce <- Decoder s Nonce
forall s. Decoder s Nonce
decodeNonce
  ByteString
aad <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  EncSecretKey
encSecretKey <- Decoder s EncSecretKey
forall s. Decoder s EncSecretKey
decodeEncSecretKey
  Tag
tag <- Decoder s Tag
forall s. Decoder s Tag
decodeTag
  (PublicKey
pub, ChainCode
cc) <- (XPrvError -> Decoder s (PublicKey, ChainCode))
-> ((PublicKey, ChainCode) -> Decoder s (PublicKey, ChainCode))
-> Either XPrvError (PublicKey, ChainCode)
-> Decoder s (PublicKey, ChainCode)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either XPrvError -> Decoder s (PublicKey, ChainCode)
forall s a. XPrvError -> Decoder s a
failDecoder (PublicKey, ChainCode) -> Decoder s (PublicKey, ChainCode)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError (PublicKey, ChainCode)
 -> Decoder s (PublicKey, ChainCode))
-> Either XPrvError (PublicKey, ChainCode)
-> Decoder s (PublicKey, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either XPrvError (PublicKey, ChainCode)
decodeAad ByteString
aad
  Envelope -> Decoder s Envelope
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope -> Decoder s Envelope) -> Envelope -> Decoder s Envelope
forall a b. (a -> b) -> a -> b
$
    Envelope
      { eSalt :: Salt
eSalt = Salt
salt
      , eNonce :: Nonce
eNonce = Nonce
nonce
      , ePublicKey :: PublicKey
ePublicKey = PublicKey
pub
      , eChainCode :: ChainCode
eChainCode = ChainCode
cc
      , eEncSecretKey :: EncSecretKey
eEncSecretKey = EncSecretKey
encSecretKey
      , eTag :: Tag
eTag = Tag
tag
      }

encodeEnvelope :: Envelope -> Encoding
encodeEnvelope :: Envelope -> Encoding
encodeEnvelope Envelope
envelope =
  [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
    [ Word -> Encoding
encodeListLen Word
5
    , Salt -> Encoding
encodeSalt (Envelope -> Salt
eSalt Envelope
envelope)
    , Nonce -> Encoding
encodeNonce (Envelope -> Nonce
eNonce Envelope
envelope)
    , ByteString -> Encoding
encodeBytes (PublicKey -> ChainCode -> ByteString
encodeAad (Envelope -> PublicKey
ePublicKey Envelope
envelope) (Envelope -> ChainCode
eChainCode Envelope
envelope))
    , EncSecretKey -> Encoding
encodeEncSecretKey (Envelope -> EncSecretKey
eEncSecretKey Envelope
envelope)
    , Tag -> Encoding
encodeTag (Envelope -> Tag
eTag Envelope
envelope)
    ]

encodeAad :: PublicKey -> ChainCode -> ByteString
encodeAad :: PublicKey -> ChainCode -> ByteString
encodeAad PublicKey
publicKey ChainCode
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
      , Int -> Encoding
encodeInt Int
secretKeySize
      , PublicKey -> Encoding
encodePublicKey PublicKey
publicKey
      , ChainCode -> Encoding
encodeChainCode ChainCode
cc
      ]

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

decodeAadFields :: Decoder s (PublicKey, ChainCode)
decodeAadFields :: forall s. Decoder s (PublicKey, ChainCode)
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
/= forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word Int
encSecretKeySize) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
    XPrvError -> Decoder s ()
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidCiphertextLength
  ByteString
pubKeyBytes <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  ByteString
chainCodeBytes <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe PublicKey
forall (f :: * -> *). MonadFail f => ByteString -> f PublicKey
mkPublicKey ByteString
pubKeyBytes of
    Maybe PublicKey
Nothing -> XPrvError -> Decoder s (PublicKey, ChainCode)
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidPublicKey
    Just PublicKey
publicKey ->
      case ByteString -> Maybe ChainCode
forall (f :: * -> *). MonadFail f => ByteString -> f ChainCode
mkChainCode ByteString
chainCodeBytes of
        Maybe ChainCode
Nothing -> XPrvError -> Decoder s (PublicKey, ChainCode)
forall s a. XPrvError -> Decoder s a
failDecoder XPrvError
XPrvInvalidChainCode
        Just ChainCode
chainCode -> (PublicKey, ChainCode) -> Decoder s (PublicKey, ChainCode)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey
publicKey, ChainCode
chainCode)

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

withDecryptedKeyMaterial ::
  ByteArrayAccess passphrase =>
  EncryptedKey ->
  passphrase ->
  (KeyMaterial Validated -> IO (Either XPrvError a)) ->
  IO (Either XPrvError a)
withDecryptedKeyMaterial :: forall passphrase a.
ByteArrayAccess passphrase =>
EncryptedKey
-> passphrase
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withDecryptedKeyMaterial EncryptedKey
ekey passphrase
pass KeyMaterial Validated -> IO (Either XPrvError a)
action =
  case EncryptedKey -> XPrvFormat
encryptedKeyFormat EncryptedKey
ekey of
    XPrvFormat
LegacyV1 -> Either XPrvError a -> IO (Either XPrvError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError a
forall a b. a -> Either a b
Left XPrvError
XPrvDecodeError)
    XPrvFormat
EnvelopeV2 ->
      (MLockedSizedBytes ENC_SECRET_KEY_SIZE -> SecretKey)
-> (SecretKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall (n :: Nat) b c.
KnownNat n =>
(MLockedSizedBytes n -> b) -> (b -> IO c) -> IO c
mlsbCreate MLockedSizedBytes ENC_SECRET_KEY_SIZE -> SecretKey
SecretKey ((SecretKey -> IO (Either XPrvError a)) -> IO (Either XPrvError a))
-> (SecretKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \SecretKey
secretKey ->
        SecretKey
-> EncryptedKey
-> passphrase
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall passphrase.
ByteArrayAccess passphrase =>
SecretKey
-> EncryptedKey
-> passphrase
-> IO (Either XPrvError (KeyMaterial Unchecked))
decryptKeyMaterialV2 SecretKey
secretKey EncryptedKey
ekey passphrase
pass IO (Either XPrvError (KeyMaterial Unchecked))
-> (Either XPrvError (KeyMaterial Unchecked)
    -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left XPrvError
err -> Either XPrvError a -> IO (Either XPrvError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError a -> IO (Either XPrvError a))
-> Either XPrvError a -> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ XPrvError -> Either XPrvError a
forall a b. a -> Either a b
Left XPrvError
err
          Right KeyMaterial Unchecked
uncheckedKeyMaterial ->
            KeyMaterial Unchecked
-> IO (Either XPrvError (KeyMaterial Validated))
validateKeyMaterial KeyMaterial Unchecked
uncheckedKeyMaterial IO (Either XPrvError (KeyMaterial Validated))
-> (Either XPrvError (KeyMaterial Validated)
    -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Left XPrvError
err -> Either XPrvError a -> IO (Either XPrvError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError a -> IO (Either XPrvError a))
-> Either XPrvError a -> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ XPrvError -> Either XPrvError a
forall a b. a -> Either a b
Left XPrvError
err
              Right KeyMaterial Validated
keyMaterial -> KeyMaterial Validated -> IO (Either XPrvError a)
action KeyMaterial Validated
keyMaterial

decryptKeyMaterialV2 ::
  ByteArrayAccess passphrase =>
  -- | Empty SecretKey that will be populated from EncryptedKey
  SecretKey ->
  EncryptedKey ->
  passphrase ->
  IO (Either XPrvError (KeyMaterial Unchecked))
decryptKeyMaterialV2 :: forall passphrase.
ByteArrayAccess passphrase =>
SecretKey
-> EncryptedKey
-> passphrase
-> IO (Either XPrvError (KeyMaterial Unchecked))
decryptKeyMaterialV2 SecretKey
secretKey EncryptedKey
eKey passphrase
pass =
  case EncryptedKey -> Either XPrvError Envelope
decodeEncryptedKey EncryptedKey
eKey of
    Left XPrvError
err -> Either XPrvError (KeyMaterial Unchecked)
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError (KeyMaterial Unchecked)
forall a b. a -> Either a b
Left XPrvError
err)
    Right Envelope
envelope -> do
      passphrase
-> Salt
-> (WrappingKey -> IO (Either XPrvError (KeyMaterial Unchecked)))
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall passphrase a.
ByteArrayAccess passphrase =>
passphrase
-> Salt
-> (WrappingKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withWrappingKey passphrase
pass (Envelope -> Salt
eSalt Envelope
envelope) ((WrappingKey -> IO (Either XPrvError (KeyMaterial Unchecked)))
 -> IO (Either XPrvError (KeyMaterial Unchecked)))
-> (WrappingKey -> IO (Either XPrvError (KeyMaterial Unchecked)))
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall a b. (a -> b) -> a -> b
$ \WrappingKey
wrappingKey -> do
        let aad :: ByteString
aad = PublicKey -> ChainCode -> ByteString
encodeAad (Envelope -> PublicKey
ePublicKey Envelope
envelope) (Envelope -> ChainCode
eChainCode Envelope
envelope)
        CDerivationScheme
status <-
          SecretKey
-> (SecretKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a. SecretKey -> (SecretKeyPtr -> IO a) -> IO a
withSecretKeyPtr SecretKey
secretKey ((SecretKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (SecretKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \SecretKeyPtr
secretKeyPtr ->
            EncSecretKey
-> (EncSecretKeyPtr -> IO CDerivationScheme)
-> IO CDerivationScheme
forall a. EncSecretKey -> (EncSecretKeyPtr -> IO a) -> IO a
withEncSecretKeyPtr (Envelope -> EncSecretKey
eEncSecretKey Envelope
envelope) ((EncSecretKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (EncSecretKeyPtr -> IO CDerivationScheme)
-> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \EncSecretKeyPtr
encSecretKeyPtr ->
              Tag -> (TagPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a. Tag -> (TagPtr -> IO a) -> IO a
withTagPtr (Envelope -> Tag
eTag Envelope
envelope) ((TagPtr -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (TagPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \TagPtr
tagPtr ->
                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 ->
                  Nonce -> (NoncePtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a. Nonce -> (NoncePtr -> IO a) -> IO a
withNoncePtr (Envelope -> Nonce
eNonce Envelope
envelope) ((NoncePtr -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (NoncePtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \NoncePtr
noncePtr ->
                    WrappingKey
-> (WrappingKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a. WrappingKey -> (WrappingKeyPtr -> IO a) -> IO a
withWrappingKeyPtr WrappingKey
wrappingKey ((WrappingKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (WrappingKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \WrappingKeyPtr
wrappingKeyPtr ->
                      SecretKeyPtr
-> EncSecretKeyPtr
-> TagPtr
-> Ptr Word8
-> CULLong
-> NoncePtr
-> WrappingKeyPtr
-> IO CDerivationScheme
wallet_xchacha20poly1305_decrypt
                        SecretKeyPtr
secretKeyPtr
                        EncSecretKeyPtr
encSecretKeyPtr
                        TagPtr
tagPtr
                        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)
                        NoncePtr
noncePtr
                        WrappingKeyPtr
wrappingKeyPtr
        if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
          then
            Either XPrvError (KeyMaterial Unchecked)
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError (KeyMaterial Unchecked)
 -> IO (Either XPrvError (KeyMaterial Unchecked)))
-> Either XPrvError (KeyMaterial Unchecked)
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall a b. (a -> b) -> a -> b
$ XPrvError -> Either XPrvError (KeyMaterial Unchecked)
forall a b. a -> Either a b
Left XPrvError
XPrvAuthenticationFailed
          else
            Either XPrvError (KeyMaterial Unchecked)
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError (KeyMaterial Unchecked)
 -> IO (Either XPrvError (KeyMaterial Unchecked)))
-> Either XPrvError (KeyMaterial Unchecked)
-> IO (Either XPrvError (KeyMaterial Unchecked))
forall a b. (a -> b) -> a -> b
$
              KeyMaterial Unchecked -> Either XPrvError (KeyMaterial Unchecked)
forall a b. b -> Either a b
Right (KeyMaterial Unchecked -> Either XPrvError (KeyMaterial Unchecked))
-> KeyMaterial Unchecked
-> Either XPrvError (KeyMaterial Unchecked)
forall a b. (a -> b) -> a -> b
$
                KeyMaterial
                  { kmSecretKey :: SecretKey
kmSecretKey = SecretKey
secretKey
                  , kmPublicKey :: PublicKey
kmPublicKey = Envelope -> PublicKey
ePublicKey Envelope
envelope
                  , kmChainCode :: ChainCode
kmChainCode = Envelope -> ChainCode
eChainCode Envelope
envelope
                  }

wrapKeyMaterial ::
  ByteArrayAccess passphrase =>
  passphrase -> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial :: forall passphrase.
ByteArrayAccess passphrase =>
passphrase
-> KeyMaterial Validated -> IO (Either XPrvError EncryptedKey)
wrapKeyMaterial passphrase
pass KeyMaterial {SecretKey
kmSecretKey :: forall (v :: Validity). KeyMaterial v -> SecretKey
kmSecretKey :: SecretKey
kmSecretKey, PublicKey
kmPublicKey :: forall (v :: Validity). KeyMaterial v -> PublicKey
kmPublicKey :: PublicKey
kmPublicKey, ChainCode
kmChainCode :: forall (v :: Validity). KeyMaterial v -> ChainCode
kmChainCode :: ChainCode
kmChainCode} = do
  Either XPrvError Salt
eSalt <- (PinnedSizedBytes WRAPPING_KEY_SIZE -> Salt)
-> Either XPrvError (PinnedSizedBytes WRAPPING_KEY_SIZE)
-> Either XPrvError Salt
forall a b. (a -> b) -> Either XPrvError a -> Either XPrvError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PinnedSizedBytes WRAPPING_KEY_SIZE -> Salt
Salt (Either XPrvError (PinnedSizedBytes WRAPPING_KEY_SIZE)
 -> Either XPrvError Salt)
-> IO (Either XPrvError (PinnedSizedBytes WRAPPING_KEY_SIZE))
-> IO (Either XPrvError Salt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either XPrvError (PinnedSizedBytes WRAPPING_KEY_SIZE))
forall (n :: Nat).
KnownNat n =>
IO (Either XPrvError (PinnedSizedBytes n))
randomBytesIO
  Either XPrvError Nonce
eNonce <- (PinnedSizedBytes NONCE_SIZE -> Nonce)
-> Either XPrvError (PinnedSizedBytes NONCE_SIZE)
-> Either XPrvError Nonce
forall a b. (a -> b) -> Either XPrvError a -> Either XPrvError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PinnedSizedBytes NONCE_SIZE -> Nonce
Nonce (Either XPrvError (PinnedSizedBytes NONCE_SIZE)
 -> Either XPrvError Nonce)
-> IO (Either XPrvError (PinnedSizedBytes NONCE_SIZE))
-> IO (Either XPrvError Nonce)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either XPrvError (PinnedSizedBytes NONCE_SIZE))
forall (n :: Nat).
KnownNat n =>
IO (Either XPrvError (PinnedSizedBytes n))
randomBytesIO
  case (,) (Salt -> Nonce -> (Salt, Nonce))
-> Either XPrvError Salt
-> Either XPrvError (Nonce -> (Salt, Nonce))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either XPrvError Salt
eSalt Either XPrvError (Nonce -> (Salt, Nonce))
-> Either XPrvError Nonce -> Either XPrvError (Salt, Nonce)
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 Nonce
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 (Salt
salt, Nonce
nonce) -> do
      passphrase
-> Salt
-> (WrappingKey -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall passphrase a.
ByteArrayAccess passphrase =>
passphrase
-> Salt
-> (WrappingKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withWrappingKey passphrase
pass Salt
salt ((WrappingKey -> IO (Either XPrvError EncryptedKey))
 -> IO (Either XPrvError EncryptedKey))
-> (WrappingKey -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ \WrappingKey
wrappingKey -> do
        let aad :: ByteString
aad = PublicKey -> ChainCode -> ByteString
encodeAad PublicKey
kmPublicKey ChainCode
kmChainCode
        SecretKey
-> (SecretKeyPtr -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a. SecretKey -> (SecretKeyPtr -> IO a) -> IO a
withSecretKeyPtr SecretKey
kmSecretKey ((SecretKeyPtr -> IO (Either XPrvError EncryptedKey))
 -> IO (Either XPrvError EncryptedKey))
-> (SecretKeyPtr -> IO (Either XPrvError EncryptedKey))
-> IO (Either XPrvError EncryptedKey)
forall a b. (a -> b) -> a -> b
$ \SecretKeyPtr
skPtr -> do
          (EncSecretKey
encSecretKey, (Tag
tag, CDerivationScheme
status)) <-
            ((PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme))
 -> (EncSecretKey, (Tag, CDerivationScheme)))
-> IO
     (PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme))
-> IO (EncSecretKey, (Tag, CDerivationScheme))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PinnedSizedBytes ENC_SECRET_KEY_SIZE -> EncSecretKey)
-> (PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme))
-> (EncSecretKey, (Tag, CDerivationScheme))
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first PinnedSizedBytes ENC_SECRET_KEY_SIZE -> EncSecretKey
EncSecretKey) (IO
   (PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme))
 -> IO (EncSecretKey, (Tag, CDerivationScheme)))
-> IO
     (PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme))
-> IO (EncSecretKey, (Tag, CDerivationScheme))
forall a b. (a -> b) -> a -> b
$ (Ptr Word8 -> IO (Tag, CDerivationScheme))
-> IO
     (PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme))
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m r) -> m (PinnedSizedBytes n, r)
psbCreateResult ((Ptr Word8 -> IO (Tag, CDerivationScheme))
 -> IO
      (PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme)))
-> (Ptr Word8 -> IO (Tag, CDerivationScheme))
-> IO
     (PinnedSizedBytes ENC_SECRET_KEY_SIZE, (Tag, CDerivationScheme))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outEncSecretKey ->
              ((PinnedSizedBytes TAG_SIZE, CDerivationScheme)
 -> (Tag, CDerivationScheme))
-> IO (PinnedSizedBytes TAG_SIZE, CDerivationScheme)
-> IO (Tag, CDerivationScheme)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PinnedSizedBytes TAG_SIZE -> Tag)
-> (PinnedSizedBytes TAG_SIZE, CDerivationScheme)
-> (Tag, CDerivationScheme)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first PinnedSizedBytes TAG_SIZE -> Tag
Tag) (IO (PinnedSizedBytes TAG_SIZE, CDerivationScheme)
 -> IO (Tag, CDerivationScheme))
-> IO (PinnedSizedBytes TAG_SIZE, CDerivationScheme)
-> IO (Tag, CDerivationScheme)
forall a b. (a -> b) -> a -> b
$ (Ptr Word8 -> IO CDerivationScheme)
-> IO (PinnedSizedBytes TAG_SIZE, CDerivationScheme)
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m r) -> m (PinnedSizedBytes n, r)
psbCreateResult ((Ptr Word8 -> IO CDerivationScheme)
 -> IO (PinnedSizedBytes TAG_SIZE, CDerivationScheme))
-> (Ptr Word8 -> IO CDerivationScheme)
-> IO (PinnedSizedBytes TAG_SIZE, CDerivationScheme)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outTagPtr ->
                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 ->
                  Nonce -> (NoncePtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a. Nonce -> (NoncePtr -> IO a) -> IO a
withNoncePtr Nonce
nonce ((NoncePtr -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (NoncePtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \NoncePtr
noncePtr ->
                    WrappingKey
-> (WrappingKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a. WrappingKey -> (WrappingKeyPtr -> IO a) -> IO a
withWrappingKeyPtr WrappingKey
wrappingKey ((WrappingKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme)
-> (WrappingKeyPtr -> IO CDerivationScheme) -> IO CDerivationScheme
forall a b. (a -> b) -> a -> b
$ \WrappingKeyPtr
wrappingKeyPtr -> do
                      Ptr Word8 -> CSize -> IO ()
forall (m :: * -> *) a. MonadST m => Ptr a -> CSize -> m ()
zeroMem Ptr Word8
outTagPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
tagSize)
                      EncSecretKeyPtr
-> TagPtr
-> SecretKeyPtr
-> Ptr Word8
-> CULLong
-> NoncePtr
-> WrappingKeyPtr
-> IO CDerivationScheme
wallet_xchacha20poly1305_encrypt
                        (Ptr Word8 -> EncSecretKeyPtr
EncSecretKeyPtr Ptr Word8
outEncSecretKey)
                        (Ptr Word8 -> TagPtr
TagPtr Ptr Word8
outTagPtr)
                        SecretKeyPtr
skPtr
                        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)
                        NoncePtr
noncePtr
                        WrappingKeyPtr
wrappingKeyPtr
          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
$
                    Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
                      Envelope -> Encoding
encodeEnvelope (Envelope -> Encoding) -> Envelope -> Encoding
forall a b. (a -> b) -> a -> b
$
                        Envelope
                          { eSalt :: Salt
eSalt = Salt
salt
                          , eNonce :: Nonce
eNonce = Nonce
nonce
                          , ePublicKey :: PublicKey
ePublicKey = PublicKey
kmPublicKey
                          , eChainCode :: ChainCode
eChainCode = ChainCode
kmChainCode
                          , eEncSecretKey :: EncSecretKey
eEncSecretKey = EncSecretKey
encSecretKey
                          , eTag :: Tag
eTag = Tag
tag
                          }

-- | Verify that associated public key matches the secret key in the `KeyMaterial`
validateKeyMaterial :: KeyMaterial Unchecked -> IO (Either XPrvError (KeyMaterial Validated))
validateKeyMaterial :: KeyMaterial Unchecked
-> IO (Either XPrvError (KeyMaterial Validated))
validateKeyMaterial KeyMaterial {ChainCode
PublicKey
SecretKey
kmSecretKey :: forall (v :: Validity). KeyMaterial v -> SecretKey
kmPublicKey :: forall (v :: Validity). KeyMaterial v -> PublicKey
kmChainCode :: forall (v :: Validity). KeyMaterial v -> ChainCode
kmSecretKey :: SecretKey
kmPublicKey :: PublicKey
kmChainCode :: ChainCode
..} =
  SecretKey
-> (SecretKeyPtr -> IO (Either XPrvError (KeyMaterial Validated)))
-> IO (Either XPrvError (KeyMaterial Validated))
forall a. SecretKey -> (SecretKeyPtr -> IO a) -> IO a
withSecretKeyPtr SecretKey
kmSecretKey ((SecretKeyPtr -> IO (Either XPrvError (KeyMaterial Validated)))
 -> IO (Either XPrvError (KeyMaterial Validated)))
-> (SecretKeyPtr -> IO (Either XPrvError (KeyMaterial Validated)))
-> IO (Either XPrvError (KeyMaterial Validated))
forall a b. (a -> b) -> a -> b
$ \SecretKeyPtr
secretKeyPtr -> do
    PublicKey
-> (PublicKeyPtr -> IO (Either XPrvError (KeyMaterial Validated)))
-> IO (Either XPrvError (KeyMaterial Validated))
forall a. PublicKey -> (PublicKeyPtr -> IO a) -> IO a
withPublicKeyPtr PublicKey
kmPublicKey ((PublicKeyPtr -> IO (Either XPrvError (KeyMaterial Validated)))
 -> IO (Either XPrvError (KeyMaterial Validated)))
-> (PublicKeyPtr -> IO (Either XPrvError (KeyMaterial Validated)))
-> IO (Either XPrvError (KeyMaterial Validated))
forall a b. (a -> b) -> a -> b
$ \PublicKeyPtr
publicKeyPtr -> do
      CDerivationScheme
r <- SecretKeyPtr -> PublicKeyPtr -> IO CDerivationScheme
wallet_validate SecretKeyPtr
secretKeyPtr PublicKeyPtr
publicKeyPtr
      Either XPrvError (KeyMaterial Validated)
-> IO (Either XPrvError (KeyMaterial Validated))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError (KeyMaterial Validated)
 -> IO (Either XPrvError (KeyMaterial Validated)))
-> Either XPrvError (KeyMaterial Validated)
-> IO (Either XPrvError (KeyMaterial Validated))
forall a b. (a -> b) -> a -> b
$
        if CDerivationScheme
r CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
          then XPrvError -> Either XPrvError (KeyMaterial Validated)
forall a b. a -> Either a b
Left XPrvError
XPrvPublicKeyMismatch
          else KeyMaterial Validated -> Either XPrvError (KeyMaterial Validated)
forall a b. b -> Either a b
Right (KeyMaterial {ChainCode
PublicKey
SecretKey
kmSecretKey :: SecretKey
kmPublicKey :: PublicKey
kmChainCode :: ChainCode
kmSecretKey :: SecretKey
kmPublicKey :: PublicKey
kmChainCode :: ChainCode
..})

-- ---------------------------------------------------------------------------
-- 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).
withKeyMaterialPtr :: KeyMaterial v -> (KeyMaterialPtr -> IO r) -> IO r
withKeyMaterialPtr :: forall (v :: Validity) r.
KeyMaterial v -> (KeyMaterialPtr -> IO r) -> IO r
withKeyMaterialPtr KeyMaterial {SecretKey
kmSecretKey :: forall (v :: Validity). KeyMaterial v -> SecretKey
kmSecretKey :: SecretKey
kmSecretKey, PublicKey
kmPublicKey :: forall (v :: Validity). KeyMaterial v -> PublicKey
kmPublicKey :: PublicKey
kmPublicKey, ChainCode
kmChainCode :: forall (v :: Validity). KeyMaterial v -> ChainCode
kmChainCode :: ChainCode
kmChainCode} KeyMaterialPtr -> IO r
action =
  (KeyMaterialPtr -> IO r) -> IO r
forall c. (KeyMaterialPtr -> IO c) -> IO c
allocaKeyMaterialBuffer ((KeyMaterialPtr -> IO r) -> IO r)
-> (KeyMaterialPtr -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \ptr :: KeyMaterialPtr
ptr@(KeyMaterialPtr Ptr Word8
keyMaterialPtr) -> do
    SecretKey -> (SecretKeyPtr -> IO ()) -> IO ()
forall a. SecretKey -> (SecretKeyPtr -> IO a) -> IO a
withSecretKeyPtr SecretKey
kmSecretKey ((SecretKeyPtr -> IO ()) -> IO ())
-> (SecretKeyPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SecretKeyPtr Ptr Word8
skPtr) ->
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
keyMaterialPtr Ptr Word8
skPtr Int
secretKeySize
    PublicKey -> (PublicKeyPtr -> IO ()) -> IO ()
forall a. PublicKey -> (PublicKeyPtr -> IO a) -> IO a
withPublicKeyPtr PublicKey
kmPublicKey ((PublicKeyPtr -> IO ()) -> IO ())
-> (PublicKeyPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(PublicKeyPtr Ptr Word8
pkPtr) ->
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr Word8
keyMaterialPtr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
secretKeySize) Ptr Word8
pkPtr Int
publicKeySize
    ChainCode -> (ChainCodePtr -> IO ()) -> IO ()
forall a. ChainCode -> (ChainCodePtr -> IO a) -> IO a
withChainCodePtr ChainCode
kmChainCode ((ChainCodePtr -> IO ()) -> IO ())
-> (ChainCodePtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ChainCodePtr Ptr Word8
ccPtr) ->
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr Word8
keyMaterialPtr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
secretKeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
publicKeySize)) Ptr Word8
ccPtr Int
chainCodeSize
    KeyMaterialPtr -> IO r
action KeyMaterialPtr
ptr

-- | 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'.
withNewKeyMaterial ::
  XPrvError ->
  -- | Action that will use the newly populated `KeyMaterial`
  (KeyMaterial Validated -> IO (Either XPrvError a)) ->
  -- | Action that will populate `KeyMaterialPtr` on the C-side, after which it
  -- will usable in the `KeyMaterial` for the action above
  (KeyMaterialPtr -> IO CInt) ->
  IO (Either XPrvError a)
withNewKeyMaterial :: forall a.
XPrvError
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
withNewKeyMaterial XPrvError
onFailure KeyMaterial Validated -> IO (Either XPrvError a)
keyMaterialAction KeyMaterialPtr -> IO CDerivationScheme
fillKeyMaterialPtrAction =
  (KeyMaterialPtr -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall c. (KeyMaterialPtr -> IO c) -> IO c
allocaKeyMaterialBuffer ((KeyMaterialPtr -> IO (Either XPrvError a))
 -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \keyMaterialPtr :: KeyMaterialPtr
keyMaterialPtr@(KeyMaterialPtr Ptr Word8
inPtr) -> do
    CDerivationScheme
r <- KeyMaterialPtr -> IO CDerivationScheme
fillKeyMaterialPtrAction KeyMaterialPtr
keyMaterialPtr
    if CDerivationScheme
r CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
/= CDerivationScheme
0
      then Either XPrvError a -> IO (Either XPrvError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrvError -> Either XPrvError a
forall a b. a -> Either a b
Left XPrvError
onFailure)
      else (MLockedSizedBytes ENC_SECRET_KEY_SIZE -> SecretKey)
-> (SecretKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall (n :: Nat) b c.
KnownNat n =>
(MLockedSizedBytes n -> b) -> (b -> IO c) -> IO c
mlsbCreate MLockedSizedBytes ENC_SECRET_KEY_SIZE -> SecretKey
SecretKey ((SecretKey -> IO (Either XPrvError a)) -> IO (Either XPrvError a))
-> (SecretKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \SecretKey
secretKey -> do
        SecretKey -> (SecretKeyPtr -> IO ()) -> IO ()
forall a. SecretKey -> (SecretKeyPtr -> IO a) -> IO a
withSecretKeyPtr SecretKey
secretKey ((SecretKeyPtr -> IO ()) -> IO ())
-> (SecretKeyPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SecretKeyPtr Ptr Word8
skPtr) -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
skPtr Ptr Word8
inPtr Int
secretKeySize
        PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey <-
          (Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m ()) -> m (PinnedSizedBytes n)
psbCreate ((Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE))
-> (Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pkPtr ->
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
pkPtr (Ptr Word8
inPtr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
secretKeySize) Int
publicKeySize
        PinnedSizedBytes WRAPPING_KEY_SIZE
chainCode <-
          (Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE)
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m ()) -> m (PinnedSizedBytes n)
psbCreate ((Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE))
-> (Ptr Word8 -> IO ()) -> IO (PinnedSizedBytes WRAPPING_KEY_SIZE)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ccPtr ->
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
ccPtr (Ptr Word8
inPtr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
secretKeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
publicKeySize)) Int
chainCodeSize
        Either XPrvError (KeyMaterial Validated)
eKeyMaterial <-
          KeyMaterial Unchecked
-> IO (Either XPrvError (KeyMaterial Validated))
validateKeyMaterial (KeyMaterial Unchecked
 -> IO (Either XPrvError (KeyMaterial Validated)))
-> KeyMaterial Unchecked
-> IO (Either XPrvError (KeyMaterial Validated))
forall a b. (a -> b) -> a -> b
$
            KeyMaterial
              { kmSecretKey :: SecretKey
kmSecretKey = SecretKey
secretKey
              , kmPublicKey :: PublicKey
kmPublicKey = PinnedSizedBytes WRAPPING_KEY_SIZE -> PublicKey
PublicKey PinnedSizedBytes WRAPPING_KEY_SIZE
publicKey
              , kmChainCode :: ChainCode
kmChainCode = PinnedSizedBytes WRAPPING_KEY_SIZE -> ChainCode
ChainCode PinnedSizedBytes WRAPPING_KEY_SIZE
chainCode
              }
        case Either XPrvError (KeyMaterial Validated)
eKeyMaterial of
          Left XPrvError
err -> Either XPrvError a -> IO (Either XPrvError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError a -> IO (Either XPrvError a))
-> Either XPrvError a -> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ XPrvError -> Either XPrvError a
forall a b. a -> Either a b
Left XPrvError
err
          Right KeyMaterial Validated
keyMaterial -> KeyMaterial Validated -> IO (Either XPrvError a)
keyMaterialAction KeyMaterial Validated
keyMaterial

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

legacyMaterialFromSecret ::
  (ByteArrayAccess secret, ByteArrayAccess cc) =>
  secret ->
  cc ->
  (KeyMaterial Validated -> IO (Either XPrvError a)) ->
  IO (Either XPrvError a)
legacyMaterialFromSecret :: forall secret cc a.
(ByteArrayAccess secret, ByteArrayAccess cc) =>
secret
-> cc
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
legacyMaterialFromSecret secret
sec cc
cc KeyMaterial Validated -> IO (Either XPrvError a)
action =
  XPrvError
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
forall a.
XPrvError
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
withNewKeyMaterial XPrvError
XPrvInvalidSecretKey KeyMaterial Validated -> IO (Either XPrvError a)
action ((KeyMaterialPtr -> IO CDerivationScheme)
 -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \KeyMaterialPtr
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 -> KeyMaterialPtr -> IO CDerivationScheme
wallet_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) KeyMaterialPtr
outPtr

legacyMaterialFromMasterKey ::
  ByteArrayAccess secret =>
  secret ->
  (KeyMaterial Validated -> IO (Either XPrvError a)) ->
  IO (Either XPrvError a)
legacyMaterialFromMasterKey :: forall secret a.
ByteArrayAccess secret =>
secret
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
legacyMaterialFromMasterKey secret
sec KeyMaterial Validated -> IO (Either XPrvError a)
action =
  XPrvError
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
forall a.
XPrvError
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
withNewKeyMaterial XPrvError
XPrvInvalidSecretKey KeyMaterial Validated -> IO (Either XPrvError a)
action ((KeyMaterialPtr -> IO CDerivationScheme)
 -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \KeyMaterialPtr
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 -> KeyMaterialPtr -> IO CDerivationScheme
wallet_new_from_mkg (Ptr Word8 -> MasterKeyPtr
MasterKeyPtr Ptr Word8
psec) KeyMaterialPtr
outPtr

legacyDerivePrivate ::
  DerivationScheme ->
  KeyMaterial Validated ->
  DerivationIndex ->
  (KeyMaterial Validated -> IO (Either XPrvError a)) ->
  IO (Either XPrvError a)
legacyDerivePrivate :: forall a.
DerivationScheme
-> KeyMaterial Validated
-> DerivationIndex
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
legacyDerivePrivate DerivationScheme
dscheme KeyMaterial Validated
parent DerivationIndex
childIndex KeyMaterial Validated -> IO (Either XPrvError a)
action =
  KeyMaterial Validated
-> (KeyMaterialPtr -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall (v :: Validity) r.
KeyMaterial v -> (KeyMaterialPtr -> IO r) -> IO r
withKeyMaterialPtr KeyMaterial Validated
parent ((KeyMaterialPtr -> IO (Either XPrvError a))
 -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \KeyMaterialPtr
inPtr ->
    XPrvError
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
forall a.
XPrvError
-> (KeyMaterial Validated -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
withNewKeyMaterial XPrvError
XPrvInternalError KeyMaterial Validated -> IO (Either XPrvError a)
action ((KeyMaterialPtr -> IO CDerivationScheme)
 -> IO (Either XPrvError a))
-> (KeyMaterialPtr -> IO CDerivationScheme)
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \KeyMaterialPtr
outPtr ->
      KeyMaterialPtr
-> DerivationIndex
-> KeyMaterialPtr
-> CDerivationScheme
-> IO CDerivationScheme
wallet_derive_private KeyMaterialPtr
inPtr DerivationIndex
childIndex KeyMaterialPtr
outPtr (DerivationScheme -> CDerivationScheme
dschemeToC DerivationScheme
dscheme)

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

withWrappingKey ::
  ByteArrayAccess passphrase =>
  passphrase -> Salt -> (WrappingKey -> IO (Either XPrvError a)) -> IO (Either XPrvError a)
withWrappingKey :: forall passphrase a.
ByteArrayAccess passphrase =>
passphrase
-> Salt
-> (WrappingKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
withWrappingKey passphrase
pass Salt
salt WrappingKey -> IO (Either XPrvError a)
action = do
  KdfParams
params <- IO KdfParams
readRuntimeKdfParams
  let memBytes :: CSize
memBytes = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @CSize (KdfParams -> Word
kdfMemoryKiB KdfParams
params)) CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
* CSize
1024
      passLen :: CULLong
passLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong (passphrase -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length passphrase
pass)
      timeCost :: CULLong
timeCost = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @CULLong (KdfParams -> Word
kdfTimeCost KdfParams
params)
  (MLockedSizedBytes WRAPPING_KEY_SIZE -> WrappingKey)
-> (WrappingKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall (n :: Nat) b c.
KnownNat n =>
(MLockedSizedBytes n -> b) -> (b -> IO c) -> IO c
mlsbCreate MLockedSizedBytes WRAPPING_KEY_SIZE -> WrappingKey
WrappingKey ((WrappingKey -> IO (Either XPrvError a))
 -> IO (Either XPrvError a))
-> (WrappingKey -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \WrappingKey
wrappingKey ->
    WrappingKey
-> (WrappingKeyPtr -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a. WrappingKey -> (WrappingKeyPtr -> IO a) -> IO a
withWrappingKeyPtr WrappingKey
wrappingKey ((WrappingKeyPtr -> IO (Either XPrvError a))
 -> IO (Either XPrvError a))
-> (WrappingKeyPtr -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \WrappingKeyPtr
outWrappingKeyPtr ->
      passphrase
-> (Ptr Word8 -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
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 Word8 -> IO (Either XPrvError a)) -> IO (Either XPrvError a))
-> (Ptr Word8 -> IO (Either XPrvError a))
-> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
passPtr ->
        Salt
-> (SaltPtr -> IO (Either XPrvError a)) -> IO (Either XPrvError a)
forall a. Salt -> (SaltPtr -> IO a) -> IO a
withSaltPtr Salt
salt ((SaltPtr -> IO (Either XPrvError a)) -> IO (Either XPrvError a))
-> (SaltPtr -> IO (Either XPrvError a)) -> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ \SaltPtr
saltPtr -> do
          CDerivationScheme
status <-
            WrappingKeyPtr
-> PassPhrasePtr
-> CULLong
-> SaltPtr
-> CULLong
-> CSize
-> IO CDerivationScheme
wallet_argon2id WrappingKeyPtr
outWrappingKeyPtr (Ptr Word8 -> PassPhrasePtr
PassPhrasePtr Ptr Word8
passPtr) CULLong
passLen SaltPtr
saltPtr CULLong
timeCost CSize
memBytes
          if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
== CDerivationScheme
0
            then
              WrappingKey -> IO (Either XPrvError a)
action WrappingKey
wrappingKey
            else
              Either XPrvError a -> IO (Either XPrvError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError a -> IO (Either XPrvError a))
-> Either XPrvError a -> IO (Either XPrvError a)
forall a b. (a -> b) -> a -> b
$ XPrvError -> Either XPrvError a
forall a b. a -> Either a b
Left XPrvError
XPrvInternalError

randomBytesIO :: KnownNat n => IO (Either XPrvError (PinnedSizedBytes n))
randomBytesIO :: forall (n :: Nat).
KnownNat n =>
IO (Either XPrvError (PinnedSizedBytes n))
randomBytesIO = do
  RandomMode
mode <- IORef RandomMode -> IO RandomMode
forall a. IORef a -> IO a
readIORef IORef RandomMode
randomModeRef
  case RandomMode
mode of
    RandomMode
SystemRandom -> do
      (PinnedSizedBytes n
bytes, CDerivationScheme
status) <- (Ptr Word8 -> CSize -> IO CDerivationScheme)
-> IO (PinnedSizedBytes n, CDerivationScheme)
forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> CSize -> m r) -> m (PinnedSizedBytes n, r)
psbCreateResultLen Ptr Word8 -> CSize -> IO CDerivationScheme
forall a. Ptr a -> CSize -> IO CDerivationScheme
wallet_randombytes
      Either XPrvError (PinnedSizedBytes n)
-> IO (Either XPrvError (PinnedSizedBytes n))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPrvError (PinnedSizedBytes n)
 -> IO (Either XPrvError (PinnedSizedBytes n)))
-> Either XPrvError (PinnedSizedBytes n)
-> IO (Either XPrvError (PinnedSizedBytes n))
forall a b. (a -> b) -> a -> b
$ if CDerivationScheme
status CDerivationScheme -> CDerivationScheme -> Bool
forall a. Eq a => a -> a -> Bool
== CDerivationScheme
0 then PinnedSizedBytes n -> Either XPrvError (PinnedSizedBytes n)
forall a b. b -> Either a b
Right PinnedSizedBytes n
bytes else XPrvError -> Either XPrvError (PinnedSizedBytes n)
forall a b. a -> Either a b
Left XPrvError
XPrvInternalError
    DeterministicRandom Word64
counter -> do
      let
        len :: Int
len = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (PinnedSizedBytes n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal PinnedSizedBytes n
bytes)
        bytes :: PinnedSizedBytes n
bytes = ByteString -> PinnedSizedBytes n
forall (n :: Nat).
(HasCallStack, KnownNat n) =>
ByteString -> PinnedSizedBytes n
psbFromByteString (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 (PinnedSizedBytes n)
-> IO (Either XPrvError (PinnedSizedBytes n))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PinnedSizedBytes n -> Either XPrvError (PinnedSizedBytes n)
forall a b. b -> Either a b
Right PinnedSizedBytes n
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
        [ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 Word64
counter
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (Word64
counter Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
        , forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word8 (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_crypto_wallet_from_secret"
  wallet_from_secret ::
    SecretKeyPtr ->
    ChainCodePtr ->
    KeyMaterialPtr ->
    IO CInt

foreign import ccall "cardano_crypto_wallet_new_from_mkg"
  wallet_new_from_mkg ::
    MasterKeyPtr ->
    KeyMaterialPtr ->
    IO CInt

foreign import ccall "cardano_crypto_wallet_validate"
  wallet_validate ::
    SecretKeyPtr ->
    PublicKeyPtr ->
    IO CInt

foreign import ccall "cardano_crypto_wallet_sign"
  wallet_sign ::
    KeyMaterialPtr ->
    Ptr Word8 ->
    CSize ->
    SignaturePtr ->
    IO CInt

foreign import ccall "cardano_crypto_wallet_derive_private"
  wallet_derive_private ::
    KeyMaterialPtr ->
    DerivationIndex ->
    KeyMaterialPtr ->
    CDerivationScheme ->
    IO CInt

foreign import ccall "cardano_crypto_wallet_derive_public"
  wallet_derive_public ::
    PublicKeyPtr ->
    ChainCodePtr ->
    DerivationIndex ->
    PublicKeyPtr ->
    ChainCodePtr ->
    CDerivationScheme ->
    IO CInt

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

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

foreign import ccall "cardano_crypto_wallet_xchacha20poly1305_encrypt"
  wallet_xchacha20poly1305_encrypt ::
    EncSecretKeyPtr ->
    TagPtr ->
    SecretKeyPtr ->
    Ptr Word8 ->
    CULLong ->
    NoncePtr ->
    WrappingKeyPtr ->
    IO CInt

foreign import ccall "cardano_crypto_wallet_xchacha20poly1305_decrypt"
  wallet_xchacha20poly1305_decrypt ::
    SecretKeyPtr ->
    EncSecretKeyPtr ->
    TagPtr ->
    Ptr Word8 ->
    CULLong ->
    NoncePtr ->
    WrappingKeyPtr ->
    IO CInt