{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Simplex.RemoteControl.Invitation
  ( RCInvitation (..)
  , signInvitation
  , RCSignedInvitation (..)
  , verifySignedInvitation
  , RCVerifiedInvitation (..)
  , RCEncInvitation (..)
  ) where

import qualified Data.Aeson as J
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Time.Clock.System (SystemTime)
import Data.Word (Word16)
import Network.HTTP.Types (parseSimpleQuery)
import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery, urlDecode)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.RemoteControl.Types (VersionRangeRCP)

data RCInvitation = RCInvitation
  { -- | CA TLS certificate fingerprint of the controller.
    --
    -- This is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
    RCInvitation -> KeyHash
ca :: C.KeyHash,
    RCInvitation -> TransportHost
host :: TransportHost,
    RCInvitation -> Word16
port :: Word16,
    -- | Supported version range for remote control protocol
    RCInvitation -> VersionRangeRCP
v :: VersionRangeRCP,
    -- | Application information
    RCInvitation -> Value
app :: J.Value,
    -- | Session start time in seconds since epoch
    RCInvitation -> SystemTime
ts :: SystemTime,
    -- | Session Ed25519 public key used to verify the announcement and commands
    --
    -- This mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
    RCInvitation -> PublicKeyEd25519
skey :: C.PublicKeyEd25519,
    -- | Long-term Ed25519 public key used to verify the announcement and commands.
    --
    -- Is apart of the long term controller identity.
    RCInvitation -> PublicKeyEd25519
idkey :: C.PublicKeyEd25519,
    -- | Session X25519 DH key
    RCInvitation -> PublicKeyX25519
dh :: C.PublicKeyX25519
  }
  deriving (Int -> RCInvitation -> ShowS
[RCInvitation] -> ShowS
RCInvitation -> String
(Int -> RCInvitation -> ShowS)
-> (RCInvitation -> String)
-> ([RCInvitation] -> ShowS)
-> Show RCInvitation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCInvitation -> ShowS
showsPrec :: Int -> RCInvitation -> ShowS
$cshow :: RCInvitation -> String
show :: RCInvitation -> String
$cshowList :: [RCInvitation] -> ShowS
showList :: [RCInvitation] -> ShowS
Show)

instance StrEncoding RCInvitation where
  strEncode :: RCInvitation -> ByteString
strEncode RCInvitation {KeyHash
$sel:ca:RCInvitation :: RCInvitation -> KeyHash
ca :: KeyHash
ca, TransportHost
$sel:host:RCInvitation :: RCInvitation -> TransportHost
host :: TransportHost
host, Word16
$sel:port:RCInvitation :: RCInvitation -> Word16
port :: Word16
port, VersionRangeRCP
$sel:v:RCInvitation :: RCInvitation -> VersionRangeRCP
v :: VersionRangeRCP
v, Value
$sel:app:RCInvitation :: RCInvitation -> Value
app :: Value
app, SystemTime
$sel:ts:RCInvitation :: RCInvitation -> SystemTime
ts :: SystemTime
ts, PublicKeyEd25519
$sel:skey:RCInvitation :: RCInvitation -> PublicKeyEd25519
skey :: PublicKeyEd25519
skey, PublicKeyEd25519
$sel:idkey:RCInvitation :: RCInvitation -> PublicKeyEd25519
idkey :: PublicKeyEd25519
idkey, PublicKeyX25519
$sel:dh:RCInvitation :: RCInvitation -> PublicKeyX25519
dh :: PublicKeyX25519
dh} =
    [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
      [ ByteString
"xrcp:/",
        KeyHash -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode KeyHash
ca,
        ByteString
"@",
        TransportHost -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode TransportHost
host,
        ByteString
":",
        Word16 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Word16
port,
        ByteString
"#/?",
        Bool -> SimpleQuery -> ByteString
renderSimpleQuery Bool
False SimpleQuery
query
      ]
    where
      query :: SimpleQuery
query =
        [ (ByteString
"v", VersionRangeRCP -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode VersionRangeRCP
v),
          (ByteString
"app", ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode Value
app),
          (ByteString
"ts", SystemTime -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SystemTime
ts),
          (ByteString
"skey", PublicKeyEd25519 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode PublicKeyEd25519
skey),
          (ByteString
"idkey", PublicKeyEd25519 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode PublicKeyEd25519
idkey),
          (ByteString
"dh", PublicKeyX25519 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode PublicKeyX25519
dh)
        ]

  strP :: Parser RCInvitation
strP = do
    ByteString
_ <- ByteString -> Parser ByteString
A.string ByteString
"xrcp:/"
    KeyHash
ca <- Parser KeyHash
forall a. StrEncoding a => Parser a
strP
    Char
_ <- Char -> Parser Char
A.char Char
'@'
    TransportHost
host <- (Char -> Bool) -> Parser ByteString
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Parser ByteString
-> (ByteString -> Parser ByteString TransportHost)
-> Parser ByteString TransportHost
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Parser ByteString TransportHost)
-> (TransportHost -> Parser ByteString TransportHost)
-> Either String TransportHost
-> Parser ByteString TransportHost
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString TransportHost
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail TransportHost -> Parser ByteString TransportHost
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String TransportHost -> Parser ByteString TransportHost)
-> (ByteString -> Either String TransportHost)
-> ByteString
-> Parser ByteString TransportHost
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String TransportHost
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String TransportHost)
-> (ByteString -> ByteString)
-> ByteString
-> Either String TransportHost
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
True
    Char
