{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

{- |
Module: LnUrl.Pay

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

== Workflow

1. @LN WALLET@ decodes URL using 'getPayURL' and makes a @GET@ request.
2. @LN SERVICE@ responds with 'Response' 'SuccessResponse'.
3. @LN WALLET@ get parameters from the user.
4. @LN WALLET@ prepare a callback URL using 'getCallbackUrl'.
5. @LN SERVICE@ responds with 'Response' 'CallbackSuccessResponse'.
6. @LN WALLET@ verifies: (a) @h@ tag in 'paymentRequest' is @SHA256(metadata)@,
   (b) the amount in 'paymentRequest' matches the requested amount, and (c)
   signatures on @ChannelUpdate@ messages.
7. @LN WALLET@ pays invoice.
8. @LN WALLET@ after paying the invoice, execute the 'successAction' if defined.
-}
module LnUrl.Pay (
    -- * Client
    getPayURL,
    getCallbackUrl,
    decrypt,

    -- * Server
    encrypt,

    -- * Types
    Response (..),
    SuccessResponse (..),
    Metadata (..),
    CallbackSuccessResponse (..),
    Hop (..),
    SuccessAction (..),
    UrlAction (..),
    AesAction (..),
    AesError (..),
) where

import Control.Exception (Exception)
import Control.Monad (unless)
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (cbcDecrypt, cbcEncrypt, makeIV)
import qualified Crypto.Cipher.Types as Crypto
import Crypto.Data.Padding (Format (PKCS7), pad, unpad)
import Crypto.Error (eitherCryptoError)
import Crypto.Random (getRandomBytes)
import Data.Aeson (
    FromJSON,
    ToJSON,
    Value (String),
    object,
    parseJSON,
    toJSON,
    withArray,
    withObject,
    (.:),
    (.:?),
    (.=),
 )
import qualified Data.Aeson as Ae
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Base16 (encodeBase16')
import Data.ByteString.Base64 (decodeBase64, encodeBase64)
import qualified Data.ByteString.Char8 as BS8
import Data.Foldable (toList)
import Data.Functor ((<&>))
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.Lazy.Encoding as TL
import Data.Word (Word64)
import Haskoin (PubKey, exportPubKey)
import LnUrl (NodeId, Response (..))
import LnUrl.Utils (Base64 (..), JsonURI (..), (.=?))
import Network.URI (URI (..), parseURI, uriRegName, uriUserInfo)
import Network.URI.Utils (addQueryParams, param)

-- | Apply the LNURL-pay uri transform logic.  @LN SERVICE@ should respond to the resulting URL with 'Response'.
getPayURL :: URI -> URI
getPayURL :: URI -> URI
getPayURL URI
theURI
    | Just String
userInfo <- URIAuth -> String
uriUserInfo (URIAuth -> String) -> Maybe URIAuth -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe URIAuth
uriAuthority URI
theURI =
        URI
theURI
            { uriScheme :: String
uriScheme = if Bool
isOnion then String
"http:" else String
"https:"
            , uriAuthority :: Maybe URIAuth
uriAuthority = URIAuth -> URIAuth
stompUserInfo (URIAuth -> URIAuth) -> Maybe URIAuth -> Maybe URIAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe URIAuth
uriAuthority URI
theURI
            , uriPath :: String
uriPath = String
"/.well-known/lnurlp/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
specialChars) String
userInfo
            , uriFragment :: String
uriFragment = String
forall a. Monoid a => a
mempty
            }
    | Bool
otherwise = URI
theURI
  where
    isOnion :: Bool
isOnion = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
domain Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6) String
domain String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".onion"
    Just String
domain = URIAuth -> String
uriRegName (URIAuth -> String) -> Maybe URIAuth -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> Maybe URIAuth
uriAuthority URI
theURI
    stompUserInfo :: URIAuth -> URIAuth
stompUserInfo URIAuth
uriAuth = URIAuth
uriAuth{uriUserInfo :: String
uriUserInfo = String
forall a. Monoid a => a
mempty}
    specialChars :: String
specialChars = [Char
':', Char
'@']

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
"LNURL-pay Response" ((Object -> Parser SuccessResponse)
 -> Value -> Parser SuccessResponse)
