module Erebos.Channel (
    Channel,
    ChannelRequest, ChannelRequestData(..),
    ChannelAccept, ChannelAcceptData(..),

    createChannelRequest,
    acceptChannelRequest,
    acceptedChannel,

    channelEncrypt,
    channelDecrypt,
) where

import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class

import Crypto.Cipher.ChaChaPoly1305
import Crypto.Error

import Data.Binary
import Data.ByteArray (ByteArray, Bytes, ScrubbedBytes, convert)
import Data.ByteArray qualified as BA
import Data.ByteString.Lazy qualified as BL
import Data.List

import Erebos.Identity
import Erebos.PubKey
import Erebos.Storage

data Channel = Channel
    { Channel -> [Stored (Signed IdentityData)]
chPeers :: [Stored (Signed IdentityData)]
    , Channel -> ScrubbedBytes
chKey :: ScrubbedBytes
    , Channel -> Bytes
chNonceFixedOur :: Bytes
    , Channel -> Bytes
chNonceFixedPeer :: Bytes
    , Channel -> MVar Word64
chCounterNextOut :: MVar Word64
    , Channel -> MVar Word64
chCounterNextIn :: MVar Word64
    }

type ChannelRequest = Signed ChannelRequestData

data ChannelRequestData = ChannelRequest
    { ChannelRequestData -> [Stored (Signed IdentityData)]
crPeers :: [Stored (Signed IdentityData)]
    , ChannelRequestData -> Stored PublicKexKey
crKey :: Stored PublicKexKey
    }
    deriving (Int -> ChannelRequestData -> ShowS
[ChannelRequestData] -> ShowS
ChannelRequestData -> String
(Int -> ChannelRequestData -> ShowS)
-> (ChannelRequestData -> String)
-> ([ChannelRequestData] -> ShowS)
-> Show ChannelRequestData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChannelRequestData -> ShowS
showsPrec :: Int -> ChannelRequestData -> ShowS
$cshow :: ChannelRequestData -> String
show :: ChannelRequestData -> String
$cshowList :: [ChannelRequestData] -> ShowS
showList :: [ChannelRequestData] -> ShowS
Show)

type ChannelAccept = Signed ChannelAcceptData

data ChannelAcceptData = ChannelAccept
    { ChannelAcceptData -> Stored ChannelRequest
caRequest :: Stored ChannelRequest
    , ChannelAcceptData -> Stored PublicKexKey
caKey :: Stored PublicKexKey
    }


instance Storable ChannelRequestData where
    store' :: ChannelRequestData -> Store
store' ChannelRequestData
cr = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        (Stored (Signed IdentityData) -> StoreRec c)
-> [Stored (Signed IdentityData)] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Stored (Signed IdentityData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"peer") ([Stored (Signed IdentityData)] -> StoreRec c)
-> [Stored (Signed IdentityData)] -> StoreRec c
forall a b. (a -> b) -> a -> b
$ ChannelRequestData -> [Stored (Signed IdentityData)]
crPeers ChannelRequestData
cr
        String -> Stored PublicKexKey -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"key" (Stored PublicKexKey -> StoreRec c)
-> Stored PublicKexKey -> StoreRec c
forall a b. (a -> b) -> a -> b
$ ChannelRequestData -> Stored PublicKexKey
crKey ChannelRequestData
cr

    load' :: Load ChannelRequestData
load' = LoadRec ChannelRequestData -> Load ChannelRequestData
forall a. LoadRec a -> Load a
loadRec (LoadRec ChannelRequestData -> Load ChannelRequestData)
-> LoadRec ChannelRequestData -> Load ChannelRequestData
forall a b. (a -> b) -> a -> b
$ do
        [Stored (Signed IdentityData)]
-> Stored PublicKexKey -> ChannelRequestData
ChannelRequest
            ([Stored (Signed IdentityData)]
 -> Stored PublicKexKey -> ChannelRequestData)
