Nip11.hs

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