mirror of https://github.com/voidlizard/hbs2
54 lines
1.4 KiB
Haskell
54 lines
1.4 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
{-# Language UndecidableInstances #-}
|
|
module HBS2.Net.Auth.Schema where
|
|
|
|
import HBS2.Prelude
|
|
import HBS2.OrDie
|
|
import HBS2.Net.Proto.Types
|
|
import HBS2.Hash
|
|
import HBS2.Net.Messaging.Unix
|
|
|
|
import Data.Word
|
|
import Crypto.Error
|
|
import Crypto.PubKey.Ed25519 qualified as Ed
|
|
import Crypto.KDF.HKDF qualified as HKDF
|
|
import Crypto.Saltine.Class qualified as Saltine
|
|
import Crypto.Saltine.Class (IsEncoding(..))
|
|
import Codec.Serialise
|
|
import Data.ByteString.Lazy qualified as LBS
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteArray ( convert)
|
|
|
|
data HBS2Basic
|
|
|
|
type instance Encryption L4Proto = HBS2Basic
|
|
|
|
type instance Encryption UNIX = HBS2Basic
|
|
|
|
|
|
type ForDerivedKey s = (IsEncoding (PrivKey 'Sign s), IsEncoding (PubKey 'Sign s))
|
|
|
|
instance (MonadIO m, ForDerivedKey s, s ~ HBS2Basic) => HasDerivedKey s 'Sign Word64 m where
|
|
derivedKey nonce sk = do
|
|
|
|
sk0 <- liftIO $ throwCryptoErrorIO (Ed.secretKey k0)
|
|
let pk0 = Ed.toPublic sk0
|
|
|
|
let bs0 = convert sk0 :: ByteString
|
|
let bs1 = convert pk0 :: ByteString
|
|
|
|
sk1 <- Saltine.decode (bs0 <> bs1)
|
|
& orThrow CryptoError_SecretKeySizeInvalid
|
|
|
|
pk1 <- Saltine.decode bs1
|
|
& orThrow CryptoError_PublicKeySizeInvalid
|
|
|
|
pure (pk1, sk1)
|
|
|
|
where
|
|
ikm = Saltine.encode sk
|
|
salt = LBS.toStrict (serialise nonce)
|
|
prk = HKDF.extract @(HashType HbSync) salt ikm
|
|
k0 = HKDF.expand @_ @_ @ByteString prk salt Ed.secretKeySize
|
|
|