nostr (empty) → 1.3.0.0
raw patch · 28 files changed
+2836/−0 lines, 28 filesdep +QuickCheckdep +aesondep +async
Dependencies added: QuickCheck, aeson, async, base, base16-bytestring, base64-bytestring, bech32, bytestring, containers, cryptonite, entropy, hspec, http-conduit, memory, mtl, nonempty-wrapper-text, nostr, ppad-fixed, ppad-secp256k1, stm, text, time, unix-time, vector, websockets, wuss
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- app/Example.hs +128/−0
- app/Main.hs +54/−0
- lib/Nostr/Client.hs +396/−0
- lib/Nostr/Crypto.hs +272/−0
- lib/Nostr/Event.hs +257/−0
- lib/Nostr/Nip04.hs +109/−0
- lib/Nostr/Nip05.hs +80/−0
- lib/Nostr/Nip11.hs +80/−0
- lib/Nostr/Nip19.hs +206/−0
- lib/Nostr/Nip21.hs +31/−0
- lib/Nostr/Nip57.hs +103/−0
- lib/Nostr/Nip65.hs +59/−0
- lib/Nostr/Relay.hs +347/−0
- nostr.cabal +181/−0
- test/Main.hs +28/−0
- test/Test/Nostr/ClientSpec.hs +40/−0
- test/Test/Nostr/CryptoSpec.hs +67/−0
- test/Test/Nostr/EventSpec.hs +56/−0
- test/Test/Nostr/Nip04Spec.hs +40/−0
- test/Test/Nostr/Nip05Spec.hs +12/−0
- test/Test/Nostr/Nip11Spec.hs +45/−0
- test/Test/Nostr/Nip19Spec.hs +37/−0
- test/Test/Nostr/Nip21Spec.hs +20/−0
- test/Test/Nostr/Nip57Spec.hs +63/−0
- test/Test/Nostr/Nip65Spec.hs +40/−0
- test/Test/Nostr/RelaySpec.hs +59/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for nostr++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -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.
+ app/Example.hs view
@@ -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."
+ app/Main.hs view
@@ -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
+ lib/Nostr/Client.hs view
@@ -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", <event_id>]+withReply :: Text -> EventBuilder -> EventBuilder+withReply eid = withTag ["e", eid]++-- | Reply to an event with a recommended relay url+-- ["e", <event_id>, <relay_url>]+withReplyTo :: Text -> Text -> EventBuilder -> EventBuilder+withReplyTo eid relay = withTag ["e", eid, relay]++-- | Mention a user ("p" tag)+-- ["p", <pubkey_hex>]+withMention :: PubKey -> EventBuilder -> EventBuilder+withMention pubkey = withTag ["p", unPubKey pubkey]++-- | Mention a user with a recommended relay url+-- ["p", <pubkey_hex>, <relay_url>]+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", <event_id>, <relay_url>, "reply", <pubkey>]+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", <event_id>, <relay_url>, "root", <pubkey>]+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", <kind>:<pubkey_hex>:<d-tag>]+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", <kind>:<pubkey_hex>:<d-tag>, <relay_url>]+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
+ lib/Nostr/Crypto.hs view
@@ -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
+ lib/Nostr/Event.hs view
@@ -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, <pubkey>, <created_at>, <kind>, <tags>, <content>]+-- 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)+ ]
+ lib/Nostr/Nip04.hs view
@@ -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
+ lib/Nostr/Nip05.hs view
@@ -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 <name>@<domain> usually+ _ -> (t, "") -- Invalid fallback
+ lib/Nostr/Nip11.hs view
@@ -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
+ lib/Nostr/Nip19.hs view
@@ -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)
+ lib/Nostr/Nip21.hs view
@@ -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)
+ lib/Nostr/Nip57.hs view
@@ -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+ }
+ lib/Nostr/Nip65.hs view
@@ -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
+ lib/Nostr/Relay.hs view
@@ -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", <event>]+ | CMReq SubscriptionId [Filter] -- ^ ["REQ", <subscription_id>, <filter1>, <filter2>, ...]+ | CMClose SubscriptionId -- ^ ["CLOSE", <subscription_id>]+ | CMAuth Event -- ^ ["AUTH", <signed-event>] (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", <subscription_id>, <event>]+ | RMOK EventId Bool Text -- ^ ["OK", <event_id>, <accepted>, <message>]+ | RMEOSE SubscriptionId -- ^ ["EOSE", <subscription_id>]+ | RMClosed SubscriptionId Text -- ^ ["CLOSED", <subscription_id>, <message>]+ | RMNotice Text -- ^ ["NOTICE", <message>]+ | RMAuth Text -- ^ ["AUTH", <challenge-string>] (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
+ nostr.cabal view
@@ -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
+ test/Main.hs view
@@ -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
+ test/Test/Nostr/ClientSpec.hs view
@@ -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]]
+ test/Test/Nostr/CryptoSpec.hs view
@@ -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
+ test/Test/Nostr/EventSpec.hs view
@@ -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)"
+ test/Test/Nostr/Nip04Spec.hs view
@@ -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
+ test/Test/Nostr/Nip05Spec.hs view
@@ -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"
+ test/Test/Nostr/Nip11Spec.hs view
@@ -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
+ test/Test/Nostr/Nip19Spec.hs view
@@ -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)
+ test/Test/Nostr/Nip21Spec.hs view
@@ -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
+ test/Test/Nostr/Nip57Spec.hs view
@@ -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"+ })
+ test/Test/Nostr/Nip65Spec.hs view
@@ -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
+ test/Test/Nostr/RelaySpec.hs view
@@ -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]}"