diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for nostr + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2024 Emre YILMAZ + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/app/Example.hs b/app/Example.hs new file mode 100644 --- /dev/null +++ b/app/Example.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Concurrent (threadDelay) +import Control.Monad (forM_) +import Control.Monad.IO.Class (liftIO) +import Data.Function ((&)) +import qualified Data.Text as T + +import Nostr.Client +import Nostr.Event +import Nostr.Relay +import Nostr.Crypto +import Nostr.Nip19 +import Nostr.Nip05 + +main :: IO () +main = do + putStrLn "=== Nostr High-Level Client Example ===" + + -- 1. Generate Keys + (secKey, pubKey) <- generateKeyPair + let keys = Keys secKey pubKey (Just "wss://relay.damus.io") -- Example + + putStrLn $ "Generated Public Key (Hex): " ++ T.unpack (unPubKey pubKey) + case toNpub pubKey of + Just npub -> putStrLn $ "Generated Public Key (NIP-19): " ++ T.unpack npub + Nothing -> putStrLn "Failed to encode npub" + + case toNsec secKey of + Just nsec -> putStrLn $ "Generated Secret Key (NIP-19): " ++ T.unpack nsec + Nothing -> putStrLn "Failed to encode nsec" + + -- 2. Define relays + let relays = + [ "wss://relay.damus.io" + , "wss://nos.lol" + -- Add more if needed, but these are reliable public ones + ] + + -- 3. Connect (creates NostrEnv) + putStrLn "Connecting to relays..." + env <- connectRelays relays + + -- 4. Run App + runNostrApp env $ do + -- Publish a simple note (convenience function) + let note = "Hello Nostr from Haskell Monad! 2026-02-16" + liftIO $ putStrLn $ "Publishing note: " ++ show note + publishShortNote keys note + + -- Publish using builder pattern with tags + liftIO $ putStrLn "Publishing long-form article..." + publish keys $ shortNote "My first long-form article from Haskell!" + & withKind 30023 + & withAddressRef 30023 pubKey "haskell-nostr-intro" + & withTag ["title", "Getting Started with Nostr in Haskell"] + & withMention pubKey + + liftIO $ putStrLn "Wait 3 seconds for propagation..." + liftIO $ threadDelay 3000000 + + -- NIP-02: Follow a user + liftIO $ putStrLn "Following Jack (founder)..." + -- delirehberi's pubkey: npub1gmeu0wenescpjpymwmwgnkaedc6vy3aamf5tdtvxxf5z0yll3gdqatwl3v + let jackPubkey = "82341f882b6eabcd2ba7f1ef90aad961cf074af15b9ef44a09f9d2a8fbf71d22" + + case parsePubKey jackPubkey of + Just pk -> follow keys pk (Just "wss://relay.damus.io") (Just "jack") + Nothing -> liftIO $ putStrLn "Invalid Jack pubkey" + + let delirehberiNpub = "npub1gmeu0wenescpjpymwmwgnkaedc6vy3aamf5tdtvxxf5z0yll3gdqatwl3v" + case parsePubKey delirehberiNpub of + Just pk -> do + liftIO $ putStrLn $ "Following delirehberi (decoded from " ++ T.unpack delirehberiNpub ++ ")" + + -- Verify NIP-05 + let nip05 = "delirehberi@emre.xyz" + liftIO $ putStrLn $ "Verifying NIP-05: " ++ T.unpack nip05 ++ "..." + isVerified <- liftIO $ verifyNip05 nip05 pk + if isVerified + then liftIO $ putStrLn "UNKNOWN: Verified NIP-05 [OK]" + else liftIO $ putStrLn "WARNING: NIP-05 Verification Failed [FAILED]" + + follow keys pk (Just "wss://relay.damus.io") (Just "delirehberi@emre.xyz") + Nothing -> liftIO $ putStrLn "Error: Not a public key" + + liftIO $ putStrLn "Wait 3 seconds..." + liftIO $ threadDelay 3000000 + + -- Fetch contacts + contacts <- getContacts keys + liftIO $ putStrLn $ "My Contacts: " ++ show contacts + + -- Query for the note + liftIO $ putStrLn "Querying for my notes..." + let f = defaultFilter + { filterAuthors = Just [pubKey] + , filterKinds = Just [1] + , filterLimit = Just 5 + } + + events <- queryEvents f + + liftIO $ do + putStrLn $ "Found " ++ show (length events) ++ " events." + forM_ events $ \e -> do + putStrLn $ " - " ++ show (eventContent e) + -- Delete the event if it matches our note + if eventContent e == note then do + putStrLn $ "Deleting event: " ++ show (eventId e) + return () + else return () + + + let eventsToDelete = Prelude.filter (\e -> eventContent e == note) events + if not (null eventsToDelete) then do + let eids = map eventId eventsToDelete + liftIO $ putStrLn $ "Deleting " ++ show (length eids) ++ " events (NIP-09)..." + deleteEvents keys eids (Just "test deletion") + else + liftIO $ putStrLn "No events found to delete." + + -- 5. Cleanup + putStrLn "Disconnecting..." + disconnect env + putStrLn "Done." diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Nostr.Event +import Nostr.Crypto +import Data.Aeson (encode) +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.Word (Word64) + +main :: IO () +main = do + putStrLn "=== Nostr NIP-01 Library Demo ===" + putStrLn "" + + -- Generate a key pair + putStrLn "Generating key pair..." + (secKey, pubKey) <- generateKeyPair + putStrLn $ "Public Key: " ++ T.unpack (unPubKey pubKey) + putStrLn "" + + -- Get current timestamp + timestamp <- fmap (floor . realToFrac) getPOSIXTime :: IO Word64 + + -- Create an unsigned event (kind 1 = text note) + let event = createUnsignedEvent + pubKey + timestamp + 1 -- kind 1 = text note + [] -- no tags + "Hello from nostr.hs! This is a test event." + + putStrLn "Created unsigned event" + putStrLn "" + + -- Sign the event + putStrLn "Signing event..." + signResult <- signEvent secKey event + case signResult of + Left err -> putStrLn $ "Error signing event: " ++ T.unpack err + Right signedEvent -> do + putStrLn "Event signed successfully!" + putStrLn "" + putStrLn "Event JSON:" + BL.putStrLn $ encode signedEvent + putStrLn "" + + -- Verify the signature + putStrLn "Verifying signature..." + isValid <- verifySignature signedEvent + putStrLn $ "Signature valid: " ++ show isValid diff --git a/lib/Nostr/Client.hs b/lib/Nostr/Client.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Client.hs @@ -0,0 +1,396 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Nostr.Client + ( -- * Application + NostrEnv(..) + , NostrApp + , runNostrApp + , connectRelays + , disconnect + -- * Event Builder + , EventBuilder(..) + , shortNote + , withKind + , withTag + -- * Standard Tag Combinators (NIP-01) + , withReply + , withReplyTo + , withMention + , withMentionRelay + , withAddressRef + , withAddressRefRelay + -- * Threading Tag Combinators (NIP-10) + , withReplyToEvent + , withRootEvent + -- * Contact Lists (NIP-02) + , Contact(..) + , getContacts + , follow + , unfollow + -- * Event Deletion (NIP-09) + , deleteEvents + -- * Helpers + , parsePubKey + -- * Publishing + , publish + , publishEvent + , publishShortNote + -- * Relay Authentication (NIP-42) + , createAuthEvent + , authenticate + -- * Querying + , queryEvents + ) where + +import Control.Concurrent.Async (mapConcurrently) +import Control.Exception (catch, SomeException) +import Control.Monad (forM_) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Reader (ReaderT, runReaderT, asks) +import Data.Function ((&)) +import Data.List (find, nub) +import Data.Maybe (catMaybes, mapMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock.POSIX (getPOSIXTime) +import System.IO (hPutStrLn, stderr) +import System.Timeout (timeout) + +import Nostr.Event +import qualified Nostr.Event (mkPubKey) +import Nostr.Nip19 (decode, Nip19Object(..)) +import Nostr.Relay +import Nostr.Crypto (Keys(..), signEvent) + +-- | Nostr Application Environment +data NostrEnv = NostrEnv + { envRelays :: [RelayConnection] + } + +-- | Nostr Application Monad +type NostrApp = ReaderT NostrEnv IO + +-- | Run the Nostr Application +runNostrApp :: NostrEnv -> NostrApp a -> IO a +runNostrApp = flip runReaderT + +-- | Connect to a list of relays +connectRelays :: [Text] -> IO NostrEnv +connectRelays urls = do + conns <- mapMaybeM connectSafe urls + return $ NostrEnv conns + where + connectSafe :: Text -> IO (Maybe RelayConnection) + connectSafe url = do + -- connectRelay returns immediately (forks background thread) + conn <- connectRelay url + hPutStrLn stderr $ "Initiated connection to " ++ T.unpack url + return $ Just conn + + mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b] + mapMaybeM f xs = catMaybes <$> mapM f xs + +-- | Disconnect from all relays +disconnect :: NostrEnv -> IO () +disconnect env = do + forM_ (envRelays env) $ \conn -> do + closeConnection conn + +-- | Publish an event to all connected relays +publishEvent :: Event -> NostrApp () +publishEvent event = do + relays <- asks envRelays + liftIO $ forM_ relays $ \conn -> do + let msg = CMEvent event + catch (sendMessage conn msg) (\(_ :: SomeException) -> + hPutStrLn stderr $ "Failed to send event to " ++ T.unpack (relayUrl conn)) + +-- | Query events from all relays and aggregate results +queryEvents :: Filter -> NostrApp [Event] +queryEvents filter = do + relays <- asks envRelays + -- We use mapConcurrently to query all relays in parallel + results <- liftIO $ mapConcurrently (queryRelaySafe filter) relays + -- Deduplicate events based on ID + return $ nub $ concat results + where + queryRelaySafe :: Filter -> RelayConnection -> IO [Event] + queryRelaySafe f conn = do + catch (queryRelay conn f) (\e -> do + hPutStrLn stderr $ "Error querying " ++ T.unpack (relayUrl conn) ++ ": " ++ show (e :: SomeException) + return []) + +-- | Helper to query a single relay +-- Sends REQ, collects events until EOSE or timeout (5 seconds). +queryRelay :: RelayConnection -> Filter -> IO [Event] +queryRelay conn filter = do + subId <- SubscriptionId . T.pack . show . round <$> getPOSIXTime + sendMessage conn (CMReq subId [filter]) + -- Set a 5-second timeout for the query + result <- timeout 5000000 $ collectEvents conn subId [] + case result of + Just events -> return events + Nothing -> do + hPutStrLn stderr $ "Query timed out for " ++ T.unpack (relayUrl conn) + return [] + +collectEvents :: RelayConnection -> SubscriptionId -> [Event] -> IO [Event] +collectEvents conn subId acc = do + msg <- receiveMessage conn + case msg of + RMEvent sid event -> + if sid == subId + then collectEvents conn subId (event : acc) + else collectEvents conn subId acc -- Ignore other subscriptions + RMEOSE sid -> + if sid == subId + then return acc + else collectEvents conn subId acc + _ -> collectEvents conn subId acc -- Ignore other messages + +-- ============================================================================ +-- Event Builder +-- ============================================================================ + +-- | Builder for constructing Nostr events +-- Use 'shortNote' to create a builder, then chain with '&' and combinators. +-- +-- @ +-- import Data.Function ((&)) +-- +-- publish keys $ shortNote "Hello world" +-- & withKind 30023 +-- & withTag ["e", "event-id"] +-- & withTag ["p", "pubkey-hex"] +-- @ +data EventBuilder = EventBuilder + { ebKind :: Kind + , ebTags :: [Tag] + , ebContent :: Text + } deriving (Show, Eq) + +mkEvent :: EventBuilder +mkEvent = EventBuilder + { + ebKind = 1 + , ebTags = [] + , ebContent = "" + } +-- | Create an event builder for a short text note (kind 1) +shortNote :: Text -> EventBuilder +shortNote content = mkEvent + { + ebContent = content + } + +-- | Set the event kind +withKind :: Kind -> EventBuilder -> EventBuilder +withKind k eb = eb { ebKind = k } + +-- | Append a tag to the event +withTag :: [Text] -> EventBuilder -> EventBuilder +withTag t eb = eb { ebTags = ebTags eb ++ [t] } + +-- ============================================================================ +-- NIP-01 Standard Tag Combinators +-- ============================================================================ + +-- | Reply to an event ("e" tag) +-- ["e", ] +withReply :: Text -> EventBuilder -> EventBuilder +withReply eid = withTag ["e", eid] + +-- | Reply to an event with a recommended relay url +-- ["e", , ] +withReplyTo :: Text -> Text -> EventBuilder -> EventBuilder +withReplyTo eid relay = withTag ["e", eid, relay] + +-- | Mention a user ("p" tag) +-- ["p", ] +withMention :: PubKey -> EventBuilder -> EventBuilder +withMention pubkey = withTag ["p", unPubKey pubkey] + +-- | Mention a user with a recommended relay url +-- ["p", , ] +withMentionRelay :: PubKey -> Text -> EventBuilder -> EventBuilder +withMentionRelay pubkey relay = withTag ["p", unPubKey pubkey, relay] + +-- ============================================================================ +-- NIP-10 Threading Tag Combinators +-- ============================================================================ + +-- | Reply to an event (NIP-10 marked "e" tag) +-- ["e", , , "reply", ] +withReplyToEvent :: EventId -> Text -> PubKey -> EventBuilder -> EventBuilder +withReplyToEvent (EventId eid) relay pubkey = withTag ["e", eid, relay, "reply", unPubKey pubkey] + +-- | Mark the root of a thread (NIP-10 marked "e" tag) +-- ["e", , , "root", ] +withRootEvent :: EventId -> Text -> PubKey -> EventBuilder -> EventBuilder +withRootEvent (EventId eid) relay pubkey = withTag ["e", eid, relay, "root", unPubKey pubkey] + +-- | Reference an addressable event ("a" tag) +-- ["a", ::] +withAddressRef :: Kind -> PubKey -> Text -> EventBuilder -> EventBuilder +withAddressRef kind pubkey dTag = + let addr = T.pack (show kind) <> ":" <> unPubKey pubkey <> ":" <> dTag + in withTag ["a", addr] + +-- | Reference an addressable event with a recommended relay url +-- ["a", ::, ] +withAddressRefRelay :: Kind -> PubKey -> Text -> Text -> EventBuilder -> EventBuilder +withAddressRefRelay kind pubkey dTag relay = + let addr = T.pack (show kind) <> ":" <> unPubKey pubkey <> ":" <> dTag + in withTag ["a", addr, relay] + +-- ============================================================================ +-- Contact Lists (NIP-02) +-- ============================================================================ + +data Contact = Contact + { contactPubkey :: Text + , contactRelay :: Maybe Text + , contactPetname :: Maybe Text + } deriving (Show, Eq) + +-- | Fetch the user's latest contact list (Kind 3) +getContacts :: Keys -> NostrApp [Contact] +getContacts keys = do + let filter = defaultFilter + { filterKinds = Just [3] + , filterAuthors = Just [keysPubKey keys] + , filterLimit = Just 1 + } + events <- queryEvents filter + + -- We only care about the latest event if multiple returned (though limit 1 helps) + -- But since queryEvents aggregates from multiple relays, we might get substitutes. + -- We should sort by created_at. + -- For now, just taking the first one if available. + case events of + [] -> return [] + (e:_) -> return $ mapMaybe parseContact (eventTags e) + where + parseContact :: Tag -> Maybe Contact + parseContact tag = case tag of + ("p" : pubkey : rest) -> + let relay = if null rest then Nothing else Just (head rest) + petname = if length rest > 1 then Just (rest !! 1) else Nothing + in Just $ Contact pubkey relay petname + _ -> Nothing + +-- | Parse a public key from Hex or NIP-19 (npub) string +parsePubKey :: Text -> Maybe PubKey +parsePubKey t + | "npub1" `T.isPrefixOf` t = case decode t of + Right (Nip19Pub pk) -> Just pk + _ -> Nothing + | otherwise = case Nostr.Event.mkPubKey t of + Right pk -> Just pk + _ -> Nothing + +-- | Follow a user +follow :: Keys -> PubKey -> Maybe Text -> Maybe Text -> NostrApp () +follow keys targetPubkey relay petname = do + contacts <- getContacts keys + + -- Check if already following + -- We compare the hex representation of pubkeys since Contact stores Text + let targetHex = unPubKey targetPubkey + let startContacts = Prelude.filter (\c -> contactPubkey c /= targetHex) contacts + let newContact = Contact targetHex relay petname + let newContacts = startContacts ++ [newContact] + + publishContacts keys newContacts + +-- | Unfollow a user +unfollow :: Keys -> PubKey -> NostrApp () +unfollow keys targetPubkey = do + contacts <- getContacts keys + let targetHex = unPubKey targetPubkey + let newContacts = Prelude.filter (\c -> contactPubkey c /= targetHex) contacts + publishContacts keys newContacts + +-- | Helper to publish the contact list +publishContacts :: Keys -> [Contact] -> NostrApp () +publishContacts keys contacts = do + let builder = shortNote "" + & withKind 3 + + -- Add all contacts as "p" tags + let builderWithTags = foldl addContactTag builder contacts + + publish keys builderWithTags + where + addContactTag :: EventBuilder -> Contact -> EventBuilder + addContactTag eb c = + let tags = ["p", contactPubkey c] + ++ (case contactRelay c of Just r -> [r]; Nothing -> [""]) + ++ (case contactPetname c of Just p -> [p]; Nothing -> []) + in withTag tags eb + +-- ============================================================================ +-- Event Deletion (NIP-09) +-- ============================================================================ + +-- | Delete events (Kind 5) +-- @ +-- deleteEvents keys [eventId1, eventId2] (Just "user request") +-- @ +deleteEvents :: Keys -> [EventId] -> Maybe Text -> NostrApp () +deleteEvents keys eventIds reason = do + let content = case reason of + Just r -> r + Nothing -> "" + + let builder = shortNote content + & withKind 5 + + -- Add "e" tags for each event ID + let builderWithTags = foldl (\eb (EventId eid) -> withTag ["e", eid] eb) builder eventIds + + publish keys builderWithTags + +-- | Build, sign, and publish an event from an EventBuilder +publish :: Keys -> EventBuilder -> NostrApp () +publish keys eb = do + now <- liftIO $ round <$> getPOSIXTime + let unsigned = createUnsignedEvent (keysPubKey keys) now (ebKind eb) (ebTags eb) (ebContent eb) + signedResult <- liftIO $ signEvent (keysSecKey keys) unsigned + case signedResult of + Right event -> publishEvent event + Left err -> liftIO $ hPutStrLn stderr $ "Failed to sign event: " ++ T.unpack err + +-- | Convenience: publish a kind-1 text note (no tags) +publishShortNote :: Keys -> Text -> NostrApp () +publishShortNote keys content = publish keys (shortNote content) + +-- ============================================================================ +-- NIP-42 Relay Authentication +-- ============================================================================ + +-- | Create an authentication event (kind 22242) for NIP-42 +-- This creates an unsigned event that should be signed and sent as AUTH +createAuthEvent :: PubKey -> Text -> Text -> Event +createAuthEvent pubkey relayUrl challenge = + createUnsignedEvent pubkey 0 kindAuth [["relay", relayUrl], ["challenge", challenge]] "" + +-- | Authenticate with a relay using NIP-42 +-- Signs and sends an AUTH event with the given challenge to the specified relay +authenticate :: Keys -> Text -> Text -> NostrApp () +authenticate keys targetRelayUrl challenge = do + relays <- asks envRelays + let maybeConn = find (\conn -> relayUrl conn == targetRelayUrl) relays + case maybeConn of + Just conn -> do + now <- liftIO $ round <$> getPOSIXTime + let unsigned = createAuthEvent (keysPubKey keys) targetRelayUrl challenge + signed = unsigned { eventCreatedAt = now } + signedResult <- liftIO $ signEvent (keysSecKey keys) signed + case signedResult of + Right event -> liftIO $ catch (sendMessage conn (CMAuth event)) + (\(_ :: SomeException) -> hPutStrLn stderr $ "Failed to send auth to " ++ T.unpack targetRelayUrl) + Left err -> liftIO $ hPutStrLn stderr $ "Failed to sign auth event: " ++ T.unpack err + Nothing -> liftIO $ hPutStrLn stderr $ "No relay connection found for URL: " ++ T.unpack targetRelayUrl diff --git a/lib/Nostr/Crypto.hs b/lib/Nostr/Crypto.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Crypto.hs @@ -0,0 +1,272 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE DeriveGeneric #-} + +{-| +Module : Nostr.Crypto +Description : Cryptographic operations for Nostr events using BIP-340 Schnorr signatures +Copyright : (c) Emre YILMAZ, 2026 +License : MIT +Maintainer : z@emre.xyz + +This module provides cryptographic functions for Nostr events, +including key generation, event ID computation, and BIP-340 Schnorr signatures. +-} + +module Nostr.Crypto + ( -- * Key Management + SecKey + , generateKeyPair + , pubKeyFromSecKey + , exportSecKey + , exportPubKey + , secKeyFromBytes + , Keys(..) + , validateKeys + + -- * Event Operations + , computeEventId + , signEvent + , verifySignature + , validateEvent + , serializeEventForId + + -- * Utilities + , bytesToHex + , hexToBytes + ) where + +import qualified Crypto.Hash.Algorithms as Hash +import qualified Crypto.Hash as Hash +import qualified Crypto.Curve.Secp256k1 as Secp +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.ByteString (ByteString) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Aeson (encode, toJSON) +import GHC.Generics (Generic) -- Added this line +-- import Data.Word (Word64) -- Hiding this to import from GHC.Word +import qualified System.Entropy as E +import Data.Bits (shiftR) +import Data.Word (Word8) +import Data.Word.Wider (Wider(..)) +import Data.Word.Limb (Limb(..)) +import GHC.Word (Word64(..), Word(..)) + +import Nostr.Event hiding (validateEvent) + +-- | Secret key (private key) for signing - 32-byte wide word +type SecKey = Wider + +-- | Generate a new secp256k1 key pair for Schnorr signatures +generateKeyPair :: IO (SecKey, PubKey) +generateKeyPair = do + -- Generate 32 random bytes for the secret key + secKeyBytes <- E.getEntropy 32 + case secKeyFromBytes secKeyBytes of + Just secKey -> do + pubKey <- pubKeyFromSecKey secKey + return (secKey, pubKey) + Nothing -> error "Failed to create secret key from random bytes" + +-- | Derive public key from secret key (x-only 32-byte for BIP-340) +pubKeyFromSecKey :: SecKey -> IO PubKey +pubKeyFromSecKey secKey = do + -- ppad-secp256k1 uses derive_pub to create public key from secret key + -- It returns Maybe Pub (Projective point) + case Secp.derive_pub secKey of + Just pubKey -> do + -- Serialize to compressed format (33 bytes) and drop the first byte + -- to get the 32-byte x-only public key as per BIP-340 + let compressed = Secp.serialize_point pubKey + let pubKeyBytes = BS.drop 1 compressed + case mkPubKey (bytesToHex pubKeyBytes) of + Right pk -> return pk + Left err -> error $ "Failed to create PubKey: " ++ T.unpack err + Nothing -> error "Failed to derive public key" + +-- | Create a SecKey from raw bytes (32 bytes) +secKeyFromBytes :: ByteString -> Maybe SecKey +secKeyFromBytes bs + | BS.length bs == 32 = + -- Convert 32 bytes to Wider Word64 + let (w0, r1) = parseWord64 (BS.take 8 bs) + (w1, r2) = parseWord64 (BS.take 8 r1) + (w2, r3) = parseWord64 (BS.take 8 r2) + (w3, _) = parseWord64 (BS.take 8 r3) + + unW (W# w) = w + toLimb :: Word64 -> Limb + toLimb w = Limb (unW (fromIntegral w :: Word)) + + l0 = toLimb w0 + l1 = toLimb w1 + l2 = toLimb w2 + l3 = toLimb w3 + in Just $ Wider (# l0, l1, l2, l3 #) + | otherwise = Nothing + where + parseWord64 :: ByteString -> (Word64, ByteString) + parseWord64 b = + let ws = BS.unpack b + w = foldr (\byte acc -> acc * 256 + fromIntegral byte) 0 ws + in (w, BS.drop 8 b) + + + +-- ... (keep existing imports) + +-- | Keys struct to hold key pair and optional relay info +data Keys = Keys + { keysSecKey :: SecKey + , keysPubKey :: PubKey + , keysRelay :: Maybe Text + } deriving (Show, Generic) + +-- | Equality check for Keys (compares PubKey and Relay only, ignores SecKey) +instance Eq Keys where + (Keys _ p1 r1) == (Keys _ p2 r2) = p1 == p2 && r1 == r2 + +-- | Validate that the public key matches the secret key +validateKeys :: Keys -> IO Bool +validateKeys (Keys sec pub _) = do + derived <- pubKeyFromSecKey sec + return $ derived == pub + +-- | Export secret key as hex string +exportSecKey :: SecKey -> Text +exportSecKey (Wider (# l0, l1, l2, l3 #)) = + let + unL (Limb w) = fromIntegral (W# w) :: Word64 + w0 = unL l0 + w1 = unL l1 + w2 = unL l2 + w3 = unL l3 + + word64ToBytes :: Word64 -> [Word8] + word64ToBytes w = + [ fromIntegral (w `shiftR` 56) + , fromIntegral (w `shiftR` 48) + , fromIntegral (w `shiftR` 40) + , fromIntegral (w `shiftR` 32) + , fromIntegral (w `shiftR` 24) + , fromIntegral (w `shiftR` 16) + , fromIntegral (w `shiftR` 8) + , fromIntegral w + ] + + allBytes = concatMap word64ToBytes [w0, w1, w2, w3] + in bytesToHex $ BS.pack allBytes + +-- | Export public key (already in Text format) +exportPubKey :: PubKey -> Text +exportPubKey = unPubKey + +-- ============================================================================ +-- Event ID Computation +-- ============================================================================ + +-- | Compute SHA-256 hash +sha256 :: ByteString -> ByteString +sha256 = BA.convert . Hash.hash @ByteString @Hash.SHA256 + +-- | Serialize event for ID computation +-- Returns JSON array: [0, pubkey, created_at, kind, tags, content] +serializeEventForId :: Event -> ByteString +serializeEventForId event = + let arr = + [ toJSON (0 :: Int) + , toJSON (unPubKey (eventPubkey event)) + , toJSON (eventCreatedAt event) + , toJSON (eventKind event) + , toJSON (eventTags event) + , toJSON (eventContent event) + ] + in BS.toStrict $ encode arr + +-- | Compute event ID using SHA-256 +computeEventId :: Event -> EventId +computeEventId event = + let serialized = serializeEventForId event + hash = sha256 serialized + hexHash = bytesToHex hash + in case mkEventId hexHash of + Right eid -> eid + Left err -> error $ "Failed to create EventId: " ++ T.unpack err + +-- ============================================================================ +-- BIP-340 Schnorr Signatures +-- ============================================================================ + +-- | Sign an event and set its id and sig fields using BIP-340 Schnorr signatures +signEvent :: SecKey -> Event -> IO (Either Text Event) +signEvent secKey event = do + -- First compute the event ID + let eventWithId = event { eventId = computeEventId event } + + -- Get the event ID bytes for signing (must be 32 bytes for Schnorr) + case hexToBytes (unEventId (eventId eventWithId)) of + Left err -> return $ Left err + Right idBytes -> do + -- Generate 32 bytes of auxiliary randomness (recommended by BIP-340) + auxRand <- E.getEntropy 32 + + -- Sign with BIP-340 Schnorr + case Secp.sign_schnorr secKey idBytes auxRand of + Nothing -> return $ Left "Failed to create Schnorr signature" + Just sigBytes -> do + let sigHex = bytesToHex sigBytes + + -- Create Signature with proper validation (should be 64 bytes = 128 hex chars) + case mkSignature sigHex of + Right signature -> return $ Right $ eventWithId { eventSig = signature } + Left err -> return $ Left err + +-- | Verify event signature using BIP-340 Schnorr verification +verifySignature :: Event -> IO Bool +verifySignature event = do + case hexToBytes (unEventId (eventId event)) of + Left _ -> return False + Right idBytes -> + case hexToBytes (unPubKey (eventPubkey event)) of + Left _ -> return False + Right pubKeyBytes -> + case hexToBytes (unSignature (eventSig event)) of + Left _ -> return False + Right sigBytes -> do + -- Parse public key from x-only bytes + -- BIP-340 uses implicit even Y coordinate (prefix 0x02) + let compressedPubKey = BS.cons 0x02 pubKeyBytes + case Secp.parse_point compressedPubKey of + Nothing -> return False + Just pubKeyPoint -> + -- Verify Schnorr signature + return $ Secp.verify_schnorr idBytes pubKeyPoint sigBytes + +-- | Validate event by checking both ID integrity and signature +validateEvent :: Event -> IO Bool +validateEvent event = do + let computedId = computeEventId event + if computedId /= eventId event + then return False + else verifySignature event + +-- ============================================================================ +-- Utility Functions +-- ============================================================================ + +-- | Convert bytes to lowercase hex string +bytesToHex :: ByteString -> Text +bytesToHex = TE.decodeUtf8 . B16.encode + +-- | Convert hex string to bytes +hexToBytes :: Text -> Either Text ByteString +hexToBytes hexText = + case B16.decode (TE.encodeUtf8 hexText) of + Right bs -> Right bs + Left err -> Left $ "Invalid hex string: " <> T.pack err diff --git a/lib/Nostr/Event.hs b/lib/Nostr/Event.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Event.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Nostr.Event +Description : NIP-01 compliant Event types and utilities +Copyright : (c) Emre YILMAZ, 2026 +License : MIT +Maintainer : z@emre.xyz + +This module defines the core Event types according to NIP-01 specification. +-} + +module Nostr.Event + ( -- * Core Types + EventId(..) + , PubKey(..) + , Signature(..) + , Timestamp + , Kind + , Tag + , Event(..) + + -- * Event Kinds + , kindSetMetadata + , kindTextNote + , kindRecommendRelay + , kindContactList + , kindEncryptedDirectMessage + , kindDeletion + , kindAuth + + -- * Constructors and Validators + , mkEventId + , mkPubKey + , mkSignature + , validateHex64 + , isValidHex + + -- * Event Creation + , createUnsignedEvent + , validateEvent + + -- * Serialization + , serializeForSigning + ) where + +import Data.Aeson (FromJSON(..), ToJSON(..), Value, object, toJSON, withObject, (.:), (.=)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word64) +import Data.Char (isHexDigit) +import GHC.Generics (Generic) + +-- | Unix timestamp in seconds +type Timestamp = Word64 + +-- | Event kind as defined in NIP-01 +-- Kinds determine how the event should be interpreted +type Kind = Int + +-- | Standard event kinds +kindSetMetadata :: Kind +kindSetMetadata = 0 + +kindTextNote :: Kind +kindTextNote = 1 + +kindRecommendRelay :: Kind +kindRecommendRelay = 2 + +kindContactList :: Kind +kindContactList = 3 + +kindEncryptedDirectMessage :: Kind +kindEncryptedDirectMessage = 4 + +kindDeletion :: Kind +kindDeletion = 5 + +kindAuth :: Kind +kindAuth = 22242 + +-- | Tag is a JSON array of strings +-- Examples: ["e", "event_id"], ["p", "pubkey"] +type Tag = [Text] + +-- | Event ID - 64-character lowercase hex string (32 bytes) +-- Computed as SHA-256 hash of the serialized event data +newtype EventId = EventId { unEventId :: Text } + deriving (Show, Eq, Ord, Generic) + +-- | Public key - 64-character lowercase hex string (32 bytes) +-- secp256k1 public key of the event creator +newtype PubKey = PubKey { unPubKey :: Text } + deriving (Show, Eq, Ord, Generic) + +-- | Schnorr signature - 128-character lowercase hex string (64 bytes) +-- Signature over the event ID +newtype Signature = Signature { unSignature :: Text } + deriving (Show, Eq, Ord, Generic) + +-- | Check if a character is a valid hex digit (0-9, a-f) +isValidHex :: Char -> Bool +isValidHex c = isHexDigit c && (c >= '0' && c <= '9' || c >= 'a' && c <= 'f') + +-- | Validate that a Text is exactly 64 lowercase hex characters +validateHex64 :: Text -> Bool +validateHex64 t = T.length t == 64 && T.all isValidHex t + +-- | Validate that a Text is exactly 128 lowercase hex characters (for signatures) +validateHex128 :: Text -> Bool +validateHex128 t = T.length t == 128 && T.all isValidHex t + +-- | Smart constructor for EventId with validation +mkEventId :: Text -> Either Text EventId +mkEventId t + | validateHex64 t = Right (EventId t) + | otherwise = Left $ "Invalid EventId: must be 64 lowercase hex characters, got: " <> t + +-- | Smart constructor for PubKey with validation +mkPubKey :: Text -> Either Text PubKey +mkPubKey t + | validateHex64 t = Right (PubKey t) + | otherwise = Left $ "Invalid PubKey: must be 64 lowercase hex characters, got: " <> t + +-- | Smart constructor for Signature with validation +mkSignature :: Text -> Either Text Signature +mkSignature t + | validateHex128 t = Right (Signature t) + | otherwise = Left $ "Invalid Signature: must be 128 lowercase hex characters, got: " <> t + +-- | Nostr Event as defined in NIP-01 +-- All events must have these fields in this exact structure +data Event = Event + { eventId :: EventId -- ^ 32-byte SHA-256 hash, lowercase hex + , eventPubkey :: PubKey -- ^ 32-byte secp256k1 public key, lowercase hex + , eventCreatedAt :: Timestamp -- ^ Unix timestamp in seconds + , eventKind :: Kind -- ^ Event kind (0-65535) + , eventTags :: [Tag] -- ^ Array of tags (each tag is an array of strings) + , eventContent :: Text -- ^ Arbitrary string content + , eventSig :: Signature -- ^ 64-byte Schnorr signature, lowercase hex + } deriving (Show, Eq, Generic) + +-- | JSON serialization for EventId +instance ToJSON EventId where + toJSON (EventId t) = toJSON t + +instance FromJSON EventId where + parseJSON v = do + t <- parseJSON v + case mkEventId t of + Right eid -> return eid + Left err -> fail (T.unpack err) + +-- | JSON serialization for PubKey +instance ToJSON PubKey where + toJSON (PubKey t) = toJSON t + +instance FromJSON PubKey where + parseJSON v = do + t <- parseJSON v + case mkPubKey t of + Right pk -> return pk + Left err -> fail (T.unpack err) + +-- | JSON serialization for Signature +instance ToJSON Signature where + toJSON (Signature t) = toJSON t + +instance FromJSON Signature where + parseJSON v = do + t <- parseJSON v + case mkSignature t of + Right sig -> return sig + Left err -> fail (T.unpack err) + +-- | JSON serialization for Event (NIP-01 format) +instance ToJSON Event where + toJSON event = object + [ "id" .= eventId event + , "pubkey" .= eventPubkey event + , "created_at" .= eventCreatedAt event + , "kind" .= eventKind event + , "tags" .= eventTags event + , "content" .= eventContent event + , "sig" .= eventSig event + ] + +instance FromJSON Event where + parseJSON = withObject "Event" $ \v -> Event + <$> v .: "id" + <*> v .: "pubkey" + <*> v .: "created_at" + <*> v .: "kind" + <*> v .: "tags" + <*> v .: "content" + <*> v .: "sig" + +-- | Create an unsigned event (with dummy id and signature) +-- This should be signed using the Crypto module +createUnsignedEvent + :: PubKey -- ^ Public key of the creator + -> Timestamp -- ^ Creation timestamp + -> Kind -- ^ Event kind + -> [Tag] -- ^ Tags + -> Text -- ^ Content + -> Event +createUnsignedEvent pubkey created kind tags content = Event + { eventId = EventId (T.replicate 64 "0") -- Placeholder, to be computed + , eventPubkey = pubkey + , eventCreatedAt = created + , eventKind = kind + , eventTags = tags + , eventContent = content + , eventSig = Signature (T.replicate 128 "0") -- Placeholder, to be computed + } + +-- | Validate that an event has well-formed fields +validateEvent :: Event -> Either Text () +validateEvent event = do + -- EventId validation (already validated by newtype) + when (eventId event == EventId (T.replicate 64 "0")) $ + Left "Event has placeholder ID (not computed yet)" + + -- Signature validation + when (eventSig event == Signature (T.replicate 128 "0")) $ + Left "Event has placeholder signature (not signed yet)" + + -- Kind validation (should be in valid range) + when (eventKind event < 0 || eventKind event > 65535) $ + Left "Event kind must be between 0 and 65535" + + -- Timestamp validation (basic sanity check) + when (eventCreatedAt event == 0) $ + Left "Event timestamp cannot be zero" + + return () + where + when :: Bool -> Either Text () -> Either Text () + when True action = action + when False _ = Right () + + + +-- | Serialize event for signing (NIP-01 format) +-- Returns the JSON array: [0, , , , , ] +-- This is used by the Crypto module to compute the event ID +serializeForSigning :: Event -> Value +serializeForSigning event = toJSON + [ toJSON (0 :: Int) + , toJSON (unPubKey (eventPubkey event)) + , toJSON (eventCreatedAt event) + , toJSON (eventKind event) + , toJSON (eventTags event) + , toJSON (eventContent event) + ] diff --git a/lib/Nostr/Nip04.hs b/lib/Nostr/Nip04.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Nip04.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Nostr.Nip04 +Description : NIP-04 Encrypted Direct Message (Legacy) +Copyright : (c) Emre YILMAZ, 2026 +License : MIT +Maintainer : z@emre.xyz + +This module provides NIP-04 encryption and decryption. +-} + +module Nostr.Nip04 + ( encryptNip04 + , decryptNip04 + , sharedSecret + ) where + +import Crypto.Cipher.AES (AES256) +import Crypto.Cipher.Types (BlockCipher(..), Cipher(..), IV, makeIV) +import Crypto.Error (CryptoFailable(..)) +import qualified Crypto.Curve.Secp256k1 as Secp +import Data.ByteArray (ByteArray, ByteArrayAccess) +import qualified Data.ByteArray as BA +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified System.Entropy as E + +import Nostr.Crypto (SecKey, hexToBytes) +import Nostr.Event (PubKey(..)) + +-- | Compute shared secret using ECDH +sharedSecret :: SecKey -> PubKey -> Maybe ByteString +sharedSecret secKey pubKey = do + -- Parse the x-only public key from hex. We prefix with 0x02 to parse as compressed point. + pubBytes <- either (const Nothing) Just (hexToBytes $ unPubKey pubKey) + let compressedPubKey = BS.cons 0x02 pubBytes + pubPoint <- Secp.parse_point compressedPubKey + + -- Use ppad-secp256k1 ecdh. Note: If this computes SHA256 of the point instead of + -- just returning the X coordinate, we might need to use `mul` directly. + -- Let's try `ecdh` first. + Secp.ecdh pubPoint secKey + +-- | PKCS7 padding +padPKCS7 :: Int -> ByteString -> ByteString +padPKCS7 blockSize bs = + let len = BS.length bs + padLen = blockSize - (len `mod` blockSize) + padding = BS.replicate padLen (fromIntegral padLen) + in BS.append bs padding + +-- | PKCS7 unpadding +unpadPKCS7 :: ByteString -> Maybe ByteString +unpadPKCS7 bs = + let len = BS.length bs + padLen = fromIntegral $ BS.last bs + in if padLen > 0 && padLen <= 16 && len >= padLen + then Just $ BS.take (len - padLen) bs + else Nothing + +-- | Encrypt text message +encryptNip04 :: SecKey -> PubKey -> Text -> IO (Maybe Text) +encryptNip04 secKey pubKey msg = do + case sharedSecret secKey pubKey of + Nothing -> return Nothing + Just secret -> do + ivBytes <- E.getEntropy 16 + case initCipher secret of + CryptoFailed _ -> return Nothing + CryptoPassed cipher -> + case makeIV ivBytes :: Maybe (IV AES256) of + Nothing -> return Nothing + Just iv -> do + let paddedMsg = padPKCS7 16 (TE.encodeUtf8 msg) + let ciphertext = cbcEncrypt cipher iv paddedMsg + let b64Cipher = TE.decodeUtf8 $ B64.encode ciphertext + let b64Iv = TE.decodeUtf8 $ B64.encode ivBytes + return $ Just $ b64Cipher <> "?iv=" <> b64Iv + +-- | Decrypt text message +decryptNip04 :: SecKey -> PubKey -> Text -> Maybe Text +decryptNip04 secKey pubKey encryptedMsg = do + let parts = T.splitOn "?iv=" encryptedMsg + case parts of + [b64Cipher, b64Iv] -> do + secret <- sharedSecret secKey pubKey + cipherBytes <- either (const Nothing) Just (B64.decode $ TE.encodeUtf8 b64Cipher) + ivBytes <- either (const Nothing) Just (B64.decode $ TE.encodeUtf8 b64Iv) + + cipher <- case initCipher secret of + CryptoPassed c -> Just c + CryptoFailed _ -> Nothing + + iv <- makeIV ivBytes :: Maybe (IV AES256) + + let decryptedPadded = cbcDecrypt cipher iv cipherBytes + decryptedBytes <- unpadPKCS7 decryptedPadded + Just $ TE.decodeUtf8 decryptedBytes + + _ -> Nothing + +-- | Initialize AES256 cipher +initCipher :: ByteString -> CryptoFailable AES256 +initCipher = cipherInit diff --git a/lib/Nostr/Nip05.hs b/lib/Nostr/Nip05.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Nip05.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Nostr.Nip05 + ( Nip05Id + , verifyNip05 + , resolveNip05 + ) where + +import Control.Exception (try, SomeException) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Aeson (FromJSON, parseJSON, withObject, (.:?), (.:)) +import qualified Data.Aeson as Aeson +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Network.HTTP.Simple + ( httpJSON + , getResponseBody + , parseRequest + , setRequestSecure + , setRequestPort + , Response + ) + +import Nostr.Event (PubKey(..)) +import Nostr.Client (parsePubKey) + +type Nip05Id = Text + +-- | JSON Response structure for NIP-05 +-- { "names": { "bob": "pubkey_hex" } } +data Nip05Response = Nip05Response + { nip05Names :: Map Text Text + } deriving (Show) + +instance FromJSON Nip05Response where + parseJSON = withObject "Nip05Response" $ \v -> Nip05Response + <$> v .: "names" + +-- | Verify a NIP-05 identifier matches a given public key +verifyNip05 :: MonadIO m => Nip05Id -> PubKey -> m Bool +verifyNip05 identifier (PubKey pkHex) = do + mPub <- resolveNip05 identifier + case mPub of + Just (PubKey resolvedHex) -> return $ pkHex == resolvedHex + Nothing -> return False + +-- | Resolve a NIP-05 identifier to a Public Key +resolveNip05 :: MonadIO m => Nip05Id -> m (Maybe PubKey) +resolveNip05 identifier = liftIO $ do + let (name, domain) = parseIdentifier identifier + let url = "https://" <> domain <> "/.well-known/nostr.json?name=" <> name + + -- PutStrLn for debugging + -- putStrLn $ "Resolving NIP-05: " ++ T.unpack url + + req <- parseRequest (T.unpack url) + -- Ensure HTTPS + let req' = setRequestSecure True $ setRequestPort 443 req + + result <- try (httpJSON req') :: IO (Either SomeException (Response Nip05Response)) + + case result of + Left _ -> return Nothing + Right response -> do + let nip05Resp = getResponseBody response + case Map.lookup name (nip05Names nip05Resp) of + Just pubKeyHex -> return $ parsePubKey pubKeyHex + Nothing -> return Nothing + + where + parseIdentifier :: Text -> (Text, Text) + parseIdentifier t = + case T.splitOn "@" t of + [n, d] -> (n, d) + [d] -> ("_", d) -- Handle domain-only as root? Spec says @ usually + _ -> (t, "") -- Invalid fallback diff --git a/lib/Nostr/Nip11.hs b/lib/Nostr/Nip11.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Nip11.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} + +{-| +Module : Nostr.Nip11 +Description : NIP-11 Relay Information Document +Copyright : (c) Emre YILMAZ, 2026 +License : MIT +Maintainer : z@emre.xyz + +This module implements NIP-11, allowing clients to fetch relay capabilities +and information. +-} + +module Nostr.Nip11 + ( RelayInfo(..) + , fetchRelayInfo + ) where + +import Data.Aeson (FromJSON(..), ToJSON(..), withObject, (.:?)) +import qualified Data.Aeson as A +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import GHC.Generics (Generic) +import Network.HTTP.Simple +import Control.Exception (try, SomeException) + +-- | Information about a relay +data RelayInfo = RelayInfo + { riName :: Maybe Text + , riDescription :: Maybe Text + , riPubkey :: Maybe Text + , riContact :: Maybe Text + , riSupportedNips :: Maybe [Int] + , riSoftware :: Maybe Text + , riVersion :: Maybe Text + } deriving (Show, Eq, Generic) + +instance FromJSON RelayInfo where + parseJSON = withObject "RelayInfo" $ \v -> RelayInfo + <$> v .:? "name" + <*> v .:? "description" + <*> v .:? "pubkey" + <*> v .:? "contact" + <*> v .:? "supported_nips" + <*> v .:? "software" + <*> v .:? "version" + +instance ToJSON RelayInfo where + toJSON ri = A.object $ catMaybes + [ ("name" A..=) <$> riName ri + , ("description" A..=) <$> riDescription ri + , ("pubkey" A..=) <$> riPubkey ri + , ("contact" A..=) <$> riContact ri + , ("supported_nips" A..=) <$> riSupportedNips ri + , ("software" A..=) <$> riSoftware ri + , ("version" A..=) <$> riVersion ri + ] + where + catMaybes = foldr (\mx xs -> maybe xs (:xs) mx) [] + +-- | Convert a websocket URL (wss:// or ws://) to HTTP (https:// or http://) +toHttpUrl :: Text -> Text +toHttpUrl url + | "wss://" `T.isPrefixOf` url = "https://" <> T.drop 6 url + | "ws://" `T.isPrefixOf` url = "http://" <> T.drop 5 url + | otherwise = url + +-- | Fetch relay information document +fetchRelayInfo :: Text -> IO (Either String RelayInfo) +fetchRelayInfo relayUrl = do + let httpUrl = T.unpack $ toHttpUrl relayUrl + req <- parseRequest httpUrl + let reqWithHeaders = setRequestHeader "Accept" ["application/nostr+json"] req + + result <- try $ httpJSON reqWithHeaders :: IO (Either SomeException (Response RelayInfo)) + case result of + Left err -> return $ Left $ "HTTP request failed: " ++ show err + Right response -> return $ Right $ getResponseBody response diff --git a/lib/Nostr/Nip19.hs b/lib/Nostr/Nip19.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Nip19.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Nostr.Nip19 + ( -- * Encoding + toNpub + , toNsec + , toNote + , toNprofile + , toNevent + -- * Decoding + , Nip19Object(..) + , ProfilePtr(..) + , EventPtr(..) + , decode + ) where + +import Codec.Binary.Bech32 (dataPartFromBytes, dataPartToBytes, encode, decodeLenient, humanReadablePartFromText) +import qualified Codec.Binary.Bech32 as Bech32 +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Word (Word8) + +import Nostr.Crypto +import Nostr.Event (EventId(..), PubKey(..), mkPubKey, mkEventId) + +-- | Decoded NIP-19 Object +data Nip19Object + = Nip19Pub PubKey + | Nip19Sec SecKey + | Nip19Note EventId + | Nip19Profile ProfilePtr + | Nip19Event EventPtr + deriving (Show) + +instance Eq Nip19Object where + (Nip19Pub a) == (Nip19Pub b) = a == b + (Nip19Sec a) == (Nip19Sec b) = exportSecKey a == exportSecKey b + (Nip19Note a) == (Nip19Note b) = a == b + (Nip19Profile a) == (Nip19Profile b) = a == b + (Nip19Event a) == (Nip19Event b) = a == b + _ == _ = False + +data ProfilePtr = ProfilePtr + { ppPubkey :: PubKey + , ppRelays :: [Text] + } deriving (Show, Eq) + +data EventPtr = EventPtr + { epEventId :: EventId + , epRelays :: [Text] + , epAuthor :: Maybe PubKey + } deriving (Show, Eq) + +-- | Encode a Public Key as npub +toNpub :: PubKey -> Maybe Text +toNpub pk = do + pkBytes <- either (const Nothing) Just $ hexToBytes (exportPubKey pk) + encodeBech32 "npub" pkBytes + +-- | Encode a Secret Key as nsec +toNsec :: SecKey -> Maybe Text +toNsec sk = do + skBytes <- either (const Nothing) Just $ hexToBytes (exportSecKey sk) + encodeBech32 "nsec" skBytes + +-- | Encode an Event ID as note +toNote :: EventId -> Maybe Text +toNote (EventId eid) = do + eidBytes <- either (const Nothing) Just $ hexToBytes eid + encodeBech32 "note" eidBytes + +-- | Encode a profile pointer as nprofile (TLV) +toNprofile :: PubKey -> [Text] -> Maybe Text +toNprofile pk relays = do + pkBytes <- either (const Nothing) Just $ hexToBytes (exportPubKey pk) + -- TLV encoding: type (1 byte) + length (1 byte) + value + -- Type 0: special (pubkey), 32 bytes + -- Type 1: relay, variable length + let tlv = encodeTLV 0 pkBytes <> mconcat (map (encodeTLV 1 . TE.encodeUtf8) relays) + encodeBech32 "nprofile" tlv + +-- | Encode an event pointer as nevent (TLV) +toNevent :: EventId -> [Text] -> Maybe PubKey -> Maybe Text +toNevent (EventId eid) relays author = do + eidBytes <- either (const Nothing) Just $ hexToBytes eid + + authorBytes <- case author of + Just pk -> do + pkBytes <- either (const Nothing) Just $ hexToBytes (exportPubKey pk) + return $ encodeTLV 2 pkBytes + Nothing -> return BS.empty + + let tlv = encodeTLV 0 eidBytes + <> mconcat (map (encodeTLV 1 . TE.encodeUtf8) relays) + <> authorBytes + encodeBech32 "nevent" tlv + +-- | Generic Bech32 Encoder +encodeBech32 :: Text -> ByteString -> Maybe Text +encodeBech32 prefix dataBytes = do + hrp <- qualifiedHumanReadablePartFromText prefix + let dataPart = dataPartFromBytes dataBytes + either (const Nothing) Just $ encode hrp dataPart + where + qualifiedHumanReadablePartFromText t = + either (const Nothing) Just $ humanReadablePartFromText t + +-- | TLV Encoder +-- Type (8-bit), Length (8-bit), Value +encodeTLV :: Word8 -> ByteString -> ByteString +encodeTLV typ val = + let len = fromIntegral (BS.length val) :: Word8 + in BS.pack [typ, len] <> val + +-- | Decode a Bech32 string +decode :: Text -> Either Text Nip19Object +decode input = case decodeLenient input of + Left err -> Left $ "Bech32 decode error: " <> T.pack (show err) + Right (hrp, dataPart) -> do + let prefix = Bech32.humanReadablePartToText hrp + bytes <- maybe (Left "Invalid data part") Right $ dataPartToBytes dataPart + + case prefix of + "npub" -> do + pk <- parsePubKey bytes + Right $ Nip19Pub pk + "nsec" -> do + sk <- parseSecKey bytes + Right $ Nip19Sec sk + "note" -> do + eid <- parseEventId bytes + Right $ Nip19Note eid + "nprofile" -> do + ptr <- parseProfileTLV bytes + Right $ Nip19Profile ptr + "nevent" -> do + ptr <- parseEventTLV bytes + Right $ Nip19Event ptr + _ -> Left $ "Unknown prefix: " <> prefix + +-- Helpers for parsing +parsePubKey :: ByteString -> Either Text PubKey +parsePubKey bs = + let hex = bytesToHex bs + in Nostr.Event.mkPubKey hex + +parseSecKey :: ByteString -> Either Text SecKey +parseSecKey bs = + case secKeyFromBytes bs of + Just sk -> Right sk + Nothing -> Left "Invalid secret key bytes" + +parseEventId :: ByteString -> Either Text EventId +parseEventId bs = + let hex = bytesToHex bs + in Nostr.Event.mkEventId hex + +parseProfileTLV :: ByteString -> Either Text ProfilePtr +parseProfileTLV bs = do + tlv <- parseTLV bs + pubkeyBs <- maybe (Left "Missing pubkey in nprofile") Right (findTLV 0 tlv) + pubkey <- parsePubKey pubkeyBs + let relays = map TE.decodeUtf8 (findAllTLV 1 tlv) + Right $ ProfilePtr pubkey relays + +parseEventTLV :: ByteString -> Either Text EventPtr +parseEventTLV bs = do + tlv <- parseTLV bs + eventIdBs <- maybe (Left "Missing event ID in nevent") Right (findTLV 0 tlv) + eventId <- parseEventId eventIdBs + let relays = map TE.decodeUtf8 (findAllTLV 1 tlv) + author <- case findTLV 2 tlv of + Just authorBs -> Just <$> parsePubKey authorBs + Nothing -> Right Nothing + Right $ EventPtr eventId relays author + +-- | Parse TLV data into list of (type, value) pairs +parseTLV :: ByteString -> Either Text [(Word8, ByteString)] +parseTLV bs = go bs [] + where + go remaining acc + | BS.null remaining = Right (reverse acc) + | BS.length remaining < 2 = Left "Incomplete TLV entry" + | otherwise = do + let typ = BS.head remaining + let len = fromIntegral (BS.index remaining 1) :: Int + let remaining' = BS.drop 2 remaining + if BS.length remaining' < len + then Left "TLV value truncated" + else do + let val = BS.take len remaining' + let rest = BS.drop len remaining' + go rest ((typ, val) : acc) + +-- | Find first TLV entry of given type +findTLV :: Word8 -> [(Word8, ByteString)] -> Maybe ByteString +findTLV typ = lookup typ + +-- | Find all TLV entries of given type +findAllTLV :: Word8 -> [(Word8, ByteString)] -> [ByteString] +findAllTLV typ = mapMaybe (\(t, v) -> if t == typ then Just v else Nothing) diff --git a/lib/Nostr/Nip21.hs b/lib/Nostr/Nip21.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Nip21.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Nostr.Nip21 + ( -- * URI Handling + parseNostrUri + , toNostrUri + ) where + +import Data.Text (Text) +import qualified Data.Text as T + +import Nostr.Nip19 (Nip19Object(..), ProfilePtr(..), EventPtr(..), decode, toNpub, toNsec, toNote, toNprofile, toNevent) + +-- | Parse a nostr: URI into a Nip19Object +-- Strips the "nostr:" prefix and decodes the NIP-19 string +parseNostrUri :: Text -> Either Text Nip19Object +parseNostrUri uri + | "nostr:" `T.isPrefixOf` uri = decode (T.drop 6 uri) + | otherwise = Left "URI does not start with 'nostr:'" + +-- | Generate a nostr: URI from a Nip19Object +-- Adds the "nostr:" prefix to the NIP-19 encoded string +toNostrUri :: Nip19Object -> Maybe Text +toNostrUri obj = do + encoded <- case obj of + Nip19Pub pk -> toNpub pk + Nip19Sec sk -> toNsec sk + Nip19Note eid -> toNote eid + Nip19Profile (ProfilePtr pk relays) -> toNprofile pk relays + Nip19Event (EventPtr eid relays author) -> toNevent eid relays author + return ("nostr:" <> encoded) diff --git a/lib/Nostr/Nip57.hs b/lib/Nostr/Nip57.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Nip57.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Nostr.Nip57 +Description : NIP-57 Lightning Zaps +Copyright : (c) Emre YILMAZ, 2026 +License : MIT +Maintainer : z@emre.xyz + +This module provides support for NIP-57 Zap Requests and Receipts. +-} + +module Nostr.Nip57 + ( kindZapRequest + , kindZapReceipt + , ZapRequest(..) + , ZapReceipt(..) + , parseZapRequest + , parseZapReceipt + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Maybe (listToMaybe, mapMaybe) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as BSL +import qualified Data.Text.Encoding as TE + +import Nostr.Event (Event(..), Kind, Tag, PubKey) + +kindZapRequest :: Kind +kindZapRequest = 9734 + +kindZapReceipt :: Kind +kindZapReceipt = 9735 + +-- | Represents a Zap Request (kind 9734) +data ZapRequest = ZapRequest + { zrRelays :: [Text] + , zrAmount :: Maybe Text + , zrLnurl :: Maybe Text + , zrP :: Text -- Recipient pubkey + , zrE :: Maybe Text -- Event id being zapped + } deriving (Show, Eq) + +-- | Represents a Zap Receipt (kind 9735) +data ZapReceipt = ZapReceipt + { zrpBolt11 :: Text + , zrpPreimage :: Maybe Text + , zrpDescription :: Text -- The JSON representation of the Zap Request event + , zrpP :: Text + , zrpE :: Maybe Text + } deriving (Show, Eq) + +findTagValue :: Text -> [Tag] -> Maybe Text +findTagValue name tags = listToMaybe $ mapMaybe (extract name) tags + where + extract n (t:v:_) | t == n = Just v + extract _ _ = Nothing + +findTagValues :: Text -> [Tag] -> [Text] +findTagValues name tags = mapMaybe (extract name) tags + where + extract n (t:v:_) | t == n = Just v + extract _ _ = Nothing + +-- | Parse an Event into a ZapRequest if it matches kind 9734 +parseZapRequest :: Event -> Maybe ZapRequest +parseZapRequest ev + | eventKind ev /= kindZapRequest = Nothing + | otherwise = do + let tags = eventTags ev + p <- findTagValue "p" tags + + -- relays tag can have multiple values in a single tag ["relays", "url1", "url2"] + -- or multiple ["relays", "url1"] tags. We handle both by concat. + let relays = concatMap (drop 1) (filter (\t -> case t of ("relays":_) -> True; _ -> False) tags) + + return $ ZapRequest + { zrRelays = relays + , zrAmount = findTagValue "amount" tags + , zrLnurl = findTagValue "lnurl" tags + , zrP = p + , zrE = findTagValue "e" tags + } + +-- | Parse an Event into a ZapReceipt if it matches kind 9735 +parseZapReceipt :: Event -> Maybe ZapReceipt +parseZapReceipt ev + | eventKind ev /= kindZapReceipt = Nothing + | otherwise = do + let tags = eventTags ev + bolt11 <- findTagValue "bolt11" tags + description <- findTagValue "description" tags + p <- findTagValue "p" tags + + return $ ZapReceipt + { zrpBolt11 = bolt11 + , zrpPreimage = findTagValue "preimage" tags + , zrpDescription = description + , zrpP = p + , zrpE = findTagValue "e" tags + } diff --git a/lib/Nostr/Nip65.hs b/lib/Nostr/Nip65.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Nip65.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Nostr.Nip65 +Description : NIP-65 Relay List Metadata +Copyright : (c) Emre YILMAZ, 2026 +License : MIT +Maintainer : z@emre.xyz + +This module provides support for NIP-65, which allows users to advertise +which relays they use to read and write events. +-} + +module Nostr.Nip65 + ( -- * Constants + kindRelayListMetadata + + -- * Types + , RelayMarker(..) + , RelayListEntry(..) + + -- * Helpers + , mkRelayListTag + , parseRelayListTag + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Nostr.Event (Tag, Kind) + +-- | Event kind for Relay List Metadata (10002) +kindRelayListMetadata :: Kind +kindRelayListMetadata = 10002 + +-- | Determines if a relay is used for reading, writing, or both. +data RelayMarker + = ReadMarker + | WriteMarker + | BothMarker + deriving (Show, Eq) + +-- | Represents a single relay entry in the list +data RelayListEntry = RelayListEntry + { rleUrl :: Text + , rleMarker :: RelayMarker + } deriving (Show, Eq) + +-- | Create a tag for a relay list entry +mkRelayListTag :: RelayListEntry -> Tag +mkRelayListTag (RelayListEntry url BothMarker) = ["r", url] +mkRelayListTag (RelayListEntry url ReadMarker) = ["r", url, "read"] +mkRelayListTag (RelayListEntry url WriteMarker) = ["r", url, "write"] + +-- | Parse a tag into a RelayListEntry if possible +parseRelayListTag :: Tag -> Maybe RelayListEntry +parseRelayListTag ["r", url] = Just $ RelayListEntry url BothMarker +parseRelayListTag ["r", url, "read"] = Just $ RelayListEntry url ReadMarker +parseRelayListTag ["r", url, "write"] = Just $ RelayListEntry url WriteMarker +parseRelayListTag _ = Nothing diff --git a/lib/Nostr/Relay.hs b/lib/Nostr/Relay.hs new file mode 100644 --- /dev/null +++ b/lib/Nostr/Relay.hs @@ -0,0 +1,347 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-| +Module : Nostr.Relay +Description : NIP-01 client-relay communication types and utilities +Copyright : (c) Emre YILMAZ, 2026 +License : MIT +Maintainer : z@emre.xyz + +This module defines the message types for client-relay communication +according to NIP-01 specification. +-} + +module Nostr.Relay + ( -- * Core Types + SubscriptionId(..) + , ClientMessage(..) + , RelayMessage(..) + , Filter(..) + , RelayConnection(..) + + -- * Filter Helpers + , defaultFilter + + -- * WebSocket Connection + , connectRelay + , sendMessage + , receiveMessage + , closeConnection + ) where + +import Control.Concurrent (forkIO, killThread, threadDelay) +import Control.Concurrent.STM +import Control.Exception (finally, catch, SomeException) +import Control.Monad (forever) +import Data.Aeson (FromJSON(..), ToJSON(..), object, withArray, withObject, (.:?), (.=)) +import qualified Data.Aeson as A +import qualified Data.Aeson.Types as A +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Vector as V +import GHC.Generics (Generic) +import qualified Network.WebSockets as WS +import qualified Wuss + +import Nostr.Event + +-- | Subscription ID used to identify subscriptions +-- Can be any arbitrary string chosen by the client +newtype SubscriptionId = SubscriptionId { unSubscriptionId :: Text } + deriving (Show, Eq, Ord, Generic) + +instance ToJSON SubscriptionId where + toJSON (SubscriptionId sid) = toJSON sid + +instance FromJSON SubscriptionId where + parseJSON v = SubscriptionId <$> parseJSON v + +-- ============================================================================ +-- Client Messages (Client → Relay) +-- ============================================================================ + +-- | Messages sent from client to relay +data ClientMessage + = CMEvent Event -- ^ ["EVENT", ] + | CMReq SubscriptionId [Filter] -- ^ ["REQ", , , , ...] + | CMClose SubscriptionId -- ^ ["CLOSE", ] + | CMAuth Event -- ^ ["AUTH", ] (NIP-42) + deriving (Show, Eq, Generic) + +instance ToJSON ClientMessage where + toJSON (CMEvent event) = + A.Array $ V.fromList [A.String "EVENT", A.toJSON event] + + toJSON (CMReq subId filters) = + A.Array $ V.fromList $ [A.String "REQ", A.toJSON subId] ++ map A.toJSON filters + + toJSON (CMClose subId) = + A.Array $ V.fromList [A.String "CLOSE", A.toJSON subId] + + toJSON (CMAuth event) = + A.Array $ V.fromList [A.String "AUTH", A.toJSON event] + +instance FromJSON ClientMessage where + parseJSON = withArray "ClientMessage" $ \arr -> do + when (V.length arr < 2) $ + fail "ClientMessage array must have at least 2 elements" + + msgType <- parseJSON (V.head arr) :: A.Parser Text + + case msgType of + "EVENT" -> do + when (V.length arr /= 2) $ + fail "EVENT message must have exactly 2 elements" + event <- parseJSON (arr V.! 1) + return $ CMEvent event + + "REQ" -> do + when (V.length arr < 3) $ + fail "REQ message must have at least 3 elements (type, subscription_id, filter)" + subId <- parseJSON (arr V.! 1) + filters <- mapM parseJSON (V.toList $ V.drop 2 arr) + return $ CMReq subId filters + + "CLOSE" -> do + when (V.length arr /= 2) $ + fail "CLOSE message must have exactly 2 elements" + subId <- parseJSON (arr V.! 1) + return $ CMClose subId + + "AUTH" -> do + when (V.length arr /= 2) $ + fail "AUTH message must have exactly 2 elements" + event <- parseJSON (arr V.! 1) + return $ CMAuth event + + _ -> fail $ "Unknown client message type: " ++ T.unpack msgType + where + when :: Bool -> A.Parser () -> A.Parser () + when True action = action + when False _ = return () + +-- ============================================================================ +-- Relay Messages (Relay → Client) +-- ============================================================================ + +-- | Messages sent from relay to client +data RelayMessage + = RMEvent SubscriptionId Event -- ^ ["EVENT", , ] + | RMOK EventId Bool Text -- ^ ["OK", , , ] + | RMEOSE SubscriptionId -- ^ ["EOSE", ] + | RMClosed SubscriptionId Text -- ^ ["CLOSED", , ] + | RMNotice Text -- ^ ["NOTICE", ] + | RMAuth Text -- ^ ["AUTH", ] (NIP-42) + deriving (Show, Eq, Generic) + +instance ToJSON RelayMessage where + toJSON (RMEvent subId event) = + A.Array $ V.fromList [A.String "EVENT", A.toJSON subId, A.toJSON event] + + toJSON (RMOK eventId accepted msg) = + A.Array $ V.fromList [A.String "OK", A.toJSON eventId, A.toJSON accepted, A.toJSON msg] + + toJSON (RMEOSE subId) = + A.Array $ V.fromList [A.String "EOSE", A.toJSON subId] + + toJSON (RMClosed subId msg) = + A.Array $ V.fromList [A.String "CLOSED", A.toJSON subId, A.toJSON msg] + + toJSON (RMNotice msg) = + A.Array $ V.fromList [A.String "NOTICE", A.toJSON msg] + + toJSON (RMAuth challenge) = + A.Array $ V.fromList [A.String "AUTH", A.toJSON challenge] + +instance FromJSON RelayMessage where + parseJSON = withArray "RelayMessage" $ \arr -> do + when (V.length arr < 2) $ + fail "RelayMessage array must have at least 2 elements" + + msgType <- parseJSON (V.head arr) :: A.Parser Text + + case msgType of + "EVENT" -> do + when (V.length arr /= 3) $ + fail "EVENT message must have exactly 3 elements" + subId <- parseJSON (arr V.! 1) + event <- parseJSON (arr V.! 2) + return $ RMEvent subId event + + "OK" -> do + when (V.length arr /= 4) $ + fail "OK message must have exactly 4 elements" + eventId <- parseJSON (arr V.! 1) + accepted <- parseJSON (arr V.! 2) + msg <- parseJSON (arr V.! 3) + return $ RMOK eventId accepted msg + + "EOSE" -> do + when (V.length arr /= 2) $ + fail "EOSE message must have exactly 2 elements" + subId <- parseJSON (arr V.! 1) + return $ RMEOSE subId + + "CLOSED" -> do + when (V.length arr /= 3) $ + fail "CLOSED message must have exactly 3 elements" + subId <- parseJSON (arr V.! 1) + msg <- parseJSON (arr V.! 2) + return $ RMClosed subId msg + + "NOTICE" -> do + when (V.length arr /= 2) $ + fail "NOTICE message must have exactly 2 elements" + msg <- parseJSON (arr V.! 1) + return $ RMNotice msg + + "AUTH" -> do + when (V.length arr /= 2) $ + fail "AUTH message must have exactly 2 elements" + challenge <- parseJSON (arr V.! 1) + return $ RMAuth challenge + + _ -> fail $ "Unknown relay message type: " ++ T.unpack msgType + where + when :: Bool -> A.Parser () -> A.Parser () + when True action = action + when False _ = return () + +-- ============================================================================ +-- Filter +-- ============================================================================ + +-- | Filter for subscription queries +-- All fields are optional, matching events must satisfy all present conditions +data Filter = Filter + { filterIds :: Maybe [EventId] -- ^ Event IDs to match + , filterAuthors :: Maybe [PubKey] -- ^ Author public keys to match + , filterKinds :: Maybe [Kind] -- ^ Event kinds to match + , filterETags :: Maybe [EventId] -- ^ #e tags to match + , filterPTags :: Maybe [PubKey] -- ^ #p tags to match + , filterSince :: Maybe Timestamp -- ^ Events after this timestamp + , filterUntil :: Maybe Timestamp -- ^ Events before this timestamp + , filterLimit :: Maybe Int -- ^ Maximum number of events to return + } deriving (Show, Eq, Generic) + +-- | Default empty filter (matches everything) +defaultFilter :: Filter +defaultFilter = Filter + { filterIds = Nothing + , filterAuthors = Nothing + , filterKinds = Nothing + , filterETags = Nothing + , filterPTags = Nothing + , filterSince = Nothing + , filterUntil = Nothing + , filterLimit = Nothing + } + +instance ToJSON Filter where + toJSON f = object $ catMaybes + [ ("ids" .=) <$> filterIds f + , ("authors" .=) <$> filterAuthors f + , ("kinds" .=) <$> filterKinds f + , ("#e" .=) <$> filterETags f + , ("#p" .=) <$> filterPTags f + , ("since" .=) <$> filterSince f + , ("until" .=) <$> filterUntil f + , ("limit" .=) <$> filterLimit f + ] + where + catMaybes :: [Maybe a] -> [a] + catMaybes = foldr (\mx xs -> maybe xs (:xs) mx) [] + +instance FromJSON Filter where + parseJSON = withObject "Filter" $ \v -> Filter + <$> v .:? "ids" + <*> v .:? "authors" + <*> v .:? "kinds" + <*> v .:? "#e" + <*> v .:? "#p" + <*> v .:? "since" + <*> v .:? "until" + <*> v .:? "limit" + +-- ============================================================================ +-- WebSocket Connection +-- ============================================================================ + +-- | Relay WebSocket connection +data RelayConnection = RelayConnection + { relayUrl :: Text + , sendChan :: TChan ClientMessage + , recvChan :: TChan RelayMessage + , cleanup :: IO () + } + +-- | Connect to a Nostr relay via WebSocket +-- Takes a relay URL (e.g., "wss://relay.damus.io") and starts background threads +connectRelay :: Text -> IO RelayConnection +connectRelay url = do + sChan <- newTChanIO + rChan <- newTChanIO + + let (isSecure, host, port, path) = parseRelayUrl url + + -- Connection handler shared between secure and plain connections + let wsApp conn = do + -- Fork a sender thread that reads from sChan and sends to WS + senderTid <- forkIO $ forever $ do + msg <- atomically $ readTChan sChan + WS.sendTextData conn (A.encode msg) + + -- Main loop: receive from WS and write to rChan + flip finally (killThread senderTid) $ forever $ do + msgData <- WS.receiveData conn + case A.eitherDecode msgData of + Right relayMsg -> atomically $ writeTChan rChan relayMsg + Left _ -> return () + + -- Connection loop with exponential backoff + let connectLoop delay = do + let runConn = if isSecure + then Wuss.runSecureClient (T.unpack host) (fromIntegral port) (T.unpack path) wsApp + else WS.runClient (T.unpack host) port (T.unpack path) wsApp + catch runConn (\(_ :: SomeException) -> do + threadDelay delay + let newDelay = min 60000000 (delay * 2) + connectLoop newDelay + ) + + tid <- forkIO $ connectLoop 1000000 -- Start with 1 second delay + + return $ RelayConnection url sChan rChan (killThread tid) + where + -- Parse relay URL to extract scheme, host, port, and path + parseRelayUrl :: Text -> (Bool, Text, Int, Text) + parseRelayUrl u = + let (secure, stripped) = case T.stripPrefix "wss://" u of + Just s -> (True, s) + Nothing -> case T.stripPrefix "ws://" u of + Just s -> (False, s) + Nothing -> (True, u) -- Default to secure + (hostPort, pathWithSlash) = T.breakOn "/" stripped + path = if T.null pathWithSlash then "/" else pathWithSlash + (host, portText) = T.breakOn ":" hostPort + port = case T.stripPrefix ":" portText of + Just p -> case reads (T.unpack p) of + [(n, "")] -> n + _ -> if secure then 443 else 80 + Nothing -> if secure then 443 else 80 + in (secure, host, port, path) + +-- | Send a client message to the relay +sendMessage :: RelayConnection -> ClientMessage -> IO () +sendMessage conn msg = atomically $ writeTChan (sendChan conn) msg + +-- | Receive a relay message from the relay +-- This is a blocking operation that waits for the next message +receiveMessage :: RelayConnection -> IO RelayMessage +receiveMessage conn = atomically $ readTChan (recvChan conn) + +-- | Close the relay connection +closeConnection :: RelayConnection -> IO () +closeConnection conn = cleanup conn diff --git a/nostr.cabal b/nostr.cabal new file mode 100644 --- /dev/null +++ b/nostr.cabal @@ -0,0 +1,181 @@ +cabal-version: 3.0 +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- Initial package description 'nostr' generated by +-- 'cabal init'. For further documentation, see: +-- http://haskell.org/cabal/users-guide/ +-- +-- The name of the package. +name: nostr + +-- The package version. +-- See the Haskell package versioning policy (PVP) for standards +-- guiding when and how versions should be incremented. +-- https://pvp.haskell.org +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 1.3.0.0 +bug-reports: https://github.com/delirehberi/nostr.hs/issues + +-- A short (one-line) description of the package. +synopsis: Nostr library + +-- A longer description of the package. +description: A Haskell library for the Nostr protocol, providing + client and relay communication, event handling, and + support for various NIPs including authentication, + threading, and URI schemes. + +-- URL for the project homepage or repository. +homepage: https://nostrhs.emre.xyz + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Emre YILMAZ + +-- An email address to which users can send suggestions, bug reports, and patches. +maintainer: z@emre.xyz + +-- A copyright notice. +-- copyright: +category: Network +build-type: Simple + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +extra-doc-files: CHANGELOG.md + +-- Extra source files to be distributed with the package, such as examples, or a tutorial module. +-- extra-source-files: + +source-repository head + type: git + location: https://github.com/delirehberi/nostr.hs.git + + +common warnings + ghc-options: -Wall + +library + -- Import common warning flags. + import: warnings + + -- Modules exported by the library. + exposed-modules: Nostr.Event , Nostr.Relay, Nostr.Crypto, Nostr.Client, Nostr.Nip19, Nostr.Nip05, Nostr.Nip21, Nostr.Nip11, Nostr.Nip65, Nostr.Nip04, Nostr.Nip57 + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.18.0.0 && <4.20 + , aeson + , bytestring + , text + , unix-time + , websockets + , ppad-secp256k1 >= 0.4.0 + , ppad-fixed + , nonempty-wrapper-text + , cryptonite + , memory + , base16-bytestring + , vector + , entropy + , containers + , async + , stm + , http-conduit + , mtl + , time + , wuss + , bech32 + , base64-bytestring + + -- Directories containing source files. + hs-source-dirs: lib + + -- Base language which the package is written in. + default-language: Haskell2010 + +executable nostr + -- Import common warning flags. + import: warnings + + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: + base >=4.18.0.0 && <4.20, + nostr, + aeson, + bytestring, + text, + time + + -- Directories containing source files. + hs-source-dirs: app + + -- Base language which the package is written in. + default-language: Haskell2010 + +executable nostr-example + import: warnings + main-is: Example.hs + build-depends: + base >=4.18.0.0 && <4.20, + nostr, + text, + bytestring, + time + + hs-source-dirs: app + default-language: GHC2021 + +test-suite nostr-test + import: warnings + default-language: GHC2021 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: + Test.Nostr.ClientSpec + Test.Nostr.Nip19Spec + Test.Nostr.EventSpec + Test.Nostr.CryptoSpec + Test.Nostr.RelaySpec + Test.Nostr.Nip11Spec + Test.Nostr.Nip65Spec + Test.Nostr.Nip04Spec + Test.Nostr.Nip57Spec + Test.Nostr.Nip05Spec + Test.Nostr.Nip21Spec + build-depends: + base >=4.18.0.0 && <4.20, + nostr, + hspec, + QuickCheck, + text, + bytestring, + aeson, + containers, + base64-bytestring diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,28 @@ +module Main where + +import Test.Hspec +import qualified Test.Nostr.ClientSpec +import qualified Test.Nostr.Nip19Spec +import qualified Test.Nostr.EventSpec +import qualified Test.Nostr.CryptoSpec +import qualified Test.Nostr.RelaySpec +import qualified Test.Nostr.Nip11Spec +import qualified Test.Nostr.Nip65Spec +import qualified Test.Nostr.Nip04Spec +import qualified Test.Nostr.Nip57Spec +import qualified Test.Nostr.Nip05Spec +import qualified Test.Nostr.Nip21Spec + +main :: IO () +main = hspec $ do + Test.Nostr.ClientSpec.spec + Test.Nostr.Nip19Spec.spec + Test.Nostr.EventSpec.spec + Test.Nostr.CryptoSpec.spec + Test.Nostr.RelaySpec.spec + Test.Nostr.Nip11Spec.spec + Test.Nostr.Nip65Spec.spec + Test.Nostr.Nip04Spec.spec + Test.Nostr.Nip57Spec.spec + Test.Nostr.Nip05Spec.spec + Test.Nostr.Nip21Spec.spec diff --git a/test/Test/Nostr/ClientSpec.hs b/test/Test/Nostr/ClientSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/ClientSpec.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.ClientSpec (spec) where + +import Test.Hspec +import Test.QuickCheck +import Nostr.Client +import Nostr.Event +import Data.Function ((&)) +import Data.Text (Text) +import qualified Data.Text as T + +spec :: Spec +spec = do + describe "EventBuilder" $ do + it "creates a Short Text Note (Kind 1)" $ do + let content = "Hello World" + let builder = shortNote content + ebKind builder `shouldBe` 1 + ebContent builder `shouldBe` content + ebTags builder `shouldBe` [] + + it "adds tags correctly with withTag" $ do + let builder = shortNote "test" & withTag ["t", "haskell"] + ebTags builder `shouldBe` [["t", "haskell"]] + + it "overrides kind with withKind" $ do + let builder = shortNote "test" & withKind 42 + ebKind builder `shouldBe` 42 + + it "adds reply tag with withReply" $ do + let eid = "0000000000000000000000000000000000000000000000000000000000000001" + let builder = shortNote "reply" & withReply eid + ebTags builder `shouldBe` [["e", eid]] + + it "adds mention tag with withMention" $ do + let pubkey = "0000000000000000000000000000000000000000000000000000000000000002" + let pk = case mkPubKey pubkey of Right p -> p; Left _ -> error "Invalid pubkey" + let builder = shortNote "mention" & withMention pk + ebTags builder `shouldBe` [["p", pubkey]] diff --git a/test/Test/Nostr/CryptoSpec.hs b/test/Test/Nostr/CryptoSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/CryptoSpec.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.CryptoSpec (spec) where + +import Test.Hspec +import Nostr.Crypto +import Nostr.Event hiding (validateEvent) +import qualified Data.Text as T + +spec :: Spec +spec = do + describe "Nostr.Crypto" $ do + + describe "Key Generation and Validation" $ do + it "generates a valid key pair where pub key is derived from sec key" $ do + (sec, pub) <- generateKeyPair + let keys = Keys sec pub Nothing + isValid <- validateKeys keys + isValid `shouldBe` True + + describe "Signing and Verification" $ do + it "successfully signs an event and verifies its signature" $ do + (sec, pub) <- generateKeyPair + let unsigned = createUnsignedEvent pub 1672531200 1 [] "hello crypto" + signedResult <- signEvent sec unsigned + case signedResult of + Left err -> expectationFailure $ "Signing failed: " <> T.unpack err + Right signedEvent -> do + isValid <- verifySignature signedEvent + isValid `shouldBe` True + + isValidFull <- validateEvent signedEvent + isValidFull `shouldBe` True + + it "fails verification if content is tampered with" $ do + (sec, pub) <- generateKeyPair + let unsigned = createUnsignedEvent pub 1672531200 1 [] "hello crypto" + signedResult <- signEvent sec unsigned + case signedResult of + Left err -> expectationFailure $ "Signing failed: " <> T.unpack err + Right signedEvent -> do + let tamperedEvent = signedEvent { eventContent = "tampered" } + isValid <- validateEvent tamperedEvent + isValid `shouldBe` False + + it "fails verification if signature is tampered with" $ do + (sec, pub) <- generateKeyPair + let unsigned = createUnsignedEvent pub 1672531200 1 [] "hello crypto" + signedResult <- signEvent sec unsigned + case signedResult of + Left err -> expectationFailure $ "Signing failed: " <> T.unpack err + Right signedEvent -> do + let invalidSigHex = T.replicate 128 "0" + let invalidSig = case mkSignature invalidSigHex of + Right s -> s + Left _ -> error "Invalid mock signature" + let tamperedEvent = signedEvent { eventSig = invalidSig } + isValid <- validateEvent tamperedEvent + isValid `shouldBe` False + + describe "Hex conversion" $ do + it "converts back and forth successfully" $ do + let originalHex = "deadbeef12345678" + case hexToBytes originalHex of + Left err -> expectationFailure $ "Hex conversion failed: " <> T.unpack err + Right bytes -> do + bytesToHex bytes `shouldBe` originalHex diff --git a/test/Test/Nostr/EventSpec.hs b/test/Test/Nostr/EventSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/EventSpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} + +module Test.Nostr.EventSpec (spec) where + +import Test.Hspec +import Nostr.Event +import Data.Aeson (encode, decode) +import qualified Data.Text as T +import qualified Data.ByteString.Lazy as BSL +import qualified Data.Text.Encoding as TE + +spec :: Spec +spec = do + describe "Nostr.Event" $ do + + describe "Smart Constructors (Hex Validation)" $ do + it "validates valid 64-char hex strings for EventId" $ do + let validHex = T.replicate 64 "a" + mkEventId validHex `shouldBe` Right (EventId validHex) + + it "rejects invalid lengths for EventId" $ do + let invalidHex = T.replicate 63 "a" + mkEventId invalidHex `shouldSatisfy` (\case Left _ -> True; _ -> False) + + it "rejects invalid chars for EventId" $ do + let invalidHex = T.replicate 63 "a" <> "g" + mkEventId invalidHex `shouldSatisfy` (\case Left _ -> True; _ -> False) + + it "validates valid 128-char hex strings for Signature" $ do + let validHex = T.replicate 128 "b" + mkSignature validHex `shouldBe` Right (Signature validHex) + + describe "JSON Serialization" $ do + it "serializes EventId to JSON string" $ do + let hex = T.replicate 64 "c" + let eid = EventId hex + encode eid `shouldBe` ("\"" <> BSL.fromStrict (TE.encodeUtf8 hex) <> "\"") + + it "deserializes EventId from JSON string" $ do + let hex = T.replicate 64 "d" + decode ("\"" <> BSL.fromStrict (TE.encodeUtf8 hex) <> "\"") `shouldBe` Just (EventId hex) + + describe "serializeForSigning" $ do + it "returns correct NIP-01 format" $ do + let pk = PubKey (T.replicate 64 "e") + let unsigned = createUnsignedEvent pk 1672531200 1 [] "hello world" + let serialized = serializeForSigning unsigned + let expectedJson = "[0,\"" <> T.replicate 64 "e" <> "\",1672531200,1,[],\"hello world\"]" + encode serialized `shouldBe` BSL.fromStrict (TE.encodeUtf8 expectedJson) + + describe "validateEvent" $ do + it "rejects unsigned placeholders" $ do + let pk = PubKey (T.replicate 64 "e") + let unsigned = createUnsignedEvent pk 1672531200 1 [] "hello world" + validateEvent unsigned `shouldBe` Left "Event has placeholder ID (not computed yet)" diff --git a/test/Test/Nostr/Nip04Spec.hs b/test/Test/Nostr/Nip04Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/Nip04Spec.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} + +module Test.Nostr.Nip04Spec (spec) where + +import Test.Hspec +import Nostr.Nip04 +import Nostr.Crypto +import qualified Data.Text as T + +spec :: Spec +spec = do + describe "Nostr.Nip04" $ do + + it "encrypts and decrypts a message" $ do + (sec1, pub1) <- generateKeyPair + (sec2, pub2) <- generateKeyPair + + let message = "Hello, secret Nostr!" + + -- User 1 encrypts message for User 2 + encryptedOpt <- encryptNip04 sec1 pub2 message + encryptedOpt `shouldSatisfy` (\case Just _ -> True; _ -> False) + + let Just encrypted = encryptedOpt + + -- User 2 decrypts message from User 1 + let decryptedOpt = decryptNip04 sec2 pub1 encrypted + decryptedOpt `shouldBe` Just message + + it "fails to decrypt with wrong key" $ do + (sec1, pub1) <- generateKeyPair + (sec2, pub2) <- generateKeyPair + (sec3, pub3) <- generateKeyPair -- malicious user + + let message = "Secret" + Just encrypted <- encryptNip04 sec1 pub2 message + + let decryptedOpt = decryptNip04 sec3 pub1 encrypted + decryptedOpt `shouldBe` Nothing diff --git a/test/Test/Nostr/Nip05Spec.hs b/test/Test/Nostr/Nip05Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/Nip05Spec.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.Nip05Spec (spec) where + +import Test.Hspec +import Nostr.Nip05 + +spec :: Spec +spec = do + describe "Nostr.Nip05" $ do + it "exists but HTTP fetching is skipped in unit tests to avoid network I/O" $ do + pendingWith "HTTP mocking not yet implemented for Nip05" diff --git a/test/Test/Nostr/Nip11Spec.hs b/test/Test/Nostr/Nip11Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/Nip11Spec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.Nip11Spec (spec) where + +import Test.Hspec +import Nostr.Nip11 +import Data.Aeson (encode, decode) +import qualified Data.Text as T + +spec :: Spec +spec = do + describe "Nostr.Nip11" $ do + + describe "RelayInfo JSON Parsing" $ do + it "parses complete RelayInfo from JSON" $ do + let jsonStr = "{\"name\":\"Damus\",\"description\":\"A nostr relay\",\"pubkey\":\"hexpubkey\",\"contact\":\"admin@damus.io\",\"supported_nips\":[1,2,11,50],\"software\":\"nostr-rs-relay\",\"version\":\"0.8.9\"}" + let expected = RelayInfo + { riName = Just "Damus" + , riDescription = Just "A nostr relay" + , riPubkey = Just "hexpubkey" + , riContact = Just "admin@damus.io" + , riSupportedNips = Just [1, 2, 11, 50] + , riSoftware = Just "nostr-rs-relay" + , riVersion = Just "0.8.9" + } + decode jsonStr `shouldBe` Just expected + + it "parses empty JSON to all Nothing fields" $ do + let jsonStr = "{}" + let expected = RelayInfo Nothing Nothing Nothing Nothing Nothing Nothing Nothing + decode jsonStr `shouldBe` Just expected + + it "serializes RelayInfo to JSON" $ do + let info = RelayInfo + { riName = Just "Damus" + , riDescription = Nothing + , riPubkey = Nothing + , riContact = Nothing + , riSupportedNips = Just [1] + , riSoftware = Nothing + , riVersion = Nothing + } + -- The order of keys is not guaranteed in Aeson by default, + -- so we just check decode . encode == Just info + decode (encode info) `shouldBe` Just info diff --git a/test/Test/Nostr/Nip19Spec.hs b/test/Test/Nostr/Nip19Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/Nip19Spec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.Nip19Spec (spec) where + +import Test.Hspec +import Test.QuickCheck +import Nostr.Nip19 +import Nostr.Event (PubKey(..), EventId(..), mkPubKey, mkEventId) +import Nostr.Crypto (generateKeyPair, exportPubKey, exportSecKey, SecKey) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Maybe (isJust, fromJust) + +spec :: Spec +spec = do + describe "NIP-19 Encoding/Decoding" $ do + it "encodes and decodes PubKey (npub)" $ do + -- Using a fixed key for reproducibility or property test + -- Let's do a simple property check if valid hex + let hex = "3bf0c63fcb9347d40134708a0d773553e299b71858752d508823f399f603d2b3" + let pk = case mkPubKey hex of Right k -> k; Left _ -> error "Invalid pubkey" + + let encoded = toNpub pk + encoded `shouldSatisfy` isJust + + let decoded = decode (fromJust encoded) + decoded `shouldBe` Right (Nip19Pub pk) + + it "encodes and decodes EventId (note)" $ do + let hex = "46f3c7bb33cc3019049b76dc89dbb96e34c247bdda68b6ad8632682793ff8a1a" + let eid = case mkEventId hex of Right e -> e; Left _ -> error "Invalid event id" + + let encoded = toNote eid + encoded `shouldSatisfy` isJust + + let decoded = decode (fromJust encoded) + decoded `shouldBe` Right (Nip19Note eid) diff --git a/test/Test/Nostr/Nip21Spec.hs b/test/Test/Nostr/Nip21Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/Nip21Spec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.Nip21Spec (spec) where + +import Test.Hspec +import Nostr.Nip21 +import Data.Either (isRight, isLeft) + +spec :: Spec +spec = do + describe "Nostr.Nip21" $ do + it "parses nostr: URIs" $ do + let uri = "nostr:npub1sg6plzptd64u62a878hep2kev88swjh3tw00gjsfl8f237lmu63q0uf63m" + parseNostrUri uri `shouldSatisfy` isRight + + it "handles URIs without scheme" $ do + parseNostrUri "npub1sg6plzptd64u62a878hep2kev88swjh3tw00gjsfl8f237lmu63q0uf63m" `shouldSatisfy` isLeft + + it "rejects arbitrary strings" $ do + parseNostrUri "hello world" `shouldSatisfy` isLeft diff --git a/test/Test/Nostr/Nip57Spec.hs b/test/Test/Nostr/Nip57Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/Nip57Spec.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.Nip57Spec (spec) where + +import Test.Hspec +import Nostr.Nip57 +import Nostr.Event +import qualified Data.Text as T + +dummyEvent :: Kind -> [Tag] -> Event +dummyEvent k tags = Event + { eventId = EventId "id" + , eventPubkey = PubKey "pubkey" + , eventCreatedAt = 123456 + , eventKind = k + , eventTags = tags + , eventContent = "" + , eventSig = Signature "sig" + } + +spec :: Spec +spec = do + describe "Nostr.Nip57" $ do + + describe "Zap Request" $ do + it "parses a valid Zap Request" $ do + let tags = [ ["relays", "wss://relay1.com", "wss://relay2.com"] + , ["amount", "1000"] + , ["lnurl", "lnurl1..."] + , ["p", "recipient_pubkey"] + , ["e", "event_id"] + ] + let ev = dummyEvent 9734 tags + let parsed = parseZapRequest ev + parsed `shouldBe` Just (ZapRequest + { zrRelays = ["wss://relay1.com", "wss://relay2.com"] + , zrAmount = Just "1000" + , zrLnurl = Just "lnurl1..." + , zrP = "recipient_pubkey" + , zrE = Just "event_id" + }) + + it "fails on wrong kind" $ do + let ev = dummyEvent 1 [] + parseZapRequest ev `shouldBe` Nothing + + describe "Zap Receipt" $ do + it "parses a valid Zap Receipt" $ do + let tags = [ ["bolt11", "lnbc10n..."] + , ["preimage", "1234567890abcdef"] + , ["description", "{\"kind\":9734}"] + , ["p", "recipient_pubkey"] + , ["e", "event_id"] + ] + let ev = dummyEvent 9735 tags + let parsed = parseZapReceipt ev + parsed `shouldBe` Just (ZapReceipt + { zrpBolt11 = "lnbc10n..." + , zrpPreimage = Just "1234567890abcdef" + , zrpDescription = "{\"kind\":9734}" + , zrpP = "recipient_pubkey" + , zrpE = Just "event_id" + }) diff --git a/test/Test/Nostr/Nip65Spec.hs b/test/Test/Nostr/Nip65Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/Nip65Spec.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.Nip65Spec (spec) where + +import Test.Hspec +import Nostr.Nip65 + +spec :: Spec +spec = do + describe "Nostr.Nip65" $ do + + describe "Tag Parsing and Creation" $ do + it "creates tag for BothMarker" $ do + let entry = RelayListEntry "wss://relay.damus.io" BothMarker + mkRelayListTag entry `shouldBe` ["r", "wss://relay.damus.io"] + + it "creates tag for ReadMarker" $ do + let entry = RelayListEntry "wss://relay.damus.io" ReadMarker + mkRelayListTag entry `shouldBe` ["r", "wss://relay.damus.io", "read"] + + it "creates tag for WriteMarker" $ do + let entry = RelayListEntry "wss://relay.damus.io" WriteMarker + mkRelayListTag entry `shouldBe` ["r", "wss://relay.damus.io", "write"] + + it "parses tag for BothMarker" $ do + let tag = ["r", "wss://relay.damus.io"] + parseRelayListTag tag `shouldBe` Just (RelayListEntry "wss://relay.damus.io" BothMarker) + + it "parses tag for ReadMarker" $ do + let tag = ["r", "wss://relay.damus.io", "read"] + parseRelayListTag tag `shouldBe` Just (RelayListEntry "wss://relay.damus.io" ReadMarker) + + it "parses tag for WriteMarker" $ do + let tag = ["r", "wss://relay.damus.io", "write"] + parseRelayListTag tag `shouldBe` Just (RelayListEntry "wss://relay.damus.io" WriteMarker) + + it "rejects invalid tags" $ do + parseRelayListTag ["p", "pubkey"] `shouldBe` Nothing + parseRelayListTag ["r", "url", "invalid-marker"] `shouldBe` Nothing + parseRelayListTag ["r"] `shouldBe` Nothing diff --git a/test/Test/Nostr/RelaySpec.hs b/test/Test/Nostr/RelaySpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Nostr/RelaySpec.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Nostr.RelaySpec (spec) where + +import Test.Hspec +import Nostr.Relay +import Nostr.Event +import Data.Aeson (encode, decode) +import qualified Data.Text as T + +spec :: Spec +spec = do + describe "Nostr.Relay" $ do + + describe "ClientMessage JSON Serialization" $ do + it "serializes CMClose to JSON" $ do + let subId = SubscriptionId "sub-123" + let msg = CMClose subId + encode msg `shouldBe` "[\"CLOSE\",\"sub-123\"]" + + it "deserializes CMClose from JSON" $ do + let jsonStr = "[\"CLOSE\",\"sub-123\"]" + decode jsonStr `shouldBe` Just (CMClose (SubscriptionId "sub-123")) + + it "serializes CMReq to JSON" $ do + let subId = SubscriptionId "sub-req" + let f = defaultFilter { filterLimit = Just 10 } + let msg = CMReq subId [f] + encode msg `shouldBe` "[\"REQ\",\"sub-req\",{\"limit\":10}]" + + describe "RelayMessage JSON Serialization" $ do + it "serializes RMNotice to JSON" $ do + let msg = RMNotice "Hello" + encode msg `shouldBe` "[\"NOTICE\",\"Hello\"]" + + it "deserializes RMNotice from JSON" $ do + let jsonStr = "[\"NOTICE\",\"Hello\"]" + decode jsonStr `shouldBe` Just (RMNotice "Hello") + + it "serializes RMEOSE to JSON" $ do + let subId = SubscriptionId "sub-1" + let msg = RMEOSE subId + encode msg `shouldBe` "[\"EOSE\",\"sub-1\"]" + + it "deserializes RMEOSE from JSON" $ do + let jsonStr = "[\"EOSE\",\"sub-1\"]" + decode jsonStr `shouldBe` Just (RMEOSE (SubscriptionId "sub-1")) + + describe "Filter JSON Serialization" $ do + it "serializes empty filter" $ do + encode defaultFilter `shouldBe` "{}" + + it "serializes filter with limit" $ do + let f = defaultFilter { filterLimit = Just 42 } + encode f `shouldBe` "{\"limit\":42}" + + it "serializes filter with kinds" $ do + let f = defaultFilter { filterKinds = Just [1, 3] } + encode f `shouldBe` "{\"kinds\":[1,3]}"