-> (Object -> Parser SuccessResponse)
-> Value
-> Parser SuccessResponse
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Text
tag <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tag"
        Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"payRequest" :: Text)) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Must have payRequest tag"
        URI
-> Word64 -> Word64 -> [Metadata] -> Maybe Int -> SuccessResponse
SuccessResponse
            (URI
 -> Word64 -> Word64 -> [Metadata] -> Maybe Int -> SuccessResponse)
-> Parser URI
-> Parser
     (Word64 -> Word64 -> [Metadata] -> Maybe Int -> 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
  (Word64 -> Word64 -> [Metadata] -> Maybe Int -> SuccessResponse)
-> Parser Word64
-> Parser (Word64 -> [Metadata] -> Maybe Int -> 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
"maxSendable"
            Parser (Word64 -> [Metadata] -> Maybe Int -> SuccessResponse)
-> Parser Word64
-> Parser ([Metadata] -> Maybe Int -> 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
"minSendable"
            Parser ([Metadata] -> Maybe Int -> SuccessResponse)
-> Parser [Metadata] -> Parser (Maybe Int -> 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
"metadata" Parser Text -> (Text -> Parser [Metadata]) -> Parser [Metadata]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Parser [Metadata])
-> ([Metadata] -> Parser [Metadata])
-> Either String [Metadata]
-> Parser [Metadata]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser [Metadata]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail [Metadata] -> Parser [Metadata]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [Metadata] -> Parser [Metadata])
-> (Text -> Either String [Metadata]) -> Text -> Parser [Metadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String [Metadata]
forall a. FromJSON a => ByteString -> Either String a
Ae.eitherDecode (ByteString -> Either String [Metadata])
-> (Text -> ByteString) -> Text -> Either String [Metadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8)
            Parser (Maybe Int -> SuccessResponse)
-> Parser (Maybe Int) -> Parser SuccessResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"commentAllowed"

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
"maxSendable" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Word64
maxSendable SuccessResponse
response
            , Text
"minSendable" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SuccessResponse -> Word64
minSendable SuccessResponse
response
            , Text
"metadata" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text
TL.decodeUtf8 (ByteString -> Text)
-> (SuccessResponse -> ByteString) -> SuccessResponse -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Metadata] -> ByteString
forall a. ToJSON a => a -> ByteString
Ae.encode ([Metadata] -> ByteString)
-> (SuccessResponse -> [Metadata]) -> SuccessResponse -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuccessResponse -> [Metadata]
metadata) SuccessResponse
response
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Text
"commentAllowed" Text -> Maybe Int -> Maybe Pair
forall a. ToJSON a => Text -> Maybe a -> Maybe Pair
.=? SuccessResponse -> Maybe Int
commentAllowed SuccessResponse
response]

data SuccessResponse = SuccessResponse
    { SuccessResponse -> URI
callback :: URI
    , -- | millisatoshi
      SuccessResponse -> Word64
maxSendable :: Word64
    , -- | millisatoshi
      SuccessResponse -> Word64
minSendable :: Word64
    , SuccessResponse -> [Metadata]
metadata :: [Metadata]
    , SuccessResponse -> Maybe Int
commentAllowed :: Maybe Int
    }
    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 -> String -> String
[SuccessResponse] -> String -> String
SuccessResponse -> String
(Int -> SuccessResponse -> String -> String)
-> (SuccessResponse -> String)
-> ([SuccessResponse] -> String -> String)
-> Show SuccessResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SuccessResponse] -> String -> String
$cshowList :: [SuccessResponse] -> String -> String
show :: SuccessResponse -> String
$cshow :: SuccessResponse -> String
showsPrec :: Int -> SuccessResponse -> String -> String
$cshowsPrec :: Int -> SuccessResponse -> String -> String
Show)

{- | The metadata array

 * Must contain a 'PlainText' value
 * May contain at most one of 'ImagePNG' or 'ImageJPEG'
 * May contain at most one of 'Email' or 'Ident'
-}
data Metadata
    = PlainText Text
    | ImagePNG ByteString
    | ImageJPEG ByteString
    | Email Text
    | Ident Text
    deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq, Int -> Metadata -> String -> String