-> LoadRec [Stored (Signed IdentityData)]
-> LoadRec (Stored PublicKexKey -> ChannelRequestData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec [Stored (Signed IdentityData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"peer"
            LoadRec (Stored PublicKexKey -> ChannelRequestData)
-> LoadRec (Stored PublicKexKey) -> LoadRec ChannelRequestData
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Stored PublicKexKey)
forall a. Storable a => String -> LoadRec a
loadRef String
"key"

instance Storable ChannelAcceptData where
    store' :: ChannelAcceptData -> Store
store' ChannelAcceptData
ca = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        String -> Stored ChannelRequest -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"req" (Stored ChannelRequest -> StoreRec c)
-> Stored ChannelRequest -> StoreRec c
forall a b. (a -> b) -> a -> b
$ ChannelAcceptData -> Stored ChannelRequest
caRequest ChannelAcceptData
ca
        String -> Stored PublicKexKey -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"key" (Stored PublicKexKey -> StoreRec c)
-> Stored PublicKexKey -> StoreRec c
forall a b. (a -> b) -> a -> b
$ ChannelAcceptData -> Stored PublicKexKey
caKey ChannelAcceptData
ca

    load' :: Load ChannelAcceptData
load' = LoadRec ChannelAcceptData -> Load ChannelAcceptData
forall a. LoadRec a -> Load a
loadRec (LoadRec ChannelAcceptData -> Load ChannelAcceptData)
-> LoadRec ChannelAcceptData -> Load ChannelAcceptData
forall a b. (a -> b) -> a -> b
$ do
        Stored ChannelRequest -> Stored PublicKexKey -> ChannelAcceptData
ChannelAccept
            (Stored ChannelRequest -> Stored PublicKexKey -> ChannelAcceptData)
-> LoadRec (Stored ChannelRequest)
-> LoadRec (Stored PublicKexKey -> ChannelAcceptData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec (Stored ChannelRequest)
forall a. Storable a => String -> LoadRec a
loadRef String
"req"
            LoadRec (Stored PublicKexKey -> ChannelAcceptData)
-> LoadRec (Stored PublicKexKey) -> LoadRec ChannelAcceptData
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LoadRec (Stored PublicKexKey)
forall a. Storable a => String -> LoadRec a
loadRef String
"key"


keySize :: Int
keySize :: Int
keySize = Int
32

createChannelRequest :: (MonadStorage m, MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> m (Stored ChannelRequest)
createChannelRequest :: forall (m :: * -> *).
(MonadStorage m, MonadIO m, MonadError String m) =>
UnifiedIdentity -> UnifiedIdentity -> m (Stored ChannelRequest)
createChannelRequest UnifiedIdentity
self UnifiedIdentity
peer = do
    (SecretKexKey
_, Stored PublicKexKey
xpublic) <- IO (SecretKexKey, Stored PublicKexKey)
-> m (SecretKexKey, Stored PublicKexKey)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SecretKexKey, Stored PublicKexKey)
 -> m (SecretKexKey, Stored PublicKexKey))
-> (Storage -> IO (SecretKexKey, Stored PublicKexKey))
-> Storage
-> m (SecretKexKey, Stored PublicKexKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Storage -> IO (SecretKexKey, Stored PublicKexKey)
forall sec pub. KeyPair sec pub => Storage -> IO (sec, Stored pub)
generateKeys (Storage -> m (SecretKexKey, Stored PublicKexKey))
-> m Storage -> m (SecretKexKey, Stored PublicKexKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Storage
forall (m :: * -> *). MonadStorage m => m Storage
getStorage
    SecretKey
skey <- Stored PublicKey -> m SecretKey
forall sec pub (m :: * -> *).
(KeyPair sec pub, MonadIO m, MonadError String m) =>
Stored pub -> m sec
loadKey (Stored PublicKey -> m SecretKey)
-> Stored PublicKey -> m SecretKey
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored PublicKey
forall (m :: * -> *). Identity m -> Stored PublicKey
idKeyMessage UnifiedIdentity
self
    ChannelRequest -> m (Stored ChannelRequest)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore (ChannelRequest -> m (Stored ChannelRequest))
-> m ChannelRequest -> m (Stored ChannelRequest)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SecretKey -> Stored ChannelRequestData -> m ChannelRequest
forall (m :: * -> *) a.
MonadStorage m =>
SecretKey -> Stored a -> m (Signed a)
sign SecretKey
skey (Stored ChannelRequestData -> m ChannelRequest)
-> m (Stored ChannelRequestData) -> m ChannelRequest
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChannelRequestData -> m (Stored ChannelRequestData)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChannelRequest { crPeers :: [Stored (Signed IdentityData)]
crPeers = [Stored (Signed IdentityData)] -> [Stored (Signed IdentityData)]
forall a. Ord a => [a] -> [a]
sort [UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
self, UnifiedIdentity -> Stored (Signed IdentityData)
idData UnifiedIdentity
peer], crKey :: Stored PublicKexKey
crKey = Stored PublicKexKey
xpublic }

acceptChannelRequest :: (MonadStorage m, MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelRequest -> m (Stored ChannelAccept, Channel)
acceptChannelRequest :: forall (m :: * -> *).
(MonadStorage m, MonadIO m, MonadError String m) =>
UnifiedIdentity
-> UnifiedIdentity
-> Stored ChannelRequest
-> m (Stored ChannelAccept, Channel)
acceptChannelRequest UnifiedIdentity
self UnifiedIdentity
peer Stored ChannelRequest
req = do
    case [Maybe UnifiedIdentity] -> Maybe [UnifiedIdentity]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Maybe UnifiedIdentity] -> Maybe [UnifiedIdentity])
-> [Maybe UnifiedIdentity] -> Maybe [UnifiedIdentity]
forall a b. (a -> b) -> a -> b
$ (Stored (Signed IdentityData) -> Maybe UnifiedIdentity)
-> [Stored (Signed IdentityData)] -> [Maybe UnifiedIdentity]
forall a b. (a -> b) -> [a] -> [b]
map Stored (Signed IdentityData) -> Maybe UnifiedIdentity
validateIdentity ([Stored (Signed IdentityData)] -> [Maybe UnifiedIdentity])
-> [Stored (Signed IdentityData)] -> [Maybe UnifiedIdentity]
forall a b. (a -> b) -> a -> b
$ ChannelRequestData -> [Stored (Signed IdentityData)]
crPeers (ChannelRequestData -> [Stored (Signed IdentityData)])
-> ChannelRequestData -> [Stored (Signed IdentityData)]
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequestData -> ChannelRequestData
forall a. Stored a -> a
fromStored (Stored ChannelRequestData -> ChannelRequestData)
-> Stored ChannelRequestData -> ChannelRequestData
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> Stored ChannelRequestData
forall a. Signed a -> Stored a
signedData (ChannelRequest -> Stored ChannelRequestData)
-> ChannelRequest -> Stored ChannelRequestData
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req of
        Maybe [UnifiedIdentity]
Nothing -> String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"invalid peers in channel request"
        Just [UnifiedIdentity]
peers -> do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (UnifiedIdentity -> Bool) -> [UnifiedIdentity] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UnifiedIdentity
self UnifiedIdentity -> UnifiedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity`) [UnifiedIdentity]
peers) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"self identity missing in channel request peers"
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (UnifiedIdentity -> Bool) -> [UnifiedIdentity] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UnifiedIdentity
peer UnifiedIdentity -> UnifiedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity`) [UnifiedIdentity]
peers) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"peer identity missing in channel request peers"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UnifiedIdentity -> Stored PublicKey
forall (m :: * -> *). Identity m -> Stored PublicKey
idKeyMessage UnifiedIdentity
peer Stored PublicKey -> [Stored PublicKey] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((Stored Signature -> Stored PublicKey)
-> [Stored Signature] -> [Stored PublicKey]
forall a b. (a -> b) -> [a] -> [b]
map (Signature -> Stored PublicKey
sigKey (Signature -> Stored PublicKey)
-> (Stored Signature -> Signature)
-> Stored Signature
-> Stored PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored Signature -> Signature
forall a. Stored a -> a
fromStored) ([Stored Signature] -> [Stored PublicKey])
-> [Stored Signature] -> [Stored PublicKey]
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> [Stored Signature]
forall a. Signed a -> [Stored Signature]
signedSignature (ChannelRequest -> [Stored Signature])
-> ChannelRequest -> [Stored Signature]
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"channel requent not signed by peer"

    (SecretKexKey
xsecret, Stored PublicKexKey
xpublic) <- IO (SecretKexKey, Stored PublicKexKey)
-> m (SecretKexKey, Stored PublicKexKey)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SecretKexKey, Stored PublicKexKey)
 -> m (SecretKexKey, Stored PublicKexKey))
