{-# LANGUAGE OverloadedStrings #-}

{- |
Module: LnUrl.Withdraw

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

== Workflow

1. @LN WALLET@ makes @GET@ request
2. @LN SERVICE@ responds with 'Response' 'SuccessResponse'.
3. @LN WALLET@ get withdrawal amount from user.
4. @LN WALLET@ prepare and make @GET@ request using 'getCallbackURL'.
5. @LN SERVICE@ responds with 'AckResponse'.
-}
module LnUrl.Withdraw (
    -- * Client
    getCallbackURL,

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

import Data.Aeson (
    FromJSON,
    ToJSON,
    object,
    parseJSON,
    toJSON,
    withObject,
    (.:),
    (.:?),
    (.=),
 )
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word64)
import LnUrl (AckResponse (..), Response (..))
import LnUrl.Utils (JsonURI (..), (.=?))
import Network.URI (URI)
import Network.URI.Utils (addQueryParams, param)

-- | The initial GET request responds with 'Response' 'SuccessResponse'
data SuccessResponse = SuccessResponse
    { SuccessResponse -> URI
callback :: URI
    , SuccessResponse -> Text
challenge :: Text
    , SuccessResponse -> Text
defaultDescription :: Text
    , -- | millisatoshis
      SuccessResponse -> Word64
minWithdrawable :: Word64
    , -- | millisatoshis
      SuccessResponse -> Word64
maxWithdrawable :: Word64
    , -- | URL to use to make a subsequent LNURL-withdraw request, response with 'SuccessResponse'
      SuccessResponse -> Maybe URI
balanceCheck :: Maybe URI
    }
    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 ->
        URI
-> Text -> Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse
SuccessResponse
            (URI
 -> Text
 -> Text
 -> Word64
 -> Word64
 -> Maybe URI
 -> SuccessResponse)
-> Parser URI
-> Parser
     (Text -> Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Functor 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
  (Text -> Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
-> Parser Text
-> Parser
     (Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"k1"
            Parser (Text -> Word64 -> Word64 -> Maybe URI -> SuccessResponse)
-> Parser Text
-> Parser (Word64 -> Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"defaultDescription"
            Parser (Word64 -> Word64 -> Maybe URI -> SuccessResponse)
-> Parser Word64 -> Parser (Word64 -> Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"minWithdrawable"
            Parser (Word64 -> Maybe URI -> SuccessResponse)
-> Parser Word64 -> Parser (Maybe URI -> SuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"maxWithdrawable"
            Parser (Maybe URI -> SuccessResponse)
-> Parser (Maybe URI) -> Parser SuccessResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((JsonURI -> URI) -> Maybe JsonURI -> Maybe URI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonURI -> URI
getJsonURI (Maybe JsonURI -> Maybe URI)
-> Parser (Maybe JsonURI) -> Parser (Maybe URI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe JsonURI)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"balanceCheck")

instance ToJSON SuccessResponse where
    toJSON :: SuccessResponse -> Value
toJSON SuccessResponse
response =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ Text
"callback" Text -> JsonURI -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (URI -> JsonURI
JsonURI (URI -> JsonURI)
-> (SuccessResponse -> URI) -> SuccessResponse -> JsonURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> URI
callback) SuccessResponse
response
            , Text
"k1" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Text
challenge SuccessResponse
response
            , Text
"defaultDescription" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Text
defaultDescription SuccessResponse
response
            , Text
"minWithdrawable" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Word64
minWithdrawable SuccessResponse
response
            , Text
"maxWithdrawable" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Word64
maxWithdrawable SuccessResponse
response
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Text
"balanceCheck" Text -> Maybe JsonURI -> Maybe Pair
forall a. ToJSON a => Text -> Maybe a -> Maybe Pair
.=? (URI -> JsonURI
JsonURI (URI -> JsonURI) -> Maybe URI -> Maybe JsonURI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuccessResponse -> Maybe URI
balanceCheck SuccessResponse
response)]

-- | Use the first response to build the callback url
getCallbackURL ::
    SuccessResponse ->
    Text ->
    -- | URL where @LN SERVICE@ can POST 'SuccessResponse' values to notify the wallet
    Maybe URI ->
    URI
getCallbackURL :: SuccessResponse -> Text -> Maybe URI -> URI
getCallbackURL SuccessResponse
response Text
thePaymentRequest Maybe URI
balanceNotifyURI =
    URI -> Query -> URI
addQueryParams (SuccessResponse -> URI
callback SuccessResponse
response) (Query -> URI) -> Query -> URI
forall a b. (a -> b) -> a -> b
$
        [Maybe QueryItem] -> Query
forall a. [Maybe a] -> [a]
catMaybes
            [ QueryItem -> Maybe QueryItem
forall a. a -> Maybe a
Just (QueryItem -> Maybe QueryItem) -> QueryItem -> Maybe QueryItem
forall a b. (a -> b) -> a -> b
$ ByteString
-> (SuccessResponse -> ByteString) -> SuccessResponse -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"k1" (Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (SuccessResponse -> Text) -> SuccessResponse -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> Text
challenge) SuccessResponse
response
            , QueryItem -> Maybe QueryItem
forall a. a -> Maybe a
Just (QueryItem -> Maybe QueryItem) -> QueryItem -> Maybe QueryItem
forall a b. (a -> b) -> a -> b
$ ByteString -> (Text -> ByteString) -> Text -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"pr" Text -> ByteString
encodeUtf8 Text
thePaymentRequest
            , ByteString -> (URI -> ByteString) -> URI -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"balanceNotify" (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (URI -> Text) -> URI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show) (URI -> QueryItem) -> Maybe URI -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
balanceNotifyURI
            ]