[Metadata] -> String -> String
Metadata -> String
(Int -> Metadata -> String -> String)
-> (Metadata -> String)
-> ([Metadata] -> String -> String)
-> Show Metadata
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Metadata] -> String -> String
$cshowList :: [Metadata] -> String -> String
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> String -> String
$cshowsPrec :: Int -> Metadata -> String -> String
Show)

instance FromJSON Metadata where
    parseJSON :: Value -> Parser Metadata
parseJSON = String -> (Array -> Parser Metadata) -> Value -> Parser Metadata
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Metadata" ((Array -> Parser Metadata) -> Value -> Parser Metadata)
-> (Array -> Parser Metadata) -> Value -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ [Value] -> Parser Metadata
parseTuple ([Value] -> Parser Metadata)
-> (Array -> [Value]) -> Array -> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
      where
        parseTuple :: [Value] -> Parser Metadata
parseTuple = \case
            [String Text
mimeType, String Text
val] -> case Text
mimeType of
                Text
"text/plain" -> Metadata -> Parser Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> Parser Metadata) -> Metadata -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ Text -> Metadata
PlainText Text
val
                Text
"text/email" -> Metadata -> Parser Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> Parser Metadata) -> Metadata -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ Text -> Metadata
Email Text
val
                Text
"text/identifier" -> Metadata -> Parser Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> Parser Metadata) -> Metadata -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ Text -> Metadata
Ident Text
val
                Text
"image/png;base64" ->
                    (Text -> Parser Metadata)
-> (ByteString -> Parser Metadata)
-> Either Text ByteString
-> Parser Metadata
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Metadata
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Metadata)
-> (Text -> String) -> Text -> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (Metadata -> Parser Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> Parser Metadata)
-> (ByteString -> Metadata) -> ByteString -> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Metadata
ImagePNG)
                        (Either Text ByteString -> Parser Metadata)
-> (ByteString -> Either Text ByteString)
-> ByteString
-> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeBase64
                        (ByteString -> Parser Metadata) -> ByteString -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
val
                Text
"image/jpeg;base64" ->
                    (Text -> Parser Metadata)
-> (ByteString -> Parser Metadata)
-> Either Text ByteString
-> Parser Metadata
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Metadata
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Metadata)
-> (Text -> String) -> Text -> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (Metadata -> Parser Metadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> Parser Metadata)
-> (ByteString -> Metadata) -> ByteString -> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Metadata
ImageJPEG)
                        (Either Text ByteString -> Parser Metadata)
-> (ByteString -> Either Text ByteString)
-> ByteString
-> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeBase64
                        (ByteString -> Parser Metadata) -> ByteString -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
val
                Text
other -> String -> Parser Metadata
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Metadata) -> String -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ String
"Unknown mimetype: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
other
            [Value]
_ -> String -> Parser Metadata
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected tuple"

instance ToJSON Metadata where
    toJSON :: Metadata -> Value
toJSON =
        \case
            PlainText Text
x -> Text -> Text -> Value
tuple Text
"text/plain" Text
x
            ImagePNG ByteString
x -> Text -> Text -> Value
tuple Text
"image/png;base64" (ByteString -> Text
encodeBase64 ByteString
x)
            ImageJPEG ByteString
x -> Text -> Text -> Value
tuple Text
"image/jpeg;base64" (ByteString -> Text
encodeBase64 ByteString
x)
            Email Text
x -> Text -> Text -> Value
tuple Text
"text/email" Text
x
            Ident Text
x -> Text -> Text -> Value
tuple Text
"text/identifier" Text
x
      where
        tuple :: Text -> Text -> Value
        tuple :: Text -> Text -> Value
tuple = ((Text, Text) -> Value) -> Text -> Text -> Value
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Text, Text) -> Value
forall a. ToJSON a => a -> Value
toJSON

-- | Prepare a callback url to use to retrieve the payment request
getCallbackUrl ::
    SuccessResponse ->
    -- | amount (millisatoshis)
    Word64 ->
    -- | cache prevention
    Maybe ByteString ->
    -- | starting points (node ids)
    [NodeId] ->
    -- | comment
    Maybe Text ->
    -- | proof of payer
    Maybe PubKey ->
    Maybe URI
