{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Simplex.RemoteControl.Types
  ( RCErrorType (..),
    RCPVersion,
    VersionRCP,
    VersionRangeRCP,
    RCHostHello (..),
    RCCtrlHello (..),
    RCHostPairing (..),
    KnownHostPairing (..),
    RCCtrlAddress (..),
    RCCtrlPairing (..),
    RCHostKeys (..),
    RCHostSession (..),
    HostSessKeys (..),
    RCCtrlSession (..),
    CtrlSessKeys (..),
    RCHostEncHello (..),
    RCCtrlEncHello (..),
    SessionCode,
    RCStepTMVar,
    currentRCPVersion,
    supportedRCPVRange,
  ) where

import qualified Data.Aeson as J
import qualified Data.Aeson.TH as JQ
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word16)
import qualified Data.X509 as X
import qualified Network.TLS as TLS
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.SNTRUP761.Bindings
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
import Simplex.Messaging.Transport (TLS, TSbChainKeys, TransportPeer (..))
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (AnyError (..), safeDecodeUtf8)
import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange)
import Simplex.Messaging.Version.Internal
import UnliftIO

data RCErrorType
  = RCEInternal {RCErrorType -> String
internalErr :: String}
  | RCEIdentity
  | RCENoLocalAddress
  | RCENewController
  | RCENotDiscovered
  | RCETLSStartFailed
  | RCEException {RCErrorType -> String
exception :: String}
  | RCECtrlAuth
  | RCECtrlNotFound
  | RCECtrlError {RCErrorType -> String
ctrlErr :: String}
  | RCEInvitation
  | RCEVersion
  | RCEEncrypt
  | RCEDecrypt
  | RCEBlockSize
  | RCESyntax {RCErrorType -> String
syntaxErr :: String}
  deriving (RCErrorType -> RCErrorType -> Bool
(RCErrorType -> RCErrorType -> Bool)
-> (RCErrorType -> RCErrorType -> Bool) -> Eq RCErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RCErrorType -> RCErrorType -> Bool
== :: RCErrorType -> RCErrorType -> Bool
$c/= :: RCErrorType -> RCErrorType -> Bool
/= :: RCErrorType -> RCErrorType -> Bool
Eq, Int -> RCErrorType -> ShowS
[RCErrorType] -> ShowS
RCErrorType -> String
(Int -> RCErrorType -> ShowS)
-> (RCErrorType -> String)
-> ([RCErrorType] -> ShowS)
-> Show RCErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCErrorType -> ShowS
showsPrec :: Int -> RCErrorType -> ShowS
$cshow :: RCErrorType -> String
show :: RCErrorType -> String
$cshowList :: [RCErrorType] -> ShowS
showList :: [RCErrorType] -> ShowS
Show, Show RCErrorType
Typeable RCErrorType
(Typeable RCErrorType, Show RCErrorType) =>
(RCErrorType -> SomeException)
-> (SomeException -> Maybe RCErrorType)
-> (RCErrorType -> String)
-> Exception RCErrorType
SomeException -> Maybe RCErrorType
RCErrorType -> String
RCErrorType -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: RCErrorType -> SomeException
toException :: RCErrorType -> SomeException
$cfromException :: SomeException -> Maybe RCErrorType
fromException :: SomeException -> Maybe RCErrorType
$cdisplayException :: RCErrorType -> String
displayException :: RCErrorType -> String
Exception)

instance AnyError RCErrorType where
  fromSomeException :: SomeException -> RCErrorType
fromSomeException SomeException
e = case SomeException -> Maybe TLSException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just (TLS.Terminated Bool
_ String
_ (TLS.Error_Protocol (String
_, Bool
_, AlertDescription
TLS.UnknownCa))) -> RCErrorType
RCEIdentity
    Maybe TLSException
