{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
 Module: LnUrl.Channel

 See <https://github.com/fiatjaf/lnurl-rfc/blob/master/lnurl-channel.md>.

 == Workflow

 1. @LN SERVICE@ provides a URL for @LNURL-channel@.
 2. @LN WALLET@ makes a @GET@ request to this URL.
 3. @LN SERVICE@ responds with 'Response' 'SuccessResponse'.
 4. @LN WALLET@ connects to the node at 'remoteNode'.
 5. @LN WALLET@ prepare and make a @GET@ request using 'proceed' (followed
    possibly by 'cancel').
 6. @LN SERVICE@ responds with 'AckResponse'.
 7. @LN WALLET@ awaits an @OpenChannel@ message.
-}
module LnUrl.Channel (
    -- * Client
    proceed,
    cancel,

    -- * Types
    NodeId,
    SuccessResponse (..),
    Response (..),
    AckResponse (..),
) where

import Data.Aeson (
    FromJSON,
    ToJSON,
    object,
    parseJSON,
    toJSON,
    withObject,
    (.:),
    (.=),
 )
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import LnUrl (AckResponse (..), NodeId, Response (..))
import LnUrl.Utils (Base16 (..), JsonURI (..), getBase16)
import Network.URI (URI)
import Network.URI.Utils (addQueryParams)

-- | @LN SERVICE@ responds with 'Response' 'SuccessResponse'
data SuccessResponse = SuccessResponse
    { -- | Remote node URI
      SuccessResponse -> ByteString
remoteNode :: ByteString
    , -- | Service URL
      SuccessResponse -> URI
callback :: URI
    , -- | Wallet identifier
      SuccessResponse -> ByteString
k1 :: ByteString
    }
    deriving (SuccessResponse -> SuccessResponse -> Bool
(SuccessResponse -> SuccessResponse -> Bool)
-> (SuccessResponse -> SuccessResponse -> Bool)
-> Eq SuccessResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuccessResponse -> SuccessResponse -> Bool
$c/= :: SuccessResponse -> SuccessResponse -> Bool
== :: SuccessResponse -> SuccessResponse -> Bool
$c== :: SuccessResponse -> SuccessResponse -> Bool
Eq, Int -> SuccessResponse -> ShowS
[SuccessResponse] -> ShowS
SuccessResponse -> String
(Int -> SuccessResponse -> ShowS)
-> (SuccessResponse -> String)
-> ([SuccessResponse] -> ShowS)
-> Show SuccessResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuccessResponse] -> ShowS
$cshowList :: [SuccessResponse] -> ShowS
show :: SuccessResponse -> String
$cshow :: SuccessResponse -> String
showsPrec :: Int -> SuccessResponse -> ShowS
$cshowsPrec :: Int -> SuccessResponse -> ShowS
Show)

instance FromJSON SuccessResponse where
    parseJSON :: Value -> Parser SuccessResponse
parseJSON = String
-> (Object -> Parser SuccessResponse)
-> Value
-> Parser SuccessResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SuccessResponse" ((Object -> Parser SuccessResponse)
 -> Value -> Parser SuccessResponse)
-> (Object -> Parser SuccessResponse)
-> Value
-> Parser SuccessResponse
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Object
obj Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tag" Parser String
-> (String -> Parser SuccessResponse) -> Parser SuccessResponse
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            String
"channelRequest" ->
                ByteString -> URI -> ByteString -> SuccessResponse
SuccessResponse
                    (ByteString -> URI -> ByteString -> SuccessResponse)
-> Parser ByteString
-> Parser (URI -> ByteString -> SuccessResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uri")
                    Parser (URI -> ByteString -> SuccessResponse)
-> Parser URI -> Parser (ByteString -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (JsonURI -> URI
getJsonURI (JsonURI -> URI) -> Parser JsonURI -> Parser URI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser JsonURI
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"callback")
                    Parser (ByteString -> SuccessResponse)
-> Parser ByteString -> Parser SuccessResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Base16 -> ByteString
getBase16 (Base16 -> ByteString) -> Parser Base16 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Base16
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"k1")
            String
tag -> String -> Parser SuccessResponse
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SuccessResponse)
-> String -> Parser SuccessResponse
forall a b. (a -> b) -> a -> b
$ String
"Unknown tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tag

instance ToJSON SuccessResponse where
    toJSON :: SuccessResponse -> Value
toJSON SuccessResponse
success =
        [Pair] -> Value
object
            [ Text
"uri" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (SuccessResponse -> ByteString) -> SuccessResponse -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> ByteString
remoteNode) SuccessResponse
success
            , Text
"callback" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (URI -> String
forall a. Show a => a -> String
show (URI -> String)
-> (SuccessResponse -> URI) -> SuccessResponse -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> URI
callback) SuccessResponse
success
            , Text
"k1" Text -> Base16 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Base16
Base16 (SuccessResponse -> ByteString
k1 SuccessResponse
success)
            ]

{- | Create the URL for the follow up LNURL-channel request. @LN SERVICE@
 responds with 'AckResponse'.
-}
proceed :: SuccessResponse -> NodeId -> Bool -> URI
proceed :: SuccessResponse -> ByteString -> Bool -> URI
proceed SuccessResponse
payload ByteString
theRemoteNode Bool
isPrivate =
    URI -> Query -> URI
addQueryParams
        (SuccessResponse -> URI
callback SuccessResponse
payload)
        [ (ByteString
"k1", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ SuccessResponse -> ByteString
k1 SuccessResponse
payload)
        , (ByteString
"remoteid", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
theRemoteNode)
        , (ByteString
"private", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Bool -> ByteString
forall a. a -> a -> Bool -> a
bool ByteString
"0" ByteString
"1" Bool
isPrivate)
        ]

{- | Create the URL to cancel a LNURL-channel request. @LN SERVICE@ responds
 with 'AckResponse'.
-}
cancel :: SuccessResponse -> NodeId -> URI
cancel :: SuccessResponse -> ByteString -> URI
cancel SuccessResponse
payload ByteString
theRemoteNode =
    URI -> Query -> URI
addQueryParams
        (SuccessResponse -> URI
callback SuccessResponse
payload)
        [ (ByteString
"k1", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ SuccessResponse -> ByteString
k1 SuccessResponse
payload)
        , (ByteString
"remoteid", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
theRemoteNode)
        , (ByteString
"cancel", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1")
        ]