getCallbackUrl :: SuccessResponse
-> Word64
-> Maybe ByteString
-> [ByteString]
-> Maybe Text
-> Maybe PubKey
-> Maybe URI
getCallbackUrl SuccessResponse
response Word64
amount Maybe ByteString
maybeNonce [ByteString]
fromNodes Maybe Text
maybeComment Maybe PubKey
maybeProofOfPayer
    | Bool
commentLengthOk = URI -> Maybe URI
forall a. a -> Maybe a
Just (URI -> Maybe URI) -> URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ URI -> Query -> URI
addQueryParams (SuccessResponse -> URI
callback SuccessResponse
response) Query
params
    | Bool
otherwise = Maybe URI
forall a. Maybe a
Nothing
  where
    commentLengthOk :: Bool
commentLengthOk = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Bool
checkComment (Int -> Text -> Bool) -> Maybe Int -> Maybe (Text -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuccessResponse -> Maybe Int
commentAllowed SuccessResponse
response Maybe (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
maybeComment
    checkComment :: Int -> Text -> Bool
checkComment Int
commentSizeBound = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
commentSizeBound) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length

    params :: Query
params =
        [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 -> (Word64 -> ByteString) -> Word64 -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"amount" (String -> ByteString
BS8.pack (String -> ByteString)
-> (Word64 -> String) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show) Word64
amount
            , ByteString -> (ByteString -> ByteString) -> ByteString -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"nonce" ByteString -> ByteString
encodeBase16' (ByteString -> QueryItem) -> Maybe ByteString -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
maybeNonce
            , if [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
fromNodes
                then Maybe QueryItem
forall a. Monoid a => a
mempty
                else QueryItem -> Maybe QueryItem
forall a. a -> Maybe a
Just (QueryItem -> Maybe QueryItem) -> QueryItem -> Maybe QueryItem
forall a b. (a -> b) -> a -> b
$ ByteString
-> ([ByteString] -> ByteString) -> [ByteString] -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"fromnodes" [ByteString] -> ByteString
toNodeList [ByteString]
fromNodes
            , ByteString -> (Text -> ByteString) -> Text -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"comment" Text -> ByteString
encodeUtf8 (Text -> QueryItem) -> Maybe Text -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
maybeComment
            , ByteString -> (PubKey -> ByteString) -> PubKey -> QueryItem
forall a. ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
"proofofpayer" (Bool -> PubKey -> ByteString
exportPubKey Bool
True) (PubKey -> QueryItem) -> Maybe PubKey -> Maybe QueryItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PubKey
maybeProofOfPayer
            ]
    toNodeList :: [ByteString] -> ByteString
toNodeList = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
","

data CallbackSuccessResponse = CallbackSuccessResponse
    { CallbackSuccessResponse -> Text
paymentRequest :: Text
    , CallbackSuccessResponse -> Maybe SuccessAction
successAction :: Maybe SuccessAction
    , CallbackSuccessResponse -> Bool
disposable :: Bool
    , CallbackSuccessResponse -> [[Hop]]
routes :: [[Hop]]
    }
    deriving (CallbackSuccessResponse -> CallbackSuccessResponse -> Bool
(CallbackSuccessResponse -> CallbackSuccessResponse -> Bool)
-> (CallbackSuccessResponse -> CallbackSuccessResponse -> Bool)
-> Eq CallbackSuccessResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallbackSuccessResponse -> CallbackSuccessResponse -> Bool
$c/= :: CallbackSuccessResponse -> CallbackSuccessResponse -> Bool
== :: CallbackSuccessResponse -> CallbackSuccessResponse -> Bool
$c== :: CallbackSuccessResponse -> CallbackSuccessResponse -> Bool
Eq, Int -> CallbackSuccessResponse -> String -> String
[CallbackSuccessResponse] -> String -> String
CallbackSuccessResponse -> String
(Int -> CallbackSuccessResponse -> String -> String)
-> (CallbackSuccessResponse -> String)
-> ([CallbackSuccessResponse] -> String -> String)
-> Show CallbackSuccessResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CallbackSuccessResponse] -> String -> String
$cshowList :: [CallbackSuccessResponse] -> String -> String
show :: CallbackSuccessResponse -> String
$cshow :: CallbackSuccessResponse -> String
showsPrec :: Int -> CallbackSuccessResponse -> String -> String
$cshowsPrec :: Int -> CallbackSuccessResponse -> String -> String
Show)

instance FromJSON CallbackSuccessResponse where
    parseJSON :: Value -> Parser CallbackSuccessResponse
parseJSON = String
-> (Object -> Parser CallbackSuccessResponse)
-> Value
-> Parser CallbackSuccessResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CallbackSuccessResponse" ((Object -> Parser CallbackSuccessResponse)
 -> Value -> Parser CallbackSuccessResponse)