_ <- Char -> Parser Char
A.char Char
':'
    Word16
port <- Parser Word16
forall a. StrEncoding a => Parser a
strP
    ByteString
_ <- ByteString -> Parser ByteString
A.string ByteString
"#/?"

    SimpleQuery
q <- ByteString -> SimpleQuery
parseSimpleQuery (ByteString -> SimpleQuery)
-> Parser ByteString -> Parser ByteString SimpleQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')
    VersionRangeRCP
v <- SimpleQuery
-> ByteString
-> (ByteString -> Either String VersionRangeRCP)
-> Parser ByteString VersionRangeRCP
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
q ByteString
"v" ByteString -> Either String VersionRangeRCP
forall a. StrEncoding a => ByteString -> Either String a
strDecode
    Value
app <- SimpleQuery
-> ByteString
-> (ByteString -> Either String Value)
-> Parser ByteString Value
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
q ByteString
"app" ((ByteString -> Either String Value) -> Parser ByteString Value)
-> (ByteString -> Either String Value) -> Parser ByteString Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict (ByteString -> Either String Value)
-> (ByteString -> ByteString) -> ByteString -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
True
    SystemTime
ts <- SimpleQuery
-> ByteString
-> (ByteString -> Either String SystemTime)
-> Parser ByteString SystemTime
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
q ByteString
"ts" ((ByteString -> Either String SystemTime)
 -> Parser ByteString SystemTime)
-> (ByteString -> Either String SystemTime)
-> Parser ByteString SystemTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String SystemTime
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String SystemTime)
-> (ByteString -> ByteString)
-> ByteString
-> Either String SystemTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
True
    PublicKeyEd25519
skey <- SimpleQuery
-> ByteString
-> (ByteString -> Either String PublicKeyEd25519)
-> Parser ByteString PublicKeyEd25519
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
q ByteString
"skey" ((ByteString -> Either String PublicKeyEd25519)
 -> Parser ByteString PublicKeyEd25519)
-> (ByteString -> Either String PublicKeyEd25519)
-> Parser ByteString PublicKeyEd25519
forall a b. (a -> b) -> a -> b
$ Parser ByteString PublicKeyEd25519
-> ByteString -> Either String PublicKeyEd25519
forall a. Parser a -> ByteString -> Either String a
parseAll Parser ByteString PublicKeyEd25519
forall a. StrEncoding a => Parser a
strP
    PublicKeyEd25519
