Merge pull request #21 from futrnostr/nip44

NIP44 Encryption / Decryption

.github/workflows/tests.yml

@@ -49,6 +49,8 @@ jobs:
           make && \
           sudo make install && \
           cd ..
+      - name: Set Library Path
+        run: echo "/usr/local/lib" | sudo tee /etc/ld.so.conf.d/local.conf && sudo ldconfig
       - name: Configure
         run: cabal configure --enable-tests
       - name: Cache
@@ -59,3 +61,6 @@ jobs:
           restore-keys: ${{ runner.os }}-ghc-${{ matrix.ghc }}-
       - name: Build
         run: cabal build all
+      - name: Test
+        run: cabal run futr-tests
+

cabal.project

@@ -1,11 +1,12 @@
 packages:
     ./
+tests: True
 
 source-repository-package
   type: git
-  location: https://github.com/haskell-bitcoin/libsecp256k1-haskell
+  location: https://github.com/prolic/HsQML/
+  tag: aa599366ae09ac31904466636b95ff557d0a18e2
 
 source-repository-package
   type: git
-  location: https://github.com/prolic/HsQML/
-  tag: aa599366ae09ac31904466636b95ff557d0a18e2
+  location: https://github.com/haskell-bitcoin/libsecp256k1-haskell

futr.cabal

@@ -1,7 +1,7 @@
 cabal-version:      3.12
 name:               futr
 version:            0.1.0.0
-license:            LGPL-3.0-only
+license:            GPL-3.0-only
 license-file:       LICENSE
 copyright:          2024 Sascha-Oliver Prolic
 maintainer:         [email protected]
@@ -29,6 +29,7 @@ executable futr
     hs-source-dirs:   src
 
     other-modules:
+        Nostr.Encryption
         Nostr.Event
         Nostr.Keys
         Nostr.Kind
@@ -48,12 +49,15 @@ executable futr
         aeson >=2.2.3.0 && <2.3,
         base >=4.17.2.1 && <4.18,
         base16-bytestring >=1.0.2.0 && <1.1,
+        base64-bytestring >=1.2.1.0 && <1.3,
         basement >=0.0.16 && <0.1,
         bech32 >=1.1.7 && <1.2,
         binary >=0.8.9.1 && <0.9,
         bytestring >=0.11.5.3 && <0.12,
+        byteable >=0.1.1 && < 0.2,
         containers >=0.6.7 && <0.7,
         cryptohash-sha256 >=0.11.102.1 && <0.12,
+        crypton >=1.0 && <1.1,
         data-default >=0.7.1.1 && <0.8,
         directory >=1.3.7.1 && <1.4,
         entropy >=0.4.1.10 && <0.5,
@@ -62,16 +66,55 @@ executable futr
         hsqml >=0.3.6.0 && <0.4,
         lens >=5.3.2 && <5.4,
         libsecp256k1 >=0.2.1 && <0.3,
+        memory >=0.18 && <0.19,
         modern-uri >=0.3.6.1 && <0.4,
         random >=1.2.1.2 && <1.3,
-        secp256k1-haskell >=1.2.0 && <1.3,
+        secp256k1-haskell >=1.4.0 && <1.5,
         stm >=2.5.1.0 && <2.6,
         string-conversions >= 0.4.0.1 && < 0.5,
         text >=2.0.2 && <2.1,
         time >=1.12.2 && <1.13,
         vector >=0.13.1.0 && <0.14,
         wreq >= 0.5.4.3 && < 0.6
 