-> (Object -> Parser CallbackSuccessResponse)
-> Value
-> Parser CallbackSuccessResponse
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Text
-> Maybe SuccessAction
-> Bool
-> [[Hop]]
-> CallbackSuccessResponse
CallbackSuccessResponse
            (Text
 -> Maybe SuccessAction
 -> Bool
 -> [[Hop]]
 -> CallbackSuccessResponse)
-> Parser Text
-> Parser
     (Maybe SuccessAction -> Bool -> [[Hop]] -> CallbackSuccessResponse)
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
"pr"
            Parser
  (Maybe SuccessAction -> Bool -> [[Hop]] -> CallbackSuccessResponse)
-> Parser (Maybe SuccessAction)
-> Parser (Bool -> [[Hop]] -> CallbackSuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser (Maybe SuccessAction)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"successAction"
            Parser (Bool -> [[Hop]] -> CallbackSuccessResponse)
-> Parser Bool -> Parser ([[Hop]] -> CallbackSuccessResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"disposable")
            Parser ([[Hop]] -> CallbackSuccessResponse)
-> Parser [[Hop]] -> Parser CallbackSuccessResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser [[Hop]]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"routes"

instance ToJSON CallbackSuccessResponse where
    toJSON :: CallbackSuccessResponse -> Value
toJSON CallbackSuccessResponse
successResponse =
        [Pair] -> Value
object
            [ Text
"pr" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CallbackSuccessResponse -> Text
paymentRequest CallbackSuccessResponse
successResponse
            , Text
"successAction" Text -> Maybe SuccessAction -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CallbackSuccessResponse -> Maybe SuccessAction
successAction CallbackSuccessResponse
successResponse
            , Text
"disposable" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CallbackSuccessResponse -> Bool
disposable CallbackSuccessResponse
successResponse
            , Text
"routes" Text -> [[Hop]] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CallbackSuccessResponse -> [[Hop]]
routes CallbackSuccessResponse
successResponse
            ]

data SuccessAction
    = Url UrlAction
    | Message Text
    | Aes AesAction
    deriving (SuccessAction -> SuccessAction -> Bool
(SuccessAction -> SuccessAction -> Bool)
-> (SuccessAction -> SuccessAction -> Bool) -> Eq SuccessAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuccessAction -> SuccessAction -> Bool
$c/= :: SuccessAction -> SuccessAction -> Bool
== :: SuccessAction -> SuccessAction -> Bool
$c== :: SuccessAction -> SuccessAction -> Bool
Eq, Int -> SuccessAction -> String -> String
[SuccessAction] -> String -> String
SuccessAction -> String
(Int -> SuccessAction -> String -> String)
-> (SuccessAction -> String)
-> ([SuccessAction] -> String -> String)
-> Show SuccessAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SuccessAction] -> String -> String
$cshowList :: [SuccessAction] -> String -> String
show :: SuccessAction -> String
$cshow :: SuccessAction -> String
showsPrec :: Int -> SuccessAction -> String -> String
$cshowsPrec :: Int -> SuccessAction -> String -> String
Show)

instance FromJSON SuccessAction where
    parseJSON :: Value -> Parser SuccessAction
parseJSON = String
-> (Object -> Parser SuccessAction)
-> Value
-> Parser SuccessAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SuccessAction" ((Object -> Parser SuccessAction) -> Value -> Parser SuccessAction)
-> (Object -> Parser SuccessAction)
-> Value
-> Parser SuccessAction
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tag" Parser Text
-> (Text -> Parser SuccessAction) -> Parser SuccessAction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Text
"url" ->
                (UrlAction -> SuccessAction)