idkey <- SimpleQuery
-> ByteString
-> (ByteString -> Either String PublicKeyEd25519)
-> Parser ByteString PublicKeyEd25519
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
q ByteString
"idkey" ((ByteString -> Either String PublicKeyEd25519)
 -> Parser ByteString PublicKeyEd25519)
-> (ByteString -> Either String PublicKeyEd25519)
-> Parser ByteString PublicKeyEd25519
forall a b. (a -> b) -> a -> b
$ Parser ByteString PublicKeyEd25519
-> ByteString -> Either String PublicKeyEd25519
forall a. Parser a -> ByteString -> Either String a
parseAll Parser ByteString PublicKeyEd25519
forall a. StrEncoding a => Parser a
strP
    PublicKeyX25519
dh <- SimpleQuery
-> ByteString
-> (ByteString -> Either String PublicKeyX25519)
-> Parser ByteString PublicKeyX25519
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
q ByteString
"dh" ((ByteString -> Either String PublicKeyX25519)
 -> Parser ByteString PublicKeyX25519)
-> (ByteString -> Either String PublicKeyX25519)
-> Parser ByteString PublicKeyX25519
forall a b. (a -> b) -> a -> b
$ Parser ByteString PublicKeyX25519
-> ByteString -> Either String PublicKeyX25519
forall a. Parser a -> ByteString -> Either String a
parseAll Parser ByteString PublicKeyX25519
forall a. StrEncoding a => Parser a
strP
    RCInvitation -> Parser RCInvitation
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCInvitation {KeyHash
$sel:ca:RCInvitation :: KeyHash
ca :: KeyHash
ca, TransportHost
$sel:host:RCInvitation :: TransportHost
host :: TransportHost
host, Word16
$sel:port:RCInvitation :: Word16
port :: Word16
port, VersionRangeRCP
$sel:v:RCInvitation :: VersionRangeRCP
v :: VersionRangeRCP
v, Value
$sel:app:RCInvitation :: Value
app :: Value
app, SystemTime
$sel:ts:RCInvitation :: SystemTime
ts :: SystemTime
ts, PublicKeyEd25519
$sel:skey:RCInvitation :: PublicKeyEd25519
skey :: PublicKeyEd25519
skey, PublicKeyEd25519
$sel:idkey:RCInvitation :: PublicKeyEd25519
idkey :: PublicKeyEd25519
idkey, PublicKeyX25519
$sel:dh:RCInvitation :: PublicKeyX25519
dh :: PublicKeyX25519
dh}

data RCSignedInvitation = RCSignedInvitation
  { RCSignedInvitation -> RCInvitation
invitation :: RCInvitation,
    RCSignedInvitation -> Signature 'Ed25519
ssig :: C.Signature 'C.Ed25519,
    RCSignedInvitation -> Signature 'Ed25519
idsig :: C.Signature 'C.Ed25519
  }
  deriving (Int -> RCSignedInvitation -> ShowS
[RCSignedInvitation] -> ShowS
RCSignedInvitation -> String
(Int -> RCSignedInvitation -> ShowS)
-> (RCSignedInvitation -> String)
-> ([RCSignedInvitation] -> ShowS)
-> Show RCSignedInvitation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCSignedInvitation -> ShowS
showsPrec :: Int -> RCSignedInvitation -> ShowS
$cshow :: RCSignedInvitation -> String
show :: RCSignedInvitation -> String
$cshowList :: [RCSignedInvitation] -> ShowS
showList :: [RCSignedInvitation] -> ShowS
Show)

-- | URL-encoded and signed for showing in QR code
instance StrEncoding RCSignedInvitation where
  strEncode :: RCSignedInvitation -> ByteString