+test-suite futr-tests
+    type:                 exitcode-stdio-1.0
+    hs-source-dirs:       test, src
+    main-is:              TestMain.hs
+
+    other-modules:
+        Nostr.Encryption
+        Nostr.EncryptionTest
+        Nostr.Keys
+
+    ghc-options:
+        -threaded -Wall -Wcompat -Wincomplete-uni-patterns
+        -Wincomplete-record-updates
+
+    build-depends:
+        aeson >=2.2.3.0 && <2.3,
+        base >=4.17.2.1 && <4.18,
+        base16-bytestring >=1.0.2.0 && <1.1,
+        base64-bytestring,
+        bech32 >=1.1.7 && <1.2,
+        binary >=0.8.9.1 && <0.9,
+        bytestring >=0.11.5.3 && <0.12,
+        crypton >=1.0 && <1.1,
+        directory >=1.3.7.1 && <1.4,
+        entropy >=0.4.1.10 && <0.5,
+        haskoin-core >=1.1.0 && <1.2,
+        libsecp256k1 >=0.2.1 && <0.3,
+        memory >=0.18 && <0.19,
+        secp256k1-haskell >=1.4.0 && <1.5,
+        tasty >=1.3.0.1 && <1.4,
+        tasty-hunit >=0.9 && <0.12,
+        text >=2.0.2 && <2.1,
+        random >=1.2.1.2 && <1.3
+
+    extra-libraries:  secp256k1
+    extra-lib-dirs:   /usr/local/lib
+    default-language:     Haskell2010
+
 source-repository head
   type: git
   location: https://github.com/futrnostr/futr/

src/Main.hs

@@ -24,16 +24,16 @@ data AppModel = AppModel
 
 createContext :: MVar AppModel -> SignalKey (IO ()) -> IO (ObjRef ())
 createContext modelVar changeKey = do