-> Parser UrlAction -> Parser SuccessAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UrlAction -> SuccessAction
Url (Parser UrlAction -> Parser SuccessAction)
-> Parser UrlAction -> Parser SuccessAction
forall a b. (a -> b) -> a -> b
$
                    Text -> URI -> UrlAction
UrlAction
                        (Text -> URI -> UrlAction)
-> Parser Text -> Parser (URI -> UrlAction)
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
"description"
                        Parser (URI -> UrlAction) -> Parser URI -> Parser UrlAction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url" Parser String -> (String -> Parser URI) -> Parser URI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser URI -> (URI -> Parser URI) -> Maybe URI -> Parser URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser URI
forall a. Parser a
badUrl URI -> Parser URI
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe URI -> Parser URI)
-> (String -> Maybe URI) -> String -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseURI)
            Text
"message" -> Text -> SuccessAction
Message (Text -> SuccessAction) -> Parser Text -> Parser SuccessAction
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
"message"
            Text
"aes" ->
                (AesAction -> SuccessAction)
-> Parser AesAction -> Parser SuccessAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AesAction -> SuccessAction
Aes (Parser AesAction -> Parser SuccessAction)
-> Parser AesAction -> Parser SuccessAction
forall a b. (a -> b) -> a -> b
$
                    Text -> ByteString -> ByteString -> AesAction
AesAction
                        (Text -> ByteString -> ByteString -> AesAction)
-> Parser Text -> Parser (ByteString -> ByteString -> AesAction)
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
"description"
                        Parser (ByteString -> ByteString -> AesAction)
-> Parser ByteString -> Parser (ByteString -> AesAction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Base64 -> ByteString
getBase64 (Base64 -> ByteString) -> Parser Base64 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Base64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ciphertext")
                        Parser (ByteString -> AesAction)
-> Parser ByteString -> Parser AesAction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Base64 -> ByteString
getBase64 (Base64 -> ByteString) -> Parser Base64 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Base64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"iv")
            Text
other -> String -> Parser SuccessAction
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SuccessAction) -> String -> Parser SuccessAction
forall a b. (a -> b) -> a -> b
$ String
"Unknown tag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
other
      where
        badUrl :: Parser a
badUrl = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse url"

instance ToJSON SuccessAction where
    toJSON :: SuccessAction -> Value
toJSON = \case
        Url UrlAction
urlAction ->
            [Pair] -> Value
object
                [ Text
"tag" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"url" :: Text)
                , Text
"description" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UrlAction -> Text
urlDescription UrlAction
urlAction
                , Text
"url" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= URI -> String
forall a. Show a => a -> String
show (UrlAction -> URI
url UrlAction
urlAction)
                ]
        Message Text
msg ->
            [Pair] -> Value
object
                [ Text
"tag" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"message" :: Text)
                , Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
msg
                ]
        Aes AesAction
aes ->
            [Pair] -> Value
object
                [ Text
"tag" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"aes" :: Text)
                , Text
"description" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AesAction -> Text
aesDescription AesAction
aes
                , Text
"ciphertext" Text -> Base64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Base64
Base64 (ByteString -> Base64)
-> (AesAction -> ByteString) -> AesAction -> Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesAction -> ByteString
ciphertext) AesAction
aes
                , Text
"iv" Text -> Base64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Base64
Base64 (ByteString -> Base64)
-> (AesAction -> ByteString) -> AesAction -> Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AesAction -> ByteString
iv) AesAction
aes
                ]

data UrlAction = UrlAction
    { UrlAction -> Text
urlDescription :: Text
    , UrlAction -> URI
url :: URI
    }
    deriving (UrlAction -> UrlAction -> Bool
(UrlAction -> UrlAction -> Bool)
-> (UrlAction -> UrlAction -> Bool) -> Eq UrlAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UrlAction -> UrlAction -> Bool
$c/= :: UrlAction -> UrlAction -> Bool
== :: UrlAction -> UrlAction -> Bool
$c== :: UrlAction -> UrlAction -> Bool
Eq, Int -> UrlAction -> String -> String
[UrlAction] -> String -> String
UrlAction -> String
(Int -> UrlAction -> String -> String)
-> (UrlAction -> String)
-> ([UrlAction] -> String -> String)
-> Show UrlAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UrlAction] -> String -> String
$cshowList :: [UrlAction] -> String -> String
show :: UrlAction -> String
$cshow :: UrlAction -> String
showsPrec :: Int -> UrlAction -> String -> String
$cshowsPrec :: Int -> UrlAction -> String -> String
Show)