strEncode RCSignedInvitation {RCInvitation
$sel:invitation:RCSignedInvitation :: RCSignedInvitation -> RCInvitation
invitation :: RCInvitation
invitation, Signature 'Ed25519
$sel:ssig:RCSignedInvitation :: RCSignedInvitation -> Signature 'Ed25519
ssig :: Signature 'Ed25519
ssig, Signature 'Ed25519
$sel:idsig:RCSignedInvitation :: RCSignedInvitation -> Signature 'Ed25519
idsig :: Signature 'Ed25519
idsig} =
    [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
      [ RCInvitation -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode RCInvitation
invitation,
        ByteString
"&ssig=",
        Signature 'Ed25519 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Signature 'Ed25519
ssig,
        ByteString
"&idsig=",
        Signature 'Ed25519 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Signature 'Ed25519
idsig
      ]

  strP :: Parser RCSignedInvitation
strP = do
    -- TODO this assumes some order or parameters, can be made independent
    (ByteString
url, RCInvitation
invitation) <- Parser RCInvitation -> Parser (ByteString, RCInvitation)
forall a. Parser a -> Parser (ByteString, a)
A.match Parser RCInvitation
forall a. StrEncoding a => Parser a
strP
    SimpleQuery
sigs <- case ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
"&ssig=" ByteString
url of
      (ByteString
_, ByteString
sigs) | ByteString -> Bool
B.null ByteString
sigs -> String -> Parser ByteString SimpleQuery
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing signatures"
      (ByteString
_, ByteString
sigs) -> SimpleQuery -> Parser ByteString SimpleQuery
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleQuery -> Parser ByteString SimpleQuery)
-> SimpleQuery -> Parser ByteString SimpleQuery
forall a b. (a -> b) -> a -> b
$ ByteString -> SimpleQuery
parseSimpleQuery (ByteString -> SimpleQuery) -> ByteString -> SimpleQuery
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
1 ByteString
sigs
    Signature 'Ed25519