-    let getKeyPair :: IO (Maybe KeyPair)
-        getKeyPair = do
+    let getKeyPair' :: IO (Maybe KeyPair)
+        getKeyPair' = do
             appModel' <- readMVar modelVar
             return (keyPair appModel')
 
-        setKeyPair :: KeyPair -> IO ()
-        setKeyPair kp = modifyMVar_ modelVar $ \m -> return m { keyPair = Just kp }
+        setKeyPair' :: KeyPair -> IO ()
+        setKeyPair' kp = modifyMVar_ modelVar $ \m -> return m { keyPair = Just kp }
 
     appModel <- readMVar modelVar
-    keyMgmtObj <- createKeyMgmtCtx (keyMgmtModel appModel) changeKey getKeyPair setKeyPair
+    keyMgmtObj <- createKeyMgmtCtx (keyMgmtModel appModel) changeKey getKeyPair' setKeyPair'
 
     rootClass <- newClass [
         defPropertyConst' "ctxKeyMgmt" (\_ -> return keyMgmtObj),

src/Nostr/Encryption.hs

@@ -0,0 +1,212 @@
+-- | Module: Nostr.Encryption
+--
+-- This module provides functionalities for encrypting and decrypting messages
+-- within the Nostr network. It includes the following features:
+--
+-- * Encryption and Decryption:
+--     - Encrypts and decrypts messages using ChaCha20 encryption and HMAC-SHA256
+--
+-- * Key Derivation:
+--     - Derives a conversation key from a secret key and an extended public key
+--     - Utilizes HKDF (HMAC-based Key Derivation Function) for key expansion
+--
+-- The functions provided in this module ensure secure message encryption and decryption,
+-- following the NIP-44 standard for key derivation.
+
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE PackageImports      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Nostr.Encryption (decrypt, encrypt, getConversationKey, getMessageKeys) where
+
+import Control.Monad (unless, when)
+import Crypto.Cipher.ChaCha (generate, initialize)
+import Crypto.Hash (SHA256(..))
+import Crypto.KDF.HKDF (PRK, expand, extract, extractSkip)
+import Crypto.MAC.HMAC (HMAC, hmac)
+import qualified "libsecp256k1" Crypto.Secp256k1 as S
+import Data.Bits (shiftL, xor)
+import Data.ByteString (ByteString)
+import Data.ByteArray (ByteArrayAccess)
+import qualified Data.ByteArray as BA
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy as BSL
+import Data.Binary.Get (getWord16be, runGet)
+import Data.Binary.Put (runPut, putWord16be)
+import Data.Maybe (fromJust)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+
+import Nostr.Keys (PubKeyXO(..), SecKey(..), exportPubKeyXO)
+
+-- | Encrypts a message
+encrypt :: Text -> ByteString -> ByteString -> Either String Text
+encrypt plaintext conversationKey nonce = do
+    let (chachaKey, chachaNonce, hmacKey) = getMessageKeys conversationKey nonce
+    paddedResult <- padPlaintext plaintext
+    ciphertext <- Right (encryptChaCha20 chachaKey chachaNonce paddedResult)
+    let mac = calculateHmac hmacKey ciphertext nonce
+    let encoded = B64.encode $ BS.concat [BS.singleton 2, nonce, ciphertext, BA.convert mac]
+    Right (decodeUtf8 encoded)
+
+-- | Decrypts a message
+decrypt :: ByteString -> Text -> Either String Text
+decrypt conversationKey payload = do
+    (nonce, ciphertext, macFromMsg) <- decodePayload payload
+
+    let (chachaKey, chachaNonce, hmacKey) = getMessageKeys conversationKey nonce
+        calculatedMac = calculateHmac hmacKey ciphertext nonce
+
+    if calculatedMac /= macFromMsg
+      then Left "HMAC verification failed"
+      else do
+        let padded = decryptChaCha20 chachaKey chachaNonce ciphertext
+        unpadPlaintext padded
+
+-- | Derives the conversation key using SecKey and PubKeyXO
+getConversationKey :: SecKey -> PubKeyXO -> Maybe ByteString
+getConversationKey secKey pk = do
+    pubKeyXY <- convertToFullPubKey pk
+    let tweak = fromJust $ S.importTweak $ S.exportSecKey (getSecKey secKey)
+    sharedSecret <- S.pubKeyTweakMul pubKeyXY tweak
+    let sharedSecret' = BS.drop 1 $ S.exportPubKeyXY True sharedSecret
+    let salt = C8.pack "nip44-v2"
+    let prk = extract salt sharedSecret' :: PRK SHA256
+    return $ BA.convert prk
+
+{-|
+  Derives cryptographic keys for message encryption and authentication using a shared conversation key 
+  and a nonce, based on the HKDF (HMAC-based Key Derivation Function)
+
+  Takes:
+  * `conversationKey` - A ByteString representing the shared secret
+  * `nonce` - A ByteString used to ensure distinct keys for each message
+
+  Returns:
+  A tuple containing:
+  * `chachaKey` (32 bytes) - For ChaCha20 encryption.
+  * `chachaNonce` (12 bytes) - Nonce for ChaCha20 encryption.
+  * `hmacKey` (remaining bytes) - For message authentication using HMAC.
+
+  Example:
+
+  @
+  let (chachaKey, chachaNonce, hmacKey) = getMessageKeys conversationKey nonce
+  @
+-}
+getMessageKeys :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
+getMessageKeys conversationKey nonce = do
+  let prk = extractSkip conversationKey :: PRK SHA256
+      expandedKeys = hkdfExpand prk nonce
+      chachaKey = BS.take 32 expandedKeys
+      chachaNonce = BS.take 12 (BS.drop 32 expandedKeys)
+      hmacKey = BS.drop 44 expandedKeys
+  (chachaKey, chachaNonce, hmacKey)
+
+
+convertToFullPubKey :: PubKeyXO -> Maybe S.PubKeyXY
+convertToFullPubKey pk = S.importPubKeyXY $ BS.cons 0x02 (exportPubKeyXO pk)
+
+encryptChaCha20 :: ByteString -> ByteString -> ByteString -> ByteString
+encryptChaCha20 key nonce padded = 
+    let state = initialize 20 key nonce
+        (keystream, _) = generate state (BS.length padded)
+        ciphertext = BS.pack $ zipWith xor (BS.unpack padded) (BS.unpack keystream)
+    in ciphertext
+
+decryptChaCha20 :: ByteString -> ByteString -> ByteString -> ByteString
+decryptChaCha20 key nonce ciphertext = 
+    let state = initialize 20 key nonce
+        (keystream, _) = generate state (BS.length ciphertext)
+        keystreamList = BS.unpack keystream
+        ciphertextList = BS.unpack ciphertext
+        plaintextList = zipWith xor ciphertextList keystreamList
+        plaintext = BS.pack plaintextList
+    in plaintext
+
+calculateHmac :: ByteString -> ByteString -> ByteString -> ByteString
+calculateHmac key message aad =
+  let combined = BS.concat [aad, message]
+      hmacResult = hmac key combined :: HMAC SHA256
+  in BA.convert hmacResult
+
+hkdfExpand :: ByteArrayAccess info => PRK SHA256 -> info -> ByteString
+hkdfExpand prk info = expand prk info 76 -- 76 bytes to cover all keys
+
+unpadPlaintext :: ByteString -> Either String Text
+unpadPlaintext padded =
+  if isValidPadding padded
+    then Right $ decodeUtf8 unpadded
+    else Left "invalid padding"
+  where
+    unpaddedLen = fromIntegral $ runGet getWord16be (BSL.fromStrict $ BS.take 2 padded)
+    unpadded = BS.drop 2 $ BS.take (2 + unpaddedLen) padded
+    isValidPadding p = case calcPaddedLen unpaddedLen of
+      Left _ -> False
+      Right pd ->
+        let totalLen = 2 + pd
+        in unpaddedLen >= minPlaintextSize &&
+          unpaddedLen <= maxPlaintextSize &&
+          BS.length unpadded == unpaddedLen &&
+          BS.length p == totalLen
+
+minPlaintextSize :: Int
+minPlaintextSize = 0x0001
+
+maxPlaintextSize :: Int
+maxPlaintextSize = 0xffff
+
+-- | Calculates the padded length based on the given length.
+calcPaddedLen :: Int -> Either String Int
+calcPaddedLen len
+    | len < 1 = Left errMsgSize
+    | len > maxPlaintextSize = Left errMsgSize
+    | len <= 32 = Right 32
+    | otherwise = Right $ chunk * ((len - 1) `div` chunk + 1)
+  where
+    bitShift = ceiling (logBase 2 (fromIntegral (len - 1)) :: Double)
+    nextPower = 1 `shiftL` bitShift
+    chunk = if nextPower <= 256 then 32 else nextPower `div` 8
+    errMsgSize = "invalid plaintext size: must be between 1 and 65535 bytes"
+
+-- | Converts a length to a 2-byte prefix in big-endian order.
+writeU16BE :: Int -> ByteString
+writeU16BE len = BSL.toStrict $ runPut $ putWord16be (fromIntegral len)
+
+-- | Pads the plaintext to match the required length with padding bytes.
+padPlaintext :: Text -> Either String ByteString
+padPlaintext plaintext = do
+    unpadded <- Right (encodeUtf8 plaintext)
+    let unpaddedLen = BS.length unpadded
+    paddedLen <- calcPaddedLen unpaddedLen
+    if paddedLen >= unpaddedLen
+        then let
+            prefix = writeU16BE (fromIntegral unpaddedLen)
+            suffix = BS.replicate (paddedLen - unpaddedLen) 0
+            in Right (BS.concat [prefix, unpadded, suffix])
+        else Left "Calculated padded length is less than the unpadded length"
+
+decodePayload :: Text -> Either String (ByteString, ByteString, ByteString)
+decodePayload payloadText = do
+    let payload = encodeUtf8 payloadText
+    let plen = BS.length payload
+    unless (plen >= 132 && plen <= 87472) $ Left $ "Invalid payload length: " ++ show plen
+
+    decoded <- case B64.decode payload of
+        Left err -> Left $ "Invalid base64: " ++ err
+        Right d -> Right d
+
+    let dlen = BS.length decoded
+    unless (dlen >= 99 && dlen <= 65603) $ Left $ "Invalid data length: " ++ show dlen
+
+    let vers = BS.index decoded 0
+    when (vers /= 2) $ Left $ "Unknown encryption version: " ++ show vers
+
+    let nonce = BS.take 32 (BS.drop 1 decoded)
+        rest = BS.drop 33 decoded
+        mac = BS.take 32 (BS.drop (BS.length rest - 32) rest)
+        ciphertext = BS.take (BS.length rest - 32) rest
+
+    Right (nonce, ciphertext, mac)

src/Nostr/Keys.hs

@@ -24,10 +24,10 @@
 
 module Nostr.Keys ( 
     -- * Types
-      KeyPair
-    , PubKeyXO
-    , SecKey
-    , Signature
+      KeyPair(..)
+    , PubKeyXO(..)
+    , SecKey(..)
+    , Signature(..)
 
     -- * generation
     , createKeyPair

src/Presentation/KeyMgmt.hs

@@ -20,7 +20,7 @@ import System.Directory (XdgDirectory(XdgData), createDirectoryIfMissing,
 import System.FilePath ((</>), takeFileName)
 import Text.Read (readMaybe)
 
-import Nostr.Keys
+import Nostr.Keys hiding (getKeyPair)
 import Nostr.Profile
 import Nostr.Relay (RelayInfo, RelayURI, defaultRelays)
 --import Types