data AesAction = AesAction
    { AesAction -> Text
aesDescription :: Text
    , AesAction -> ByteString
ciphertext :: ByteString
    , AesAction -> ByteString
iv :: ByteString
    }
    deriving (AesAction -> AesAction -> Bool
(AesAction -> AesAction -> Bool)
-> (AesAction -> AesAction -> Bool) -> Eq AesAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AesAction -> AesAction -> Bool
$c/= :: AesAction -> AesAction -> Bool
== :: AesAction -> AesAction -> Bool
$c== :: AesAction -> AesAction -> Bool
Eq, Int -> AesAction -> String -> String
[AesAction] -> String -> String
AesAction -> String
(Int -> AesAction -> String -> String)
-> (AesAction -> String)
-> ([AesAction] -> String -> String)
-> Show AesAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AesAction] -> String -> String
$cshowList :: [AesAction] -> String -> String
show :: AesAction -> String
$cshow :: AesAction -> String
showsPrec :: Int -> AesAction -> String -> String
$cshowsPrec :: Int -> AesAction -> String -> String
Show)

data Hop = Hop
    { Hop -> Text
nodeId :: Text
    , Hop -> ByteString
channelUpdate :: ByteString
    }
    deriving (Hop -> Hop -> Bool
(Hop -> Hop -> Bool) -> (Hop -> Hop -> Bool) -> Eq Hop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hop -> Hop -> Bool
$c/= :: Hop -> Hop -> Bool
== :: Hop -> Hop -> Bool
$c== :: Hop -> Hop -> Bool
Eq, Int -> Hop -> String -> String
[Hop] -> String -> String
Hop -> String
(Int -> Hop -> String -> String)
-> (Hop -> String) -> ([Hop] -> String -> String) -> Show Hop
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Hop] -> String -> String
$cshowList :: [Hop] -> String -> String
show :: Hop -> String
$cshow :: Hop -> String
showsPrec :: Int -> Hop -> String -> String
$cshowsPrec :: Int -> Hop -> String -> String
Show)

instance FromJSON Hop where
    parseJSON :: Value -> Parser Hop
parseJSON = String -> (Object -> Parser Hop) -> Value -> Parser Hop
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Hop" ((Object -> Parser Hop) -> Value -> Parser Hop)
-> (Object -> Parser Hop) -> Value -> Parser Hop
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Text -> ByteString -> Hop
Hop
            (Text -> ByteString -> Hop)
-> Parser Text -> Parser (ByteString -> Hop)
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
"nodeId"
            Parser (ByteString -> Hop) -> Parser ByteString -> Parser Hop
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Base64 -> ByteString
getBase64 (Base64 -> ByteString) -> Parser Base64 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Base64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"channelUpdate")

instance ToJSON Hop where
    toJSON :: Hop -> Value
toJSON Hop
theRoute =
        [Pair] -> Value
object
            [ Text
"nodeId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hop -> Text
nodeId Hop
theRoute
            , Text
"channelUpdate" Text -> Base64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Base64
Base64 (ByteString -> Base64) -> (Hop -> ByteString) -> Hop -> Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hop -> ByteString
channelUpdate) Hop
theRoute
            ]

-- | Use the payment preimage to build an encrypted payload
encrypt ::
    -- | Payment preimage
    ByteString ->
    -- | Description
    Text ->
    -- | Message to encrypt
    ByteString ->
    IO (Either AesError AesAction)
encrypt :: ByteString -> Text -> ByteString -> IO (Either AesError AesAction)
encrypt ByteString
key Text
aesDescription ByteString
plaintext = do
    ByteString
iv <- Int -> IO ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16
    let Just IV AES256
cryptoniteIV = ByteString -> Maybe (IV AES256)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
iv
    Either AesError AesAction -> IO (Either AesError AesAction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AesError AesAction -> IO (Either AesError AesAction))