ssig <- SimpleQuery
-> ByteString
-> (ByteString -> Either String (Signature 'Ed25519))
-> Parser ByteString (Signature 'Ed25519)
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
sigs ByteString
"ssig" ((ByteString -> Either String (Signature 'Ed25519))
 -> Parser ByteString (Signature 'Ed25519))
-> (ByteString -> Either String (Signature 'Ed25519))
-> Parser ByteString (Signature 'Ed25519)
forall a b. (a -> b) -> a -> b
$ Parser ByteString (Signature 'Ed25519)
-> ByteString -> Either String (Signature 'Ed25519)
forall a. Parser a -> ByteString -> Either String a
parseAll Parser ByteString (Signature 'Ed25519)
forall a. StrEncoding a => Parser a
strP
    Signature 'Ed25519
idsig <- SimpleQuery
-> ByteString
-> (ByteString -> Either String (Signature 'Ed25519))
-> Parser ByteString (Signature 'Ed25519)
forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
sigs ByteString
"idsig" ((ByteString -> Either String (Signature 'Ed25519))
 -> Parser ByteString (Signature 'Ed25519))
-> (ByteString -> Either String (Signature 'Ed25519))
-> Parser ByteString (Signature 'Ed25519)
forall a b. (a -> b) -> a -> b
$ Parser ByteString (Signature 'Ed25519)
-> ByteString -> Either String (Signature 'Ed25519)
forall a. Parser a -> ByteString -> Either String a
parseAll Parser ByteString (Signature 'Ed25519)
forall a. StrEncoding a => Parser a
strP
    RCSignedInvitation -> Parser RCSignedInvitation
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCSignedInvitation {RCInvitation
$sel:invitation:RCSignedInvitation :: RCInvitation
invitation :: RCInvitation
invitation, Signature 'Ed25519
$sel:ssig:RCSignedInvitation :: Signature 'Ed25519
ssig :: Signature 'Ed25519
ssig, Signature 'Ed25519
$sel:idsig:RCSignedInvitation :: Signature 'Ed25519
idsig :: Signature 'Ed25519
idsig}

signInvitation :: C.PrivateKey 'C.Ed25519 -> C.PrivateKey 'C.Ed25519 -> RCInvitation -> RCSignedInvitation
signInvitation :: PrivateKey 'Ed25519
-> PrivateKey 'Ed25519 -> RCInvitation -> RCSignedInvitation
signInvitation PrivateKey 'Ed25519
sKey PrivateKey 'Ed25519
idKey RCInvitation
invitation = RCSignedInvitation {RCInvitation
$sel:invitation:RCSignedInvitation :: RCInvitation
invitation :: RCInvitation
invitation, Signature 'Ed25519
$sel:ssig:RCSignedInvitation :: Signature 'Ed25519
ssig :: Signature 'Ed25519
ssig, Signature 'Ed25519
$sel:idsig:RCSignedInvitation :: Signature 'Ed25519
idsig :: Signature 'Ed25519
idsig}
  where
    uri :: ByteString
uri = RCInvitation -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode RCInvitation
invitation
    ssig :: Signature 'Ed25519
ssig =
      case APrivateSignKey -> ByteString -> ASignature
C.sign (SAlgorithm 'Ed25519 -> PrivateKey 'Ed25519 -> APrivateSignKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateSignKey
C.APrivateSignKey SAlgorithm 'Ed25519
C.SEd25519 PrivateKey 'Ed25519
sKey) ByteString
uri of
        C.ASignature SAlgorithm a
C.SEd25519 Signature a
s -> Signature a
Signature 'Ed25519
s
        ASignature
_ -> String -> Signature 'Ed25519
forall a. HasCallStack => String -> a
error String
"signing with ed25519"
    inviteUrlSigned :: ByteString
inviteUrlSigned = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString
uri, ByteString
"&ssig=", Signature 'Ed25519 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Signature 'Ed25519
ssig]
    idsig :: Signature 'Ed25519
idsig =
      case APrivateSignKey -> ByteString -> ASignature
C.sign (SAlgorithm 'Ed25519 -> PrivateKey 'Ed25519 -> APrivateSignKey
forall (a :: Algorithm).
(AlgorithmI a, SignatureAlgorithm a) =>
SAlgorithm a -> PrivateKey a -> APrivateSignKey
C.APrivateSignKey SAlgorithm 'Ed25519
C.SEd25519 PrivateKey 'Ed25519
idKey) ByteString
inviteUrlSigned of
        C.ASignature SAlgorithm a
C.SEd25519 Signature a
s -> Signature a
Signature 'Ed25519
s
        ASignature
_ -> String -> Signature 'Ed25519
forall a. HasCallStack => String -> a
error String
"signing with ed25519"

newtype RCVerifiedInvitation = RCVerifiedInvitation RCInvitation
  deriving (Int -> RCVerifiedInvitation -> ShowS
[RCVerifiedInvitation] -> ShowS
RCVerifiedInvitation -> String
(Int -> RCVerifiedInvitation -> ShowS)
-> (RCVerifiedInvitation -> String)
-> ([RCVerifiedInvitation] -> ShowS)
-> Show RCVerifiedInvitation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCVerifiedInvitation -> ShowS
showsPrec :: Int -> RCVerifiedInvitation -> ShowS
$cshow :: RCVerifiedInvitation -> String
show :: RCVerifiedInvitation -> String
$cshowList :: [RCVerifiedInvitation] -> ShowS
showList :: [RCVerifiedInvitation] -> ShowS
Show)

verifySignedInvitation :: RCSignedInvitation -> Maybe RCVerifiedInvitation
verifySignedInvitation :: RCSignedInvitation -> Maybe RCVerifiedInvitation
verifySignedInvitation RCSignedInvitation {RCInvitation
$sel:invitation:RCSignedInvitation :: RCSignedInvitation -> RCInvitation
invitation :: RCInvitation
invitation, Signature 'Ed25519
$sel:ssig:RCSignedInvitation :: RCSignedInvitation -> Signature 'Ed25519
ssig :: Signature 'Ed25519
ssig, Signature 'Ed25519
$sel:idsig:RCSignedInvitation :: RCSignedInvitation -> Signature 'Ed25519
idsig :: Signature 'Ed25519
idsig} =
  if PublicKeyEd25519 -> Signature 'Ed25519 -> ByteString -> Bool
forall (a :: Algorithm).
SignatureAlgorithm a =>
PublicKey a -> Signature a -> ByteString -> Bool
C.verify' PublicKeyEd25519
skey Signature 'Ed25519
ssig ByteString
inviteURL Bool -> Bool -> Bool
&& PublicKeyEd25519 -> Signature 'Ed25519 -> ByteString -> Bool
forall (a :: Algorithm).
SignatureAlgorithm a =>
PublicKey a -> Signature a -> ByteString -> Bool
C.verify' PublicKeyEd25519
idkey Signature 'Ed25519
idsig ByteString
inviteURLS
    then RCVerifiedInvitation -> Maybe RCVerifiedInvitation
forall a. a -> Maybe a
Just (RCVerifiedInvitation -> Maybe RCVerifiedInvitation)
-> RCVerifiedInvitation -> Maybe RCVerifiedInvitation
forall a b. (a -> b) -> a -> b
$ RCInvitation -> RCVerifiedInvitation
RCVerifiedInvitation RCInvitation
invitation
    else Maybe RCVerifiedInvitation
forall a. Maybe a
Nothing
  where
    RCInvitation {PublicKeyEd25519
$sel:skey:RCInvitation :: RCInvitation -> PublicKeyEd25519
skey :: PublicKeyEd25519
skey, PublicKeyEd25519
$sel:idkey:RCInvitation :: RCInvitation -> PublicKeyEd25519
idkey :: PublicKeyEd25519
idkey} = RCInvitation
invitation
    inviteURL :: ByteString
inviteURL = RCInvitation -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode RCInvitation
invitation
    inviteURLS :: ByteString
inviteURLS = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString
inviteURL, ByteString
"&ssig=", Signature 'Ed25519 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Signature 'Ed25519
ssig]

data RCEncInvitation = RCEncInvitation
  { RCEncInvitation -> PublicKeyX25519
dhPubKey :: C.PublicKeyX25519,
    RCEncInvitation -> CbNonce
nonce :: C.CbNonce,
    RCEncInvitation -> ByteString
encInvitation :: ByteString
  }

instance Encoding RCEncInvitation where
  smpEncode :: RCEncInvitation -> ByteString
smpEncode RCEncInvitation {PublicKeyX25519
$sel:dhPubKey:RCEncInvitation :: RCEncInvitation -> PublicKeyX25519
dhPubKey :: PublicKeyX25519
dhPubKey, CbNonce
$sel:nonce:RCEncInvitation :: RCEncInvitation -> CbNonce
nonce :: CbNonce
nonce, ByteString
$sel:encInvitation:RCEncInvitation :: RCEncInvitation -> ByteString
encInvitation :: ByteString
encInvitation} =
    (PublicKeyX25519, CbNonce, Tail) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (PublicKeyX25519
dhPubKey, CbNonce
nonce, ByteString -> Tail
Tail ByteString
encInvitation)
  smpP :: Parser RCEncInvitation
smpP = do
    (PublicKeyX25519
dhPubKey, CbNonce
nonce, Tail ByteString
encInvitation) <- Parser (PublicKeyX25519, CbNonce, Tail)
forall a. Encoding a => Parser a
smpP
    RCEncInvitation -> Parser RCEncInvitation
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCEncInvitation {PublicKeyX25519
$sel:dhPubKey:RCEncInvitation :: PublicKeyX25519
dhPubKey :: PublicKeyX25519
dhPubKey, CbNonce
$sel:nonce:RCEncInvitation :: CbNonce
nonce :: CbNonce
nonce, ByteString
$sel:encInvitation:RCEncInvitation :: ByteString
encInvitation :: ByteString
encInvitation}

-- * Utils

requiredP :: MonadFail m => SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP :: forall (m :: * -> *) a.
MonadFail m =>
SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
requiredP SimpleQuery
q ByteString
k ByteString -> Either String a
f = m a -> (ByteString -> m a) -> Maybe ByteString -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"missing " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
k) ((String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> m a)
-> (ByteString -> Either String a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
f) (Maybe ByteString -> m a) -> Maybe ByteString -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> SimpleQuery -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
k SimpleQuery
q