-> (Storage -> IO (SecretKexKey, Stored PublicKexKey))
-> Storage
-> m (SecretKexKey, Stored PublicKexKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Storage -> IO (SecretKexKey, Stored PublicKexKey)
forall sec pub. KeyPair sec pub => Storage -> IO (sec, Stored pub)
generateKeys (Storage -> m (SecretKexKey, Stored PublicKexKey))
-> m Storage -> m (SecretKexKey, Stored PublicKexKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Storage
forall (m :: * -> *). MonadStorage m => m Storage
getStorage
    SecretKey
skey <- Stored PublicKey -> m SecretKey
forall sec pub (m :: * -> *).
(KeyPair sec pub, MonadIO m, MonadError String m) =>
Stored pub -> m sec
loadKey (Stored PublicKey -> m SecretKey)
-> Stored PublicKey -> m SecretKey
forall a b. (a -> b) -> a -> b
$ UnifiedIdentity -> Stored PublicKey
forall (m :: * -> *). Identity m -> Stored PublicKey
idKeyMessage UnifiedIdentity
self
    Stored ChannelAccept
acc <- ChannelAccept -> m (Stored ChannelAccept)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore (ChannelAccept -> m (Stored ChannelAccept))
-> m ChannelAccept -> m (Stored ChannelAccept)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SecretKey -> Stored ChannelAcceptData -> m ChannelAccept
forall (m :: * -> *) a.
MonadStorage m =>
SecretKey -> Stored a -> m (Signed a)
sign SecretKey
skey (Stored ChannelAcceptData -> m ChannelAccept)
-> m (Stored ChannelAcceptData) -> m ChannelAccept
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChannelAcceptData -> m (Stored ChannelAcceptData)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChannelAccept { caRequest :: Stored ChannelRequest
caRequest = Stored ChannelRequest
req, caKey :: Stored PublicKexKey
caKey = Stored PublicKexKey
xpublic }
    IO (Stored ChannelAccept, Channel)
-> m (Stored ChannelAccept, Channel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Stored ChannelAccept, Channel)
 -> m (Stored ChannelAccept, Channel))
-> IO (Stored ChannelAccept, Channel)
-> m (Stored ChannelAccept, Channel)
forall a b. (a -> b) -> a -> b
$ do
        let chPeers :: [Stored (Signed IdentityData)]
chPeers = ChannelRequestData -> [Stored (Signed IdentityData)]
crPeers (ChannelRequestData -> [Stored (Signed IdentityData)])
-> ChannelRequestData -> [Stored (Signed IdentityData)]
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequestData -> ChannelRequestData
forall a. Stored a -> a
fromStored (Stored ChannelRequestData -> ChannelRequestData)
-> Stored ChannelRequestData -> ChannelRequestData
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> Stored ChannelRequestData
forall a. Signed a -> Stored a
signedData (ChannelRequest -> Stored ChannelRequestData)
-> ChannelRequest -> Stored ChannelRequestData
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req
            chKey :: ScrubbedBytes
chKey = Int -> ScrubbedBytes -> ScrubbedBytes
forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
keySize (ScrubbedBytes -> ScrubbedBytes) -> ScrubbedBytes -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ SecretKexKey -> PublicKexKey -> ScrubbedBytes
dhSecret SecretKexKey
xsecret (PublicKexKey -> ScrubbedBytes) -> PublicKexKey -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$
                Stored PublicKexKey -> PublicKexKey
forall a. Stored a -> a
fromStored (Stored PublicKexKey -> PublicKexKey)
-> Stored PublicKexKey -> PublicKexKey
forall a b. (a -> b) -> a -> b
$ ChannelRequestData -> Stored PublicKexKey
crKey (ChannelRequestData -> Stored PublicKexKey)
-> ChannelRequestData -> Stored PublicKexKey
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequestData -> ChannelRequestData
forall a. Stored a -> a
fromStored (Stored ChannelRequestData -> ChannelRequestData)
-> Stored ChannelRequestData -> ChannelRequestData
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> Stored ChannelRequestData
forall a. Signed a -> Stored a
signedData (ChannelRequest -> Stored ChannelRequestData)
-> ChannelRequest -> Stored ChannelRequestData
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req
            chNonceFixedOur :: Bytes
chNonceFixedOur  = [Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
BA.pack [ Word8
2, Word8
0, Word8
0, Word8
0 ]
            chNonceFixedPeer :: Bytes
chNonceFixedPeer = [Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
BA.pack [ Word8
1, Word8
0, Word8
0, Word8
0 ]
        MVar Word64
chCounterNextOut <- Word64 -> IO (MVar Word64)
forall a. a -> IO (MVar a)
newMVar Word64
0
        MVar Word64
chCounterNextIn <- Word64 -> IO (MVar Word64)
forall a. a -> IO (MVar a)
newMVar Word64
0

        (Stored ChannelAccept, Channel)
-> IO (Stored ChannelAccept, Channel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stored ChannelAccept
acc, Channel {[Stored (Signed IdentityData)]
MVar Word64
ScrubbedBytes
Bytes
chPeers :: [Stored (Signed IdentityData)]
chKey :: ScrubbedBytes
chNonceFixedOur :: Bytes
chNonceFixedPeer :: Bytes
chCounterNextOut :: MVar Word64
chCounterNextIn :: MVar Word64
chPeers :: [Stored (Signed IdentityData)]
chKey :: ScrubbedBytes
chNonceFixedOur :: Bytes
chNonceFixedPeer :: Bytes
chCounterNextOut :: MVar Word64
chCounterNextIn :: MVar Word64
..})

acceptedChannel :: (MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelAccept -> m Channel
acceptedChannel :: forall (m :: * -> *).
(MonadIO m, MonadError String m) =>
UnifiedIdentity
-> UnifiedIdentity -> Stored ChannelAccept -> m Channel
acceptedChannel UnifiedIdentity
self UnifiedIdentity
peer Stored ChannelAccept
acc = do
    let req :: Stored ChannelRequest
req = ChannelAcceptData -> Stored ChannelRequest
caRequest (ChannelAcceptData -> Stored ChannelRequest)
-> ChannelAcceptData -> Stored ChannelRequest
forall a b. (a -> b) -> a -> b
$ Stored ChannelAcceptData -> ChannelAcceptData
forall a. Stored a -> a
fromStored (Stored ChannelAcceptData -> ChannelAcceptData)
-> Stored ChannelAcceptData -> ChannelAcceptData
forall a b. (a -> b) -> a -> b
$ ChannelAccept -> Stored ChannelAcceptData
forall a. Signed a -> Stored a
signedData (ChannelAccept -> Stored ChannelAcceptData)
-> ChannelAccept -> Stored ChannelAcceptData
forall a b. (a -> b) -> a -> b
$ Stored ChannelAccept -> ChannelAccept
forall a. Stored a -> a
fromStored Stored ChannelAccept
acc
    case [Maybe UnifiedIdentity] -> Maybe [UnifiedIdentity]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Maybe UnifiedIdentity] -> Maybe [UnifiedIdentity])
-> [Maybe UnifiedIdentity] -> Maybe [UnifiedIdentity]
forall a b. (a -> b) -> a -> b
$ (Stored (Signed IdentityData) -> Maybe UnifiedIdentity)
-> [Stored (Signed IdentityData)] -> [Maybe UnifiedIdentity]
forall a b. (a -> b) -> [a] -> [b]
map Stored (Signed IdentityData) -> Maybe UnifiedIdentity
validateIdentity ([Stored (Signed IdentityData)] -> [Maybe UnifiedIdentity])
-> [Stored (Signed IdentityData)] -> [Maybe UnifiedIdentity]
forall a b. (a -> b) -> a -> b
$ ChannelRequestData -> [Stored (Signed IdentityData)]
crPeers (ChannelRequestData -> [Stored (Signed IdentityData)])
-> ChannelRequestData -> [Stored (Signed IdentityData)]
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequestData -> ChannelRequestData
forall a. Stored a -> a
fromStored (Stored ChannelRequestData -> ChannelRequestData)
-> Stored ChannelRequestData -> ChannelRequestData
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> Stored ChannelRequestData
forall a. Signed a -> Stored a
signedData (ChannelRequest -> Stored ChannelRequestData)
-> ChannelRequest -> Stored ChannelRequestData
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req of
        Maybe [UnifiedIdentity]
Nothing -> String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"invalid peers in channel accept"
        Just [UnifiedIdentity]
peers -> do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (UnifiedIdentity -> Bool) -> [UnifiedIdentity] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UnifiedIdentity
self UnifiedIdentity -> UnifiedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity`) [UnifiedIdentity]
peers) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"self identity missing in channel accept peers"
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (UnifiedIdentity -> Bool) -> [UnifiedIdentity] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UnifiedIdentity
peer UnifiedIdentity -> UnifiedIdentity -> Bool
forall (m :: * -> *) (m' :: * -> *).
(Foldable m, Foldable m') =>
Identity m -> Identity m' -> Bool
`sameIdentity`) [UnifiedIdentity]
peers) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"peer identity missing in channel accept peers"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UnifiedIdentity -> Stored PublicKey
forall (m :: * -> *). Identity m -> Stored PublicKey
idKeyMessage UnifiedIdentity
peer Stored PublicKey -> [Stored PublicKey] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((Stored Signature -> Stored PublicKey)
-> [Stored Signature] -> [Stored PublicKey]
forall a b. (a -> b) -> [a] -> [b]
map (Signature -> Stored PublicKey
sigKey (Signature -> Stored PublicKey)
-> (Stored Signature -> Signature)
-> Stored Signature
-> Stored PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored Signature -> Signature
forall a. Stored a -> a
fromStored) ([Stored Signature] -> [Stored PublicKey])
-> [Stored Signature] -> [Stored PublicKey]
forall a b. (a -> b) -> a -> b
$ ChannelAccept -> [Stored Signature]
forall a. Signed a -> [Stored Signature]
signedSignature (ChannelAccept -> [Stored Signature])
-> ChannelAccept -> [Stored Signature]
forall a b. (a -> b) -> a -> b
$ Stored ChannelAccept -> ChannelAccept
forall a. Stored a -> a
fromStored Stored ChannelAccept
acc)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"channel accept not signed by peer"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UnifiedIdentity -> Stored PublicKey
forall (m :: * -> *). Identity m -> Stored PublicKey
idKeyMessage UnifiedIdentity
self Stored PublicKey -> [Stored PublicKey] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((Stored Signature -> Stored PublicKey)
-> [Stored Signature] -> [Stored PublicKey]
forall a b. (a -> b) -> [a] -> [b]
map (Signature -> Stored PublicKey
sigKey (Signature -> Stored PublicKey)
-> (Stored Signature -> Signature)
-> Stored Signature
-> Stored PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored Signature -> Signature
forall a. Stored a -> a
fromStored) ([Stored Signature] -> [Stored PublicKey])
-> [Stored Signature] -> [Stored PublicKey]
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> [Stored Signature]
forall a. Signed a -> [Stored Signature]
signedSignature (ChannelRequest -> [Stored Signature])
-> ChannelRequest -> [Stored Signature]
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"original channel request not signed by us"

    SecretKexKey
xsecret <- Stored PublicKexKey -> m SecretKexKey
forall sec pub (m :: * -> *).
(KeyPair sec pub, MonadIO m, MonadError String m) =>
Stored pub -> m sec
loadKey (Stored PublicKexKey -> m SecretKexKey)
-> Stored PublicKexKey -> m SecretKexKey
forall a b. (a -> b) -> a -> b
$ ChannelRequestData -> Stored PublicKexKey
crKey (ChannelRequestData -> Stored PublicKexKey)
-> ChannelRequestData -> Stored PublicKexKey
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequestData -> ChannelRequestData
forall a. Stored a -> a
fromStored (Stored ChannelRequestData -> ChannelRequestData)
-> Stored ChannelRequestData -> ChannelRequestData
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> Stored ChannelRequestData
forall a. Signed a -> Stored a
signedData (ChannelRequest -> Stored ChannelRequestData)
-> ChannelRequest -> Stored ChannelRequestData
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req
    let chPeers :: [Stored (Signed IdentityData)]
chPeers = ChannelRequestData -> [Stored (Signed IdentityData)]
crPeers (ChannelRequestData -> [Stored (Signed IdentityData)])
-> ChannelRequestData -> [Stored (Signed IdentityData)]
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequestData -> ChannelRequestData
forall a. Stored a -> a
fromStored (Stored ChannelRequestData -> ChannelRequestData)
-> Stored ChannelRequestData -> ChannelRequestData
forall a b. (a -> b) -> a -> b
$ ChannelRequest -> Stored ChannelRequestData
forall a. Signed a -> Stored a
signedData (ChannelRequest -> Stored ChannelRequestData)
-> ChannelRequest -> Stored ChannelRequestData
forall a b. (a -> b) -> a -> b
$ Stored ChannelRequest -> ChannelRequest
forall a. Stored a -> a
fromStored Stored ChannelRequest
req
        chKey :: ScrubbedBytes
chKey = Int -> ScrubbedBytes -> ScrubbedBytes
forall bs. ByteArray bs => Int -> bs -> bs
BA.take Int
keySize (ScrubbedBytes -> ScrubbedBytes) -> ScrubbedBytes -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ SecretKexKey -> PublicKexKey -> ScrubbedBytes
dhSecret SecretKexKey
xsecret (PublicKexKey -> ScrubbedBytes) -> PublicKexKey -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$
            Stored PublicKexKey -> PublicKexKey
forall a. Stored a -> a
fromStored (Stored PublicKexKey -> PublicKexKey)
-> Stored PublicKexKey -> PublicKexKey
forall a b. (a -> b) -> a -> b
$ ChannelAcceptData -> Stored PublicKexKey
caKey (ChannelAcceptData -> Stored PublicKexKey)
-> ChannelAcceptData -> Stored PublicKexKey
forall a b. (a -> b) -> a -> b
$ Stored ChannelAcceptData -> ChannelAcceptData
forall a. Stored a -> a
fromStored (Stored ChannelAcceptData -> ChannelAcceptData)
-> Stored ChannelAcceptData -> ChannelAcceptData
forall a b. (a -> b) -> a -> b
$ ChannelAccept -> Stored ChannelAcceptData
forall a. Signed a -> Stored a
signedData (ChannelAccept -> Stored ChannelAcceptData)
-> ChannelAccept -> Stored ChannelAcceptData
forall a b. (a -> b) -> a -> b
$ Stored ChannelAccept -> ChannelAccept
forall a. Stored a -> a
fromStored Stored ChannelAccept
acc
        chNonceFixedOur :: Bytes
chNonceFixedOur  = [Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
BA.pack [ Word8
1, Word8
0, Word8
0, Word8
0 ]
        chNonceFixedPeer :: Bytes
chNonceFixedPeer = [Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
BA.pack [ Word8
2, Word8
0, Word8
0, Word8
0 ]
    MVar Word64
chCounterNextOut <- IO (MVar Word64) -> m (MVar Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar Word64) -> m (MVar Word64))
-> IO (MVar Word64) -> m (MVar Word64)
forall a b. (a -> b) -> a -> b
$ Word64 -> IO (MVar Word64)
forall a. a -> IO (MVar a)
newMVar Word64
0
    MVar Word64
chCounterNextIn <- IO (MVar Word64) -> m (MVar Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar Word64) -> m (MVar Word64))
-> IO (MVar Word64) -> m (MVar Word64)
forall a b. (a -> b) -> a -> b
$ Word64 -> IO (MVar Word64)
forall a. a -> IO (MVar a)
newMVar Word64
0

    Channel -> m Channel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Channel {[Stored (Signed IdentityData)]
MVar Word64
ScrubbedBytes
Bytes
chPeers :: [Stored (Signed IdentityData)]
chKey :: ScrubbedBytes
chNonceFixedOur :: Bytes
chNonceFixedPeer :: Bytes
chCounterNextOut :: MVar Word64
chCounterNextIn :: MVar Word64
chPeers :: [Stored (Signed IdentityData)]
chKey :: ScrubbedBytes
chNonceFixedOur :: Bytes
chNonceFixedPeer :: Bytes
chCounterNextOut :: MVar Word64
chCounterNextIn :: MVar Word64
..}


channelEncrypt :: (ByteArray ba, MonadIO m, MonadError String m) => Channel -> ba -> m (ba, Word64)
channelEncrypt :: forall ba (m :: * -> *).
(ByteArray ba, MonadIO m, MonadError String m) =>
Channel -> ba -> m (ba, Word64)
channelEncrypt Channel {[Stored (Signed IdentityData)]
MVar Word64
ScrubbedBytes
Bytes
chPeers :: Channel -> [Stored (Signed IdentityData)]
chKey :: Channel -> ScrubbedBytes
chNonceFixedOur :: Channel -> Bytes
chNonceFixedPeer :: Channel -> Bytes
chCounterNextOut :: Channel -> MVar Word64
chCounterNextIn :: Channel -> MVar Word64
chPeers :: [Stored (Signed IdentityData)]
chKey :: ScrubbedBytes
chNonceFixedOur :: Bytes
chNonceFixedPeer :: Bytes
chCounterNextOut :: MVar Word64
chCounterNextIn :: MVar Word64
..} ba
plain = do
    Word64
count <- IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ MVar Word64 -> (Word64 -> IO (Word64, Word64)) -> IO Word64
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar Word64
chCounterNextOut ((Word64 -> IO (Word64, Word64)) -> IO Word64)
-> (Word64 -> IO (Word64, Word64)) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Word64
c -> (Word64, Word64) -> IO (Word64, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
c Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1, Word64
c)
    let cbytes :: Bytes
cbytes = ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> Bytes) -> ByteString -> Bytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
forall a. Binary a => a -> ByteString
encode Word64
count
        nonce :: CryptoFailable Nonce
nonce = Bytes -> Bytes -> CryptoFailable Nonce
forall ba. ByteArrayAccess ba => ba -> ba -> CryptoFailable Nonce
nonce8 Bytes
chNonceFixedOur Bytes
cbytes
    State
state <- case ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
initialize ScrubbedBytes
chKey (Nonce -> CryptoFailable State)
-> CryptoFailable Nonce -> CryptoFailable State
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CryptoFailable Nonce
nonce of
        CryptoPassed State
state -> State -> m State
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return State
state
        CryptoFailed CryptoError
err -> String -> m State
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m State) -> String -> m State
forall a b. (a -> b) -> a -> b
$ String
"failed to init chacha-poly1305 cipher: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CryptoError -> String
forall a. Show a => a -> String
show CryptoError
err

    let (ba
ctext, State
state') = ba -> State -> (ba, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
encrypt ba
plain State
state
        tag :: Auth
tag = State -> Auth
finalize State
state'
    (ba, Word64) -> m (ba, Word64)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ba] -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat [ Bytes -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes -> ba) -> Bytes -> ba
forall a b. (a -> b) -> a -> b
$ Int -> Bytes -> Bytes
forall bs. ByteArray bs => Int -> bs -> bs
BA.drop Int
7 Bytes
cbytes, ba
ctext, Auth -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Auth
tag ], Word64
count)

channelDecrypt :: (ByteArray ba, MonadIO m, MonadError String m) => Channel -> ba -> m (ba, Word64)
channelDecrypt :: forall ba (m :: * -> *).
(ByteArray ba, MonadIO m, MonadError String m) =>
Channel -> ba -> m (ba, Word64)
channelDecrypt Channel {[Stored (Signed IdentityData)]
MVar Word64
ScrubbedBytes
Bytes
chPeers :: Channel -> [Stored (Signed IdentityData)]
chKey :: Channel -> ScrubbedBytes
chNonceFixedOur :: Channel -> Bytes
chNonceFixedPeer :: Channel -> Bytes
chCounterNextOut :: Channel -> MVar Word64
chCounterNextIn :: Channel -> MVar Word64
chPeers :: [Stored (Signed IdentityData)]
chKey :: ScrubbedBytes
chNonceFixedOur :: Bytes
chNonceFixedPeer :: Bytes
chCounterNextOut :: MVar Word64
chCounterNextIn :: MVar Word64
..} ba
body = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
body Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
17) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"invalid encrypted data length"

    Word64
expectedCount <- IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ MVar Word64 -> IO Word64
forall a. MVar a -> IO a
readMVar MVar Word64
chCounterNextIn
    let countByte :: Word8
countByte = ba
body ba -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
`BA.index` Int
0
        body' :: View ba
body' = ba -> Int -> View ba
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
BA.dropView ba
body Int
1
        guessedCount :: Word64
guessedCount = Word64
expectedCount Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
128 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
countByte Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
expectedCount Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
128 :: Word8)
        nonce :: CryptoFailable Nonce
nonce = Bytes -> Bytes -> CryptoFailable Nonce
forall ba. ByteArrayAccess ba => ba -> ba -> CryptoFailable Nonce
nonce8 Bytes
chNonceFixedPeer (Bytes -> CryptoFailable Nonce) -> Bytes -> CryptoFailable Nonce
forall a b. (a -> b) -> a -> b
$ ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> Bytes) -> ByteString -> Bytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
forall a. Binary a => a -> ByteString
encode Word64
guessedCount
        blen :: Int
blen = View ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length View ba
body' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16
        ctext :: View (View ba)
ctext = View ba -> Int -> View (View ba)
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
BA.takeView View ba
body' Int
blen
        tag :: View (View ba)
tag = View ba -> Int -> View (View ba)
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
BA.dropView View ba
body' Int
blen
    State
state <- case ScrubbedBytes -> Nonce -> CryptoFailable State
forall key.
ByteArrayAccess key =>
key -> Nonce -> CryptoFailable State
initialize ScrubbedBytes
chKey (Nonce -> CryptoFailable State)
-> CryptoFailable Nonce -> CryptoFailable State
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CryptoFailable Nonce
nonce of
        CryptoPassed State
state -> State -> m State
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return State
state
        CryptoFailed CryptoError
err -> String -> m State
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m State) -> String -> m State
forall a b. (a -> b) -> a -> b
$ String
"failed to init chacha-poly1305 cipher: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CryptoError -> String
forall a. Show a => a -> String
show CryptoError
err

    let (ba
plain, State
state') = ba -> State -> (ba, State)
forall ba. ByteArray ba => ba -> State -> (ba, State)
decrypt (View (View ba) -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert View (View ba)
ctext) State
state
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ View (View ba)
tag View (View ba) -> Auth -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`BA.constEq` State -> Auth
finalize State
state') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"tag validation falied"

    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar Word64 -> (Word64 -> IO Word64) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Word64
chCounterNextIn ((Word64 -> IO Word64) -> IO ()) -> (Word64 -> IO Word64) -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> (Word64 -> Word64) -> Word64 -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max (Word64
guessedCount Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
    (ba, Word64) -> m (ba, Word64)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ba
plain, Word64
guessedCount)