-> Either AesError AesAction -> IO (Either AesError AesAction)
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either AesError AES256
cipherInit ByteString
key Either AesError AES256
-> (AES256 -> AesAction) -> Either AesError AesAction
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \AES256
cipher ->
            AesAction :: Text -> ByteString -> ByteString -> AesAction
AesAction
                { Text
aesDescription :: Text
aesDescription :: Text
aesDescription
                , ByteString
iv :: ByteString
iv :: ByteString
iv
                , ciphertext :: ByteString
ciphertext = AES256 -> IV AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt AES256
cipher IV AES256
cryptoniteIV (Format -> ByteString -> ByteString
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
pad Format
paddingConfig ByteString
plaintext)
                }

-- | Use the payment preimage to get the encrypted payload
decrypt ::
    -- | Payment preimage
    ByteString ->
    AesAction ->
    Either AesError ByteString
decrypt :: ByteString -> AesAction -> Either AesError ByteString
decrypt ByteString
key AesAction
aes = do
    AES256
cipher <- ByteString -> Either AesError AES256
cipherInit ByteString
key
    IV AES256
theIV <- Either AesError (IV AES256)
-> (IV AES256 -> Either AesError (IV AES256))
-> Maybe (IV AES256)
-> Either AesError (IV AES256)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AesError -> Either AesError (IV AES256)
forall a b. a -> Either a b
Left AesError
IvError) IV AES256 -> Either AesError (IV AES256)
forall a b. b -> Either a b
Right (Maybe (IV AES256) -> Either AesError (IV AES256))
-> Maybe (IV AES256) -> Either AesError (IV AES256)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (IV AES256)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV (AesAction -> ByteString
iv AesAction
aes)
    Either AesError ByteString
-> (ByteString -> Either AesError ByteString)
-> Maybe ByteString
-> Either AesError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AesError -> Either AesError ByteString
forall a b. a -> Either a b
Left AesError
PaddingError) ByteString -> Either AesError ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Maybe ByteString -> Either AesError ByteString)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Either AesError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> ByteString -> Maybe ByteString
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> Maybe byteArray
unpad Format
paddingConfig
        (ByteString -> Either AesError ByteString)
-> ByteString -> Either AesError ByteString
forall a b. (a -> b) -> a -> b
$ AES256 -> IV AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt AES256
cipher IV AES256
theIV (AesAction -> ByteString
ciphertext AesAction
aes)

cipherInit :: ByteString -> Either AesError AES256
cipherInit :: ByteString -> Either AesError AES256
cipherInit = (CryptoError -> AesError)
-> Either CryptoError AES256 -> Either AesError AES256
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AesError -> CryptoError -> AesError
forall a b. a -> b -> a
const AesError
KeyError) (Either CryptoError AES256 -> Either AesError AES256)
-> (ByteString -> Either CryptoError AES256)
-> ByteString
-> Either AesError AES256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable AES256 -> Either CryptoError AES256
forall a. CryptoFailable a -> Either CryptoError a
eitherCryptoError (CryptoFailable AES256 -> Either CryptoError AES256)
-> (ByteString -> CryptoFailable AES256)
-> ByteString
-> Either CryptoError AES256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key.
(Cipher AES256, ByteArray key) =>
key -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
Crypto.cipherInit @AES256

paddingConfig :: Format
paddingConfig :: Format
paddingConfig = Int -> Format
PKCS7 Int
16

data AesError = KeyError | IvError | PaddingError
    deriving (AesError -> AesError -> Bool
(AesError -> AesError -> Bool)
-> (AesError -> AesError -> Bool) -> Eq AesError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AesError -> AesError -> Bool
$c/= :: AesError -> AesError -> Bool
== :: AesError -> AesError -> Bool
$c== :: AesError -> AesError -> Bool
Eq, Int -> AesError -> String -> String
[AesError] -> String -> String
AesError -> String
(Int -> AesError -> String -> String)
-> (AesError -> String)
-> ([AesError] -> String -> String)
-> Show AesError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AesError] -> String -> String
$cshowList :: [AesError] -> String -> String
show :: AesError -> String
$cshow :: AesError -> String
showsPrec :: Int -> AesError -> String -> String
$cshowsPrec :: Int -> AesError -> String -> String
Show)

instance Exception AesError