_ -> String -> RCErrorType
RCEException (String -> RCErrorType) -> String -> RCErrorType
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
  {-# INLINE fromSomeException #-}

instance StrEncoding RCErrorType where
  strEncode :: RCErrorType -> ByteString
strEncode = \case
    RCEInternal String
err -> ByteString
"INTERNAL" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
text String
err
    RCErrorType
RCEIdentity -> ByteString
"IDENTITY"
    RCErrorType
RCENoLocalAddress -> ByteString
"NO_LOCAL_ADDR"
    RCErrorType
RCENewController -> ByteString
"NEW_CONTROLLER"
    RCErrorType
RCENotDiscovered -> ByteString
"NOT_DISCOVERED"
    RCErrorType
RCETLSStartFailed -> ByteString
"CTRL_TLS_START"
    RCEException String
err -> ByteString
"EXCEPTION" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
text String
err
    RCErrorType
RCECtrlAuth -> ByteString
"CTRL_AUTH"
    RCErrorType
RCECtrlNotFound -> ByteString
"CTRL_NOT_FOUND"
    RCECtrlError String
err -> ByteString
"CTRL_ERROR" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
text String
err
    RCErrorType
RCEInvitation -> ByteString
"INVITATION"
    RCErrorType
RCEVersion -> ByteString
"VERSION"
    RCErrorType
RCEEncrypt -> ByteString
"ENCRYPT"
    RCErrorType
RCEDecrypt -> ByteString
"DECRYPT"
    RCErrorType
RCEBlockSize -> ByteString
"BLOCK_SIZE"
    RCESyntax String
err -> ByteString
"SYNTAX" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
text String
err
    where
      text :: String -> ByteString
text = (ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  strP :: Parser RCErrorType
strP =
    (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString
-> (ByteString -> Parser RCErrorType) -> Parser RCErrorType
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
>>= \case
      ByteString
"INTERNAL" -> String -> RCErrorType
RCEInternal (String -> RCErrorType)
-> Parser ByteString String -> Parser RCErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
textP
      ByteString
"IDENTITY" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCEIdentity
      ByteString
"NO_LOCAL_ADDR" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCENoLocalAddress
      ByteString
"NEW_CONTROLLER" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCENewController
      ByteString
"NOT_DISCOVERED" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCENotDiscovered
      ByteString
"CTRL_TLS_START" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCETLSStartFailed
      ByteString
"EXCEPTION" -> String -> RCErrorType
RCEException (String -> RCErrorType)
-> Parser ByteString String -> Parser RCErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
textP
      ByteString
"CTRL_AUTH" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCECtrlAuth
      ByteString
"CTRL_NOT_FOUND" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCECtrlNotFound
      ByteString
"CTRL_ERROR" -> String -> RCErrorType
RCECtrlError (String -> RCErrorType)
-> Parser ByteString String -> Parser RCErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
textP
      ByteString
"INVITATION" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCEInvitation
      ByteString
"VERSION" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCEVersion
      ByteString
"ENCRYPT" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCEEncrypt
      ByteString
"DECRYPT" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCEDecrypt
      ByteString
"BLOCK_SIZE" -> RCErrorType -> Parser RCErrorType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCErrorType
RCEBlockSize
      ByteString
"SYNTAX" -> String -> RCErrorType
RCESyntax (String -> RCErrorType)
-> Parser ByteString String -> Parser RCErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
textP
      ByteString
_ -> String -> Parser RCErrorType
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad RCErrorType"
    where
      textP :: Parser ByteString String
textP = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> String)
-> Parser ByteString -> Parser ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.space Parser Char -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
A.takeByteString)

-- * Discovery

data RCPVersion

instance VersionScope RCPVersion

type VersionRCP = Version RCPVersion

type VersionRangeRCP = VersionRange RCPVersion

pattern VersionRCP :: Word16 -> VersionRCP
pattern $mVersionRCP :: forall {r}. VersionRCP -> (Word16 -> r) -> ((# #) -> r) -> r
$bVersionRCP :: Word16 -> VersionRCP
VersionRCP v = Version v

currentRCPVersion :: VersionRCP
currentRCPVersion :: VersionRCP
currentRCPVersion = Word16 -> VersionRCP
VersionRCP Word16
1

supportedRCPVRange :: VersionRangeRCP
supportedRCPVRange :: VersionRangeRCP
supportedRCPVRange = VersionRCP -> VersionRCP -> VersionRangeRCP
forall v. Version v -> Version v -> VersionRange v
mkVersionRange (Word16 -> VersionRCP
VersionRCP Word16
1) VersionRCP
currentRCPVersion

-- * Session

data RCHostHello = RCHostHello
  { RCHostHello -> VersionRCP
v :: VersionRCP,
    RCHostHello -> KeyHash
ca :: C.KeyHash,
    RCHostHello -> Value
app :: J.Value,
    RCHostHello -> KEMPublicKey
kem :: KEMPublicKey
  }
  deriving (Int -> RCHostHello -> ShowS
[RCHostHello] -> ShowS
RCHostHello -> String
(Int -> RCHostHello -> ShowS)
-> (RCHostHello -> String)
-> ([RCHostHello] -> ShowS)
-> Show RCHostHello
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCHostHello -> ShowS
showsPrec :: Int -> RCHostHello -> ShowS
$cshow :: RCHostHello -> String
show :: RCHostHello -> String
$cshowList :: [RCHostHello] -> ShowS
showList :: [RCHostHello] -> ShowS
Show)

$(JQ.deriveJSON defaultJSON ''RCHostHello)

data RCCtrlHello = RCCtrlHello {}
  deriving (Int -> RCCtrlHello -> ShowS
[RCCtrlHello] -> ShowS
RCCtrlHello -> String
(Int -> RCCtrlHello -> ShowS)
-> (RCCtrlHello -> String)
-> ([RCCtrlHello] -> ShowS)
-> Show RCCtrlHello
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCCtrlHello -> ShowS
showsPrec :: Int -> RCCtrlHello -> ShowS
$cshow :: RCCtrlHello -> String
show :: RCCtrlHello -> String
$cshowList :: [RCCtrlHello] -> ShowS
showList :: [RCCtrlHello] -> ShowS
Show)

$(JQ.deriveJSON defaultJSON {J.nullaryToObject = True} ''RCCtrlHello)

-- | Long-term part of controller (desktop) connection to host (mobile)
data RCHostPairing = RCHostPairing
  { RCHostPairing -> APrivateSignKey
caKey :: C.APrivateSignKey,
    RCHostPairing -> SignedCertificate
caCert :: X.SignedCertificate,
    RCHostPairing -> PrivateKeyEd25519
idPrivKey :: C.PrivateKeyEd25519,
    RCHostPairing -> Maybe KnownHostPairing
knownHost :: Maybe KnownHostPairing
  }

data KnownHostPairing = KnownHostPairing
  { KnownHostPairing -> KeyHash
hostFingerprint :: C.KeyHash, -- this is only changed in the first session, long-term identity of connected remote host
    KnownHostPairing -> PublicKeyX25519
hostDhPubKey :: C.PublicKeyX25519
  }

data RCCtrlAddress = RCCtrlAddress
  { RCCtrlAddress -> TransportHost
address :: TransportHost, -- allows any interface when found exactly
    RCCtrlAddress -> Text
interface :: Text
  }
  deriving (Int -> RCCtrlAddress -> ShowS
[RCCtrlAddress] -> ShowS
RCCtrlAddress -> String
(Int -> RCCtrlAddress -> ShowS)
-> (RCCtrlAddress -> String)
-> ([RCCtrlAddress] -> ShowS)
-> Show RCCtrlAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCCtrlAddress -> ShowS
showsPrec :: Int -> RCCtrlAddress -> ShowS
$cshow :: RCCtrlAddress -> String
show :: RCCtrlAddress -> String
$cshowList :: [RCCtrlAddress] -> ShowS
showList :: [RCCtrlAddress] -> ShowS
Show, RCCtrlAddress -> RCCtrlAddress -> Bool
(RCCtrlAddress -> RCCtrlAddress -> Bool)
-> (RCCtrlAddress -> RCCtrlAddress -> Bool) -> Eq RCCtrlAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RCCtrlAddress -> RCCtrlAddress -> Bool
== :: RCCtrlAddress -> RCCtrlAddress -> Bool
$c/= :: RCCtrlAddress -> RCCtrlAddress -> Bool
/= :: RCCtrlAddress -> RCCtrlAddress -> Bool
Eq)

-- | Long-term part of host (mobile) connection to controller (desktop)
data RCCtrlPairing = RCCtrlPairing
  { RCCtrlPairing -> APrivateSignKey
caKey :: C.APrivateSignKey,
    RCCtrlPairing -> SignedCertificate
caCert :: X.SignedCertificate,
    RCCtrlPairing -> KeyHash
ctrlFingerprint :: C.KeyHash, -- long-term identity of connected remote controller
    RCCtrlPairing -> PublicKeyEd25519
idPubKey :: C.PublicKeyEd25519,
    RCCtrlPairing -> PrivateKeyX25519
dhPrivKey :: C.PrivateKeyX25519,
    RCCtrlPairing -> Maybe PrivateKeyX25519
prevDhPrivKey :: Maybe C.PrivateKeyX25519
  }

data RCHostKeys = RCHostKeys
  { RCHostKeys -> KeyPairEd25519
sessKeys :: C.KeyPairEd25519,
    RCHostKeys -> KeyPairX25519
dhKeys :: C.KeyPairX25519
  }

-- Connected session with Host
data RCHostSession = RCHostSession
  { RCHostSession -> TLS 'TServer
tls :: TLS 'TServer,
    RCHostSession -> HostSessKeys
sessionKeys :: HostSessKeys
  }

data HostSessKeys = HostSessKeys
  { HostSessKeys -> TSbChainKeys
chainKeys :: TSbChainKeys,
    HostSessKeys -> PrivateKeyEd25519
idPrivKey :: C.PrivateKeyEd25519,
    HostSessKeys -> PrivateKeyEd25519
sessPrivKey :: C.PrivateKeyEd25519
  }

-- Host: RCCtrlPairing + RCInvitation => (RCCtrlSession, RCCtrlPairing)

data RCCtrlSession = RCCtrlSession
  { RCCtrlSession -> TLS 'TClient
tls :: TLS 'TClient,
    RCCtrlSession -> CtrlSessKeys
sessionKeys :: CtrlSessKeys
  }

data CtrlSessKeys = CtrlSessKeys
  { CtrlSessKeys -> TSbChainKeys
chainKeys :: TSbChainKeys,
    CtrlSessKeys -> PublicKeyEd25519
idPubKey :: C.PublicKeyEd25519,
    CtrlSessKeys -> PublicKeyEd25519
sessPubKey :: C.PublicKeyEd25519
  }

data RCHostEncHello = RCHostEncHello
  { RCHostEncHello -> PublicKeyX25519
dhPubKey :: C.PublicKeyX25519,
    RCHostEncHello -> CbNonce
nonce :: C.CbNonce,
    RCHostEncHello -> ByteString
encBody :: ByteString
  }
  deriving (Int -> RCHostEncHello -> ShowS
[RCHostEncHello] -> ShowS
RCHostEncHello -> String
(Int -> RCHostEncHello -> ShowS)
-> (RCHostEncHello -> String)
-> ([RCHostEncHello] -> ShowS)
-> Show RCHostEncHello
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCHostEncHello -> ShowS
showsPrec :: Int -> RCHostEncHello -> ShowS
$cshow :: RCHostEncHello -> String
show :: RCHostEncHello -> String
$cshowList :: [RCHostEncHello] -> ShowS
showList :: [RCHostEncHello] -> ShowS
Show)

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

data RCCtrlEncHello
  = RCCtrlEncHello {RCCtrlEncHello -> KEMCiphertext
kem :: KEMCiphertext, RCCtrlEncHello -> ByteString
encBody :: ByteString}
  | RCCtrlEncError {RCCtrlEncHello -> CbNonce
nonce :: C.CbNonce, RCCtrlEncHello -> ByteString
encMessage :: ByteString}
  deriving (Int -> RCCtrlEncHello -> ShowS
[RCCtrlEncHello] -> ShowS
RCCtrlEncHello -> String
(Int -> RCCtrlEncHello -> ShowS)
-> (RCCtrlEncHello -> String)
-> ([RCCtrlEncHello] -> ShowS)
-> Show RCCtrlEncHello
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RCCtrlEncHello -> ShowS
showsPrec :: Int -> RCCtrlEncHello -> ShowS
$cshow :: RCCtrlEncHello -> String
show :: RCCtrlEncHello -> String
$cshowList :: [RCCtrlEncHello] -> ShowS
showList :: [RCCtrlEncHello] -> ShowS
Show)

instance Encoding RCCtrlEncHello where
  smpEncode :: RCCtrlEncHello -> ByteString
smpEncode = \case
    RCCtrlEncHello {KEMCiphertext
$sel:kem:RCCtrlEncHello :: RCCtrlEncHello -> KEMCiphertext
kem :: KEMCiphertext
kem, ByteString
$sel:encBody:RCCtrlEncHello :: RCCtrlEncHello -> ByteString
encBody :: ByteString
encBody} -> ByteString
"HELLO " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (KEMCiphertext, Tail) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (KEMCiphertext
kem, ByteString -> Tail
Tail ByteString
encBody)
    RCCtrlEncError {CbNonce
$sel:nonce:RCCtrlEncHello :: RCCtrlEncHello -> CbNonce
nonce :: CbNonce
nonce, ByteString
$sel:encMessage:RCCtrlEncHello :: RCCtrlEncHello -> ByteString
encMessage :: ByteString
encMessage} -> ByteString
"ERROR " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (CbNonce, Tail) -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode (CbNonce
nonce, ByteString -> Tail
Tail ByteString
encMessage)
  smpP :: Parser RCCtrlEncHello
smpP =
    (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString
-> (ByteString -> Parser RCCtrlEncHello) -> Parser RCCtrlEncHello
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
>>= \case
      ByteString
"HELLO" -> do
        (KEMCiphertext
kem, Tail ByteString
encBody) <- Parser (KEMCiphertext, Tail)
forall a. Encoding a => Parser a
_smpP
        RCCtrlEncHello -> Parser RCCtrlEncHello
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCCtrlEncHello {KEMCiphertext
$sel:kem:RCCtrlEncHello :: KEMCiphertext
kem :: KEMCiphertext
kem, ByteString
$sel:encBody:RCCtrlEncHello :: ByteString
encBody :: ByteString
encBody}
      ByteString
"ERROR" -> do
        (CbNonce
nonce, Tail ByteString
encMessage) <- Parser (CbNonce, Tail)
forall a. Encoding a => Parser a
_smpP
        RCCtrlEncHello -> Parser RCCtrlEncHello
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RCCtrlEncError {CbNonce
$sel:nonce:RCCtrlEncHello :: CbNonce
nonce :: CbNonce
nonce, ByteString
$sel:encMessage:RCCtrlEncHello :: ByteString
encMessage :: ByteString
encMessage}
      ByteString
_ -> String -> Parser RCCtrlEncHello
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad RCCtrlEncHello"

-- * Utils

-- | tlsunique channel binding
type SessionCode = ByteString

type RCStepTMVar a = TMVar (Either RCErrorType a)

$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RCErrorType)

$(JQ.deriveJSON defaultJSON ''RCCtrlAddress)