{-# LINE 1 "src/System/CryptoBox.hsc" #-}
-- Copyright (C) 2015 Wire Swiss GmbH <support@wire.com>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE ForeignFunctionInterface   #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections              #-}

module System.CryptoBox
    ( Result    (..)
    , SID       (..)
    , Prekey    (..)
    , PrekeyId  (..)
    , Vector
    , Box
    , Session
    , withVector
    , copyBytes
    , open
    , newPrekey
    , isPrekey
    , session
    , sessionFromPrekey
    , sessionFromMessage
    , close
    , save
    , delete
    , encrypt
    , decrypt
    , remoteFingerprint
    , localFingerprint
    , randomBytes
    ) where

import Control.Applicative
import Control.Concurrent
import Control.Exception (finally)
import Data.ByteString (ByteString)
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import Data.IORef
import Foreign hiding (void, copyBytes)
import Foreign.C
import Prelude

import qualified Data.ByteString        as Bytes
import qualified Data.ByteString.Unsafe as Bytes
import qualified Data.HashMap.Strict    as Map



data Result a
    = Success !a
    | StorageError
    | NoSession
    | DecodeError
    | RemoteIdentityChanged
    | InvalidSignature
    | InvalidMessage
    | DuplicateMessage
    | TooDistantFuture
    | OutdatedMessage
    | Utf8Error
    | NulError
    | EncodeError
    | IdentityError
    | NoPrekey
    | Panic
    | Unknown !Int
    deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
/= :: Result a -> Result a -> Bool
Eq, Eq (Result a)
Eq (Result a) =>
(Result a -> Result a -> Ordering)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Result a)
-> (Result a -> Result a -> Result a)
-> Ord (Result a)
Result a -> Result a -> Bool
Result a -> Result a -> Ordering
Result a -> Result a -> Result a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Result a)
forall a. Ord a => Result a -> Result a -> Bool
forall a. Ord a => Result a -> Result a -> Ordering
forall a. Ord a => Result a -> Result a -> Result a
$ccompare :: forall a. Ord a => Result a -> Result a -> Ordering
compare :: Result a -> Result a -> Ordering
$c< :: forall a. Ord a => Result a -> Result a -> Bool
< :: Result a -> Result a -> Bool
$c<= :: forall a. Ord a => Result a -> Result a -> Bool
<= :: Result a -> Result a -> Bool
$c> :: forall a. Ord a => Result a -> Result a -> Bool
> :: Result a -> Result a -> Bool
$c>= :: forall a. Ord a => Result a -> Result a -> Bool
>= :: Result a -> Result a -> Bool
$cmax :: forall a. Ord a => Result a -> Result a -> Result a
max :: Result a -> Result a -> Result a
$cmin :: forall a. Ord a => Result a -> Result a -> Result a
min :: Result a -> Result a -> Result a
Ord, Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
showsPrec :: Int -> Result a -> ShowS
$cshow :: forall a. Show a => Result a -> String
show :: Result a -> String
$cshowList :: forall a. Show a => [Result a] -> ShowS
showList :: [Result a] -> ShowS
Show, (forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
fmap :: forall a b. (a -> b) -> Result a -> Result b
$c<$ :: forall a b. a -> Result b -> Result a
<$ :: forall a b. a -> Result b -> Result a
Functor)

data Box = Box
    { Box -> IORef (HashMap SID Session)
sessions  :: !(IORef (HashMap SID Session))
    , Box -> MVar ()
cboxmutex :: !(MVar ())
    , Box -> ForeignPtr ()
cboxptr   :: !(ForeignPtr ())
    }

data Session = Session
    { Session -> SID
sessid    :: !SID
    , Session -> MVar ()
sessmutex :: !(MVar ())
    , Session -> ForeignPtr ()
sessptr   :: !(ForeignPtr ())
    }

newtype Vector   = Vector   { Vector -> ForeignPtr ()
vec      :: ForeignPtr () }
newtype Prekey   = Prekey   { Prekey -> Vector
prekey   :: Vector        }
newtype PrekeyId = PrekeyId { PrekeyId -> Word16
prekeyId :: Word16        }
newtype SID      = SID      { SID -> ByteString
sid      :: ByteString    } deriving (SID -> SID -> Bool
(SID -> SID -> Bool) -> (SID -> SID -> Bool) -> Eq SID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SID -> SID -> Bool
== :: SID -> SID -> Bool
$c/= :: SID -> SID -> Bool
/= :: SID -> SID -> Bool
Eq, Eq SID
Eq SID => (Int -> SID -> Int) -> (SID -> Int) -> Hashable SID
Int -> SID -> Int
SID -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SID -> Int
hashWithSalt :: Int -> SID -> Int
$chash :: SID -> Int
hash :: SID -> Int
Hashable)

instance Show Vector  where show :: Vector -> String
show = String -> Vector -> String
forall a b. a -> b -> a
const String
"Vector"
instance Show Box     where show :: Box -> String
show = String -> Box -> String
forall a b. a -> b -> a
const String
"Box"
instance Show Prekey  where show :: Prekey -> String
show = String -> Prekey -> String
forall a b. a -> b -> a
const String
"Prekey"
instance Show Session where show :: Session -> String
show = String -> Session -> String
forall a b. a -> b -> a
const String
"Session"
instance Show SID     where show :: SID -> String
show = String -> SID -> String
forall a b. a -> b -> a
const String
"SID"

open :: FilePath -> IO (Result Box)
open :: String -> IO (Result Box)
open String
p = String -> (CString -> IO (Result Box)) -> IO (Result Box)
forall a. String -> (CString -> IO a) -> IO a
withCString String
p ((CString -> IO (Result Box)) -> IO (Result Box))
-> (CString -> IO (Result Box)) -> IO (Result Box)
forall a b. (a -> b) -> a -> b
$ \CString
cs  ->
    (Ptr CBoxVec -> IO (Result Box)) -> IO (Result Box)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CBoxVec -> IO (Result Box)) -> IO (Result Box))
-> (Ptr CBoxVec -> IO (Result Box)) -> IO (Result Box)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
ptr ->
    IO CInt -> IO Box -> IO (Result Box)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CString -> Ptr CBoxVec -> IO CInt
cbox_file_open CString
cs Ptr CBoxVec
ptr) (IO Box -> IO (Result Box)) -> IO Box -> IO (Result Box)
forall a b. (a -> b) -> a -> b
$
        IORef (HashMap SID Session) -> MVar () -> ForeignPtr () -> Box
Box (IORef (HashMap SID Session) -> MVar () -> ForeignPtr () -> Box)
-> IO (IORef (HashMap SID Session))
-> IO (MVar () -> ForeignPtr () -> Box)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap SID Session -> IO (IORef (HashMap SID Session))
forall a. a -> IO (IORef a)
newIORef HashMap SID Session
forall k v. HashMap k v
Map.empty
            IO (MVar () -> ForeignPtr () -> Box)
-> IO (MVar ()) -> IO (ForeignPtr () -> Box)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
            IO (ForeignPtr () -> Box) -> IO (ForeignPtr ()) -> IO Box
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FinalizerPtr () -> CBoxVec -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
cbox_close (CBoxVec -> IO (ForeignPtr ())) -> IO CBoxVec -> IO (ForeignPtr ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
ptr)

newPrekey :: Box -> Word16 -> IO (Result Prekey)
newPrekey :: Box -> Word16 -> IO (Result Prekey)
newPrekey Box
b Word16
i = MVar () -> IO (Result Prekey) -> IO (Result Prekey)
forall a. MVar () -> IO a -> IO a
withMutex (Box -> MVar ()
cboxmutex Box
b) (IO (Result Prekey) -> IO (Result Prekey))
-> IO (Result Prekey) -> IO (Result Prekey)
forall a b. (a -> b) -> a -> b
$
    Box -> (CBoxVec -> IO (Result Prekey)) -> IO (Result Prekey)
forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b ((CBoxVec -> IO (Result Prekey)) -> IO (Result Prekey))
-> (CBoxVec -> IO (Result Prekey)) -> IO (Result Prekey)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
cb ->
    (Ptr CBoxVec -> IO (Result Prekey)) -> IO (Result Prekey)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca          ((Ptr CBoxVec -> IO (Result Prekey)) -> IO (Result Prekey))
-> (Ptr CBoxVec -> IO (Result Prekey)) -> IO (Result Prekey)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
v ->
    IO CInt -> IO Prekey -> IO (Result Prekey)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> CUShort -> Ptr CBoxVec -> IO CInt
cbox_new_prekey CBoxVec
cb (Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i) Ptr CBoxVec
v) (IO Prekey -> IO (Result Prekey))
-> IO Prekey -> IO (Result Prekey)
forall a b. (a -> b) -> a -> b
$
        Vector -> Prekey
Prekey (Vector -> Prekey) -> IO Vector -> IO Prekey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CBoxVec -> IO Vector
newVector (CBoxVec -> IO Vector) -> IO CBoxVec -> IO Vector
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
v)

randomBytes :: Box -> Word32 -> IO (Result Vector)
randomBytes :: Box -> Word32 -> IO (Result Vector)
randomBytes Box
b Word32
n = Box -> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b ((CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
cb -> -- No need for mutex.
    (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
v ->
    IO CInt -> IO Vector -> IO (Result Vector)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> CUInt -> Ptr CBoxVec -> IO CInt
cbox_random_bytes CBoxVec
cb (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n) Ptr CBoxVec
v) (IO Vector -> IO (Result Vector))
-> IO Vector -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$
        CBoxVec -> IO Vector
newVector (CBoxVec -> IO Vector) -> IO CBoxVec -> IO Vector
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
v

session :: Box -> SID -> IO (Result Session)
session :: Box -> SID -> IO (Result Session)
session Box
b SID
i = MVar () -> IO (Result Session) -> IO (Result Session)
forall a. MVar () -> IO a -> IO a
withMutex (Box -> MVar ()
cboxmutex Box
b) (IO (Result Session) -> IO (Result Session))
-> IO (Result Session) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$
    IO (Result Session)
-> (Session -> IO (Result Session))
-> Maybe Session
-> IO (Result Session)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Result Session)
fresh (Result Session -> IO (Result Session)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Session -> IO (Result Session))
-> (Session -> Result Session) -> Session -> IO (Result Session)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> Result Session
forall a. a -> Result a
Success) (Maybe Session -> IO (Result Session))
-> IO (Maybe Session) -> IO (Result Session)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SID -> HashMap SID Session -> Maybe Session
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup SID
i (HashMap SID Session -> Maybe Session)
-> IO (HashMap SID Session) -> IO (Maybe Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (HashMap SID Session) -> IO (HashMap SID Session)
forall a. IORef a -> IO a
readIORef (Box -> IORef (HashMap SID Session)
sessions Box
b)
  where
    fresh :: IO (Result Session)
fresh = Box -> (CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b        ((CBoxVec -> IO (Result Session)) -> IO (Result Session))
-> (CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
cb ->
        ByteString
-> (CString -> IO (Result Session)) -> IO (Result Session)
forall a. ByteString -> (CString -> IO a) -> IO a
Bytes.useAsCString (SID -> ByteString
sid SID
i) ((CString -> IO (Result Session)) -> IO (Result Session))
-> (CString -> IO (Result Session)) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ \CString
ip ->
        (Ptr CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca                     ((Ptr CBoxVec -> IO (Result Session)) -> IO (Result Session))
-> (Ptr CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
sp ->
        IO CInt -> IO Session -> IO (Result Session)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> CString -> Ptr CBoxVec -> IO CInt
cbox_session_load CBoxVec
cb CString
ip Ptr CBoxVec
sp) (IO Session -> IO (Result Session))
-> IO Session -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ do
            Session
s <- SID -> MVar () -> ForeignPtr () -> Session
Session SID
i (MVar () -> ForeignPtr () -> Session)
-> IO (MVar ()) -> IO (ForeignPtr () -> Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar () IO (ForeignPtr () -> Session) -> IO (ForeignPtr ()) -> IO Session
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FinalizerPtr () -> CBoxVec -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
cbox_session_close (CBoxVec -> IO (ForeignPtr ())) -> IO CBoxVec -> IO (ForeignPtr ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
sp)
            IORef (HashMap SID Session)
-> (HashMap SID Session -> HashMap SID Session) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (Box -> IORef (HashMap SID Session)
sessions Box
b) (SID -> Session -> HashMap SID Session -> HashMap SID Session
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert SID
i Session
s)
            Session -> IO Session
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Session
s

close :: Box -> Session -> IO ()
close :: Box -> Session -> IO ()
close Box
b Session
s = MVar () -> IO () -> IO ()
forall a. MVar () -> IO a -> IO a
withMutex (Box -> MVar ()
cboxmutex Box
b) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IORef (HashMap SID Session)
-> (HashMap SID Session -> HashMap SID Session) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (Box -> IORef (HashMap SID Session)
sessions Box
b) (SID -> HashMap SID Session -> HashMap SID Session
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
Map.delete (Session -> SID
sessid Session
s))
        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally`
    MVar () -> IO () -> IO ()
forall a. MVar () -> IO a -> IO a
withMutex (Session -> MVar ()
sessmutex Session
s) (ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr (Session -> ForeignPtr ()
sessptr Session
s))

delete :: Box -> SID -> IO (Result ())
delete :: Box -> SID -> IO (Result ())
delete Box
b SID
i = MVar () -> IO (Result ()) -> IO (Result ())
forall a. MVar () -> IO a -> IO a
withMutex (Box -> MVar ()
cboxmutex Box
b) (IO (Result ()) -> IO (Result ()))
-> IO (Result ()) -> IO (Result ())
forall a b. (a -> b) -> a -> b
$ do
    IORef (HashMap SID Session)
-> (HashMap SID Session -> HashMap SID Session) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (Box -> IORef (HashMap SID Session)
sessions Box
b) (SID -> HashMap SID Session -> HashMap SID Session
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
Map.delete SID
i)
    Box -> (CBoxVec -> IO (Result ())) -> IO (Result ())
forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b ((CBoxVec -> IO (Result ())) -> IO (Result ()))
-> (CBoxVec -> IO (Result ())) -> IO (Result ())
forall a b. (a -> b) -> a -> b
$ \CBoxVec
cb ->
        ByteString -> (CString -> IO (Result ())) -> IO (Result ())
forall a. ByteString -> (CString -> IO a) -> IO a
Bytes.useAsCString (SID -> ByteString
sid SID
i) ((CString -> IO (Result ())) -> IO (Result ()))
-> (CString -> IO (Result ())) -> IO (Result ())
forall a b. (a -> b) -> a -> b
$ \CString
ip ->
        IO CInt -> IO () -> IO (Result ())
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> CString -> IO CInt
cbox_session_delete CBoxVec
cb CString
ip) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

isPrekey :: ByteString -> IO (Result PrekeyId)
isPrekey :: ByteString -> IO (Result PrekeyId)
isPrekey ByteString
b =
    ByteString
-> (CStringLen -> IO (Result PrekeyId)) -> IO (Result PrekeyId)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Bytes.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO (Result PrekeyId)) -> IO (Result PrekeyId))
-> (CStringLen -> IO (Result PrekeyId)) -> IO (Result PrekeyId)
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
    (Ptr Word16 -> IO (Result PrekeyId)) -> IO (Result PrekeyId)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca                        ((Ptr Word16 -> IO (Result PrekeyId)) -> IO (Result PrekeyId))
-> (Ptr Word16 -> IO (Result PrekeyId)) -> IO (Result PrekeyId)
forall a b. (a -> b) -> a -> b
$ \Ptr Word16
result ->
    IO CInt -> IO PrekeyId -> IO (Result PrekeyId)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (Ptr Word8 -> CUInt -> Ptr Word16 -> IO CInt
cbox_is_prekey (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr Word16
result)
        (Word16 -> PrekeyId
PrekeyId (Word16 -> PrekeyId) -> IO Word16 -> IO PrekeyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
result)

sessionFromPrekey :: Box -> SID -> ByteString -> IO (Result Session)
sessionFromPrekey :: Box -> SID -> ByteString -> IO (Result Session)
sessionFromPrekey Box
b SID
i ByteString
p = MVar () -> IO (Result Session) -> IO (Result Session)
forall a. MVar () -> IO a -> IO a
withMutex (Box -> MVar ()
cboxmutex Box
b) (IO (Result Session) -> IO (Result Session))
-> IO (Result Session) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$
    IO (Result Session)
-> (Session -> IO (Result Session))
-> Maybe Session
-> IO (Result Session)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Result Session)
fresh (Result Session -> IO (Result Session)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Session -> IO (Result Session))
-> (Session -> Result Session) -> Session -> IO (Result Session)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session -> Result Session
forall a. a -> Result a
Success) (Maybe Session -> IO (Result Session))
-> IO (Maybe Session) -> IO (Result Session)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SID -> HashMap SID Session -> Maybe Session
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup SID
i (HashMap SID Session -> Maybe Session)
-> IO (HashMap SID Session) -> IO (Maybe Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (HashMap SID Session) -> IO (HashMap SID Session)
forall a. IORef a -> IO a
readIORef (Box -> IORef (HashMap SID Session)
sessions Box
b)
  where
    fresh :: IO (Result Session)
fresh = Box -> (CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b           ((CBoxVec -> IO (Result Session)) -> IO (Result Session))
-> (CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
cb ->
        ByteString
-> (CString -> IO (Result Session)) -> IO (Result Session)
forall a. ByteString -> (CString -> IO a) -> IO a
Bytes.useAsCString (SID -> ByteString
sid SID
i)    ((CString -> IO (Result Session)) -> IO (Result Session))
-> (CString -> IO (Result Session)) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ \CString
ip ->
        ByteString
-> (CStringLen -> IO (Result Session)) -> IO (Result Session)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Bytes.unsafeUseAsCStringLen ByteString
p ((CStringLen -> IO (Result Session)) -> IO (Result Session))
-> (CStringLen -> IO (Result Session)) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ \(CString
pp, Int
pl) ->
        (Ptr CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca                        ((Ptr CBoxVec -> IO (Result Session)) -> IO (Result Session))
-> (Ptr CBoxVec -> IO (Result Session)) -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
sp ->
        IO CInt -> IO Session -> IO (Result Session)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> CString -> CPrekey -> CUInt -> Ptr CBoxVec -> IO CInt
cbox_session_init_from_prekey CBoxVec
cb CString
ip (CString -> CPrekey
forall a b. Ptr a -> Ptr b
castPtr CString
pp) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pl) Ptr CBoxVec
sp) (IO Session -> IO (Result Session))
-> IO Session -> IO (Result Session)
forall a b. (a -> b) -> a -> b
$ do
            MVar ()
m <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
            ForeignPtr ()
x <- FinalizerPtr () -> CBoxVec -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
cbox_session_close (CBoxVec -> IO (ForeignPtr ())) -> IO CBoxVec -> IO (ForeignPtr ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
sp
            Session -> IO Session
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SID -> MVar () -> ForeignPtr () -> Session
Session SID
i MVar ()
m ForeignPtr ()
x)

sessionFromMessage :: Box -> SID -> ByteString -> IO (Result (Session, Vector))
sessionFromMessage :: Box -> SID -> ByteString -> IO (Result (Session, Vector))
sessionFromMessage Box
b SID
i ByteString
m = MVar ()
-> IO (Result (Session, Vector)) -> IO (Result (Session, Vector))
forall a. MVar () -> IO a -> IO a
withMutex (Box -> MVar ()
cboxmutex Box
b) (IO (Result (Session, Vector)) -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector)) -> IO (Result (Session, Vector))
forall a b. (a -> b) -> a -> b
$
    IO (Result (Session, Vector))
-> (Session -> IO (Result (Session, Vector)))
-> Maybe Session
-> IO (Result (Session, Vector))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Result (Session, Vector))
fresh Session -> IO (Result (Session, Vector))
existing (Maybe Session -> IO (Result (Session, Vector)))
-> IO (Maybe Session) -> IO (Result (Session, Vector))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SID -> HashMap SID Session -> Maybe Session
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup SID
i (HashMap SID Session -> Maybe Session)
-> IO (HashMap SID Session) -> IO (Maybe Session)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (HashMap SID Session) -> IO (HashMap SID Session)
forall a. IORef a -> IO a
readIORef (Box -> IORef (HashMap SID Session)
sessions Box
b)
  where
    fresh :: IO (Result (Session, Vector))
fresh = Box
-> (CBoxVec -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b           ((CBoxVec -> IO (Result (Session, Vector)))
 -> IO (Result (Session, Vector)))
-> (CBoxVec -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a b. (a -> b) -> a -> b
$ \CBoxVec
cb ->
        ByteString
-> (CString -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a. ByteString -> (CString -> IO a) -> IO a
Bytes.useAsCString (SID -> ByteString
sid SID
i)    ((CString -> IO (Result (Session, Vector)))
 -> IO (Result (Session, Vector)))
-> (CString -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a b. (a -> b) -> a -> b
$ \CString
ip ->
        ByteString
-> (CStringLen -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Bytes.unsafeUseAsCStringLen ByteString
m ((CStringLen -> IO (Result (Session, Vector)))
 -> IO (Result (Session, Vector)))
-> (CStringLen -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a b. (a -> b) -> a -> b
$ \(CString
pp, Int
pl) ->
        (Ptr CBoxVec -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca                        ((Ptr CBoxVec -> IO (Result (Session, Vector)))
 -> IO (Result (Session, Vector)))
-> (Ptr CBoxVec -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
sp ->
        (Ptr CBoxVec -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca                        ((Ptr CBoxVec -> IO (Result (Session, Vector)))
 -> IO (Result (Session, Vector)))
-> (Ptr CBoxVec -> IO (Result (Session, Vector)))
-> IO (Result (Session, Vector))
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
vp ->
        IO CInt -> IO (Session, Vector) -> IO (Result (Session, Vector))
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec
-> CString
-> CPrekey
-> CUInt
-> Ptr CBoxVec
-> Ptr CBoxVec
-> IO CInt
cbox_session_init_from_message CBoxVec
cb CString
ip (CString -> CPrekey
forall a b. Ptr a -> Ptr b
castPtr CString
pp) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pl) Ptr CBoxVec
sp Ptr CBoxVec
vp) (IO (Session, Vector) -> IO (Result (Session, Vector)))
-> IO (Session, Vector) -> IO (Result (Session, Vector))
forall a b. (a -> b) -> a -> b
$ do
            MVar ()
l <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
            ForeignPtr ()
x <- FinalizerPtr () -> CBoxVec -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
cbox_session_close (CBoxVec -> IO (ForeignPtr ())) -> IO CBoxVec -> IO (ForeignPtr ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
sp
            Vector
v <- CBoxVec -> IO Vector
newVector (CBoxVec -> IO Vector) -> IO CBoxVec -> IO Vector
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
vp
            (Session, Vector) -> IO (Session, Vector)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SID -> MVar () -> ForeignPtr () -> Session
Session SID
i MVar ()
l ForeignPtr ()
x, Vector
v)

    existing :: Session -> IO (Result (Session, Vector))
existing Session
s = (Vector -> (Session, Vector))
-> Result Vector -> Result (Session, Vector)
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Session
s, ) (Result Vector -> Result (Session, Vector))
-> IO (Result Vector) -> IO (Result (Session, Vector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session -> ByteString -> IO (Result Vector)
decrypt Session
s ByteString
m

save :: Session -> IO (Result ())
save :: Session -> IO (Result ())
save Session
s = MVar () -> IO (Result ()) -> IO (Result ())
forall a. MVar () -> IO a -> IO a
withMutex (Session -> MVar ()
sessmutex Session
s) (IO (Result ()) -> IO (Result ()))
-> IO (Result ()) -> IO (Result ())
forall a b. (a -> b) -> a -> b
$ Session -> (CBoxVec -> IO (Result ())) -> IO (Result ())
forall a. Session -> (CBoxVec -> IO a) -> IO a
withSession Session
s ((CBoxVec -> IO (Result ())) -> IO (Result ()))
-> (CBoxVec -> IO (Result ())) -> IO (Result ())
forall a b. (a -> b) -> a -> b
$ \CBoxVec
sp ->
    IO CInt -> IO () -> IO (Result ())
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> IO CInt
cbox_session_save CBoxVec
sp) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

encrypt :: Session -> ByteString -> IO (Result Vector)
encrypt :: Session -> ByteString -> IO (Result Vector)
encrypt Session
s ByteString
plain = MVar () -> IO (Result Vector) -> IO (Result Vector)
forall a. MVar () -> IO a -> IO a
withMutex (Session -> MVar ()
sessmutex Session
s) (IO (Result Vector) -> IO (Result Vector))
-> IO (Result Vector) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$
    Session -> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a. Session -> (CBoxVec -> IO a) -> IO a
withSession Session
s                     ((CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
sp ->
    ByteString
-> (CStringLen -> IO (Result Vector)) -> IO (Result Vector)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Bytes.unsafeUseAsCStringLen ByteString
plain ((CStringLen -> IO (Result Vector)) -> IO (Result Vector))
-> (CStringLen -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \(CString
pp, Int
pl) ->
    (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca                            ((Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
vp -> do
    IO CInt -> IO Vector -> IO (Result Vector)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> Ptr Word8 -> CUInt -> Ptr CBoxVec -> IO CInt
cbox_encrypt CBoxVec
sp (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
pp) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pl) Ptr CBoxVec
vp) (IO Vector -> IO (Result Vector))
-> IO Vector -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$
        CBoxVec -> IO Vector
newVector (CBoxVec -> IO Vector) -> IO CBoxVec -> IO Vector
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
vp

decrypt :: Session -> ByteString -> IO (Result Vector)
decrypt :: Session -> ByteString -> IO (Result Vector)
decrypt Session
s ByteString
cipher = MVar () -> IO (Result Vector) -> IO (Result Vector)
forall a. MVar () -> IO a -> IO a
withMutex (Session -> MVar ()
sessmutex Session
s) (IO (Result Vector) -> IO (Result Vector))
-> IO (Result Vector) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$
    Session -> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a. Session -> (CBoxVec -> IO a) -> IO a
withSession Session
s                      ((CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
sp ->
    ByteString
-> (CStringLen -> IO (Result Vector)) -> IO (Result Vector)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
Bytes.unsafeUseAsCStringLen ByteString
cipher ((CStringLen -> IO (Result Vector)) -> IO (Result Vector))
-> (CStringLen -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \(CString
pp, Int
pl) ->
    (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca                             ((Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
vp ->
    IO CInt -> IO Vector -> IO (Result Vector)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> Ptr Word8 -> CUInt -> Ptr CBoxVec -> IO CInt
cbox_decrypt CBoxVec
sp (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
pp) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pl) Ptr CBoxVec
vp) (IO Vector -> IO (Result Vector))
-> IO Vector -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$
        CBoxVec -> IO Vector
newVector (CBoxVec -> IO Vector) -> IO CBoxVec -> IO Vector
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
vp

remoteFingerprint :: Session -> IO (Result Vector)
remoteFingerprint :: Session -> IO (Result Vector)
remoteFingerprint Session
s = MVar () -> IO (Result Vector) -> IO (Result Vector)
forall a. MVar () -> IO a -> IO a
withMutex (Session -> MVar ()
sessmutex Session
s) (IO (Result Vector) -> IO (Result Vector))
-> IO (Result Vector) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$
    Session -> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a. Session -> (CBoxVec -> IO a) -> IO a
withSession Session
s ((CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
sp ->
    (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca        ((Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
vp -> do
    IO CInt -> IO Vector -> IO (Result Vector)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> Ptr CBoxVec -> IO CInt
cbox_fingerprint_remote CBoxVec
sp Ptr CBoxVec
vp) (IO Vector -> IO (Result Vector))
-> IO Vector -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ CBoxVec -> IO Vector
newVector (CBoxVec -> IO Vector) -> IO CBoxVec -> IO Vector
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
vp

localFingerprint :: Box -> IO (Result Vector)
localFingerprint :: Box -> IO (Result Vector)
localFingerprint Box
b = MVar () -> IO (Result Vector) -> IO (Result Vector)
forall a. MVar () -> IO a -> IO a
withMutex (Box -> MVar ()
cboxmutex Box
b) (IO (Result Vector) -> IO (Result Vector))
-> IO (Result Vector) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$
    Box -> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b ((CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \CBoxVec
cb ->
    (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca          ((Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector))
-> (Ptr CBoxVec -> IO (Result Vector)) -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ \Ptr CBoxVec
vp -> do
    IO CInt -> IO Vector -> IO (Result Vector)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess (CBoxVec -> Ptr CBoxVec -> IO CInt
cbox_fingerprint_local CBoxVec
cb Ptr CBoxVec
vp) (IO Vector -> IO (Result Vector))
-> IO Vector -> IO (Result Vector)
forall a b. (a -> b) -> a -> b
$ CBoxVec -> IO Vector
newVector (CBoxVec -> IO Vector) -> IO CBoxVec -> IO Vector
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CBoxVec -> IO CBoxVec
forall a. Storable a => Ptr a -> IO a
peek Ptr CBoxVec
vp

withVector :: Vector -> (ByteString -> IO a) -> IO a
withVector :: forall a. Vector -> (ByteString -> IO a) -> IO a
withVector Vector
v ByteString -> IO a
f = ForeignPtr () -> (CBoxVec -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Vector -> ForeignPtr ()
vec Vector
v) ((CBoxVec -> IO a) -> IO a) -> (CBoxVec -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CBoxVec
vp -> do
    CString
b <- CPrekey -> CString
forall a b. Ptr a -> Ptr b
castPtr (CPrekey -> CString) -> IO CPrekey -> IO CString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CBoxVec -> IO CPrekey
cbox_vec_data CBoxVec
vp
    Int
n <- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CBoxVec -> IO CUInt
cbox_vec_len CBoxVec
vp
    CStringLen -> IO ByteString
Bytes.unsafePackCStringLen (CString
b, Int
n) IO ByteString -> (ByteString -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
bytes -> do
        a
x <- ByteString -> IO a
f ByteString
bytes
        a
x a -> IO a -> IO a
forall a b. a -> b -> b
`seq` a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

copyBytes :: Vector -> IO ByteString
copyBytes :: Vector -> IO ByteString
copyBytes Vector
v = Vector -> (ByteString -> IO ByteString) -> IO ByteString
forall a. Vector -> (ByteString -> IO a) -> IO a
withVector Vector
v (ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Bytes.copy)

-- Helpers ------------------------------------------------------------------

ifSuccess :: (Functor m, Monad m) => m CInt -> m a -> m (Result a)
ifSuccess :: forall (m :: * -> *) a.
(Functor m, Monad m) =>
m CInt -> m a -> m (Result a)
ifSuccess m CInt
a m a
b = do
    CInt
r <- m CInt
a
    if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
success then a -> Result a
forall a. a -> Result a
Success (a -> Result a) -> m a -> m (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
b else Result a -> m (Result a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Result a
forall a. CInt -> Result a
cboxError CInt
r)

withMutex :: MVar () -> IO a -> IO a
withMutex :: forall a. MVar () -> IO a -> IO a
withMutex MVar ()
m IO a
a = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
m (IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
a)

newVector :: CBoxVec -> IO Vector
newVector :: CBoxVec -> IO Vector
newVector CBoxVec
ptr = ForeignPtr () -> Vector
Vector (ForeignPtr () -> Vector) -> IO (ForeignPtr ()) -> IO Vector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr () -> CBoxVec -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
cbox_vec_free CBoxVec
ptr

withCryptoBox :: Box -> (Ptr () -> IO a) -> IO a
withCryptoBox :: forall a. Box -> (CBoxVec -> IO a) -> IO a
withCryptoBox Box
b = ForeignPtr () -> (CBoxVec -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Box -> ForeignPtr ()
cboxptr Box
b)

withSession :: Session -> (Ptr () -> IO a) -> IO a
withSession :: forall a. Session -> (CBoxVec -> IO a) -> IO a
withSession Session
s = ForeignPtr () -> (CBoxVec -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Session -> ForeignPtr ()
sessptr Session
s)

cboxError :: CInt -> Result a
cboxError :: forall a. CInt -> Result a
cboxError (CInt
1)           = Result a
forall a. Result a
StorageError
{-# LINE 255 "src/System/CryptoBox.hsc" #-}
cboxError (2)       = NoSession
{-# LINE 256 "src/System/CryptoBox.hsc" #-}
cboxError (3)            = DecodeError
{-# LINE 257 "src/System/CryptoBox.hsc" #-}
cboxError (4) = RemoteIdentityChanged
{-# LINE 258 "src/System/CryptoBox.hsc" #-}
cboxError (5)       = InvalidSignature
{-# LINE 259 "src/System/CryptoBox.hsc" #-}
cboxError (6)         = InvalidMessage
{-# LINE 260 "src/System/CryptoBox.hsc" #-}
cboxError (7)       = DuplicateMessage
{-# LINE 261 "src/System/CryptoBox.hsc" #-}
cboxError (8)      = TooDistantFuture
{-# LINE 262 "src/System/CryptoBox.hsc" #-}
cboxError (9)        = OutdatedMessage
{-# LINE 263 "src/System/CryptoBox.hsc" #-}
cboxError (10)              = Utf8Error
{-# LINE 264 "src/System/CryptoBox.hsc" #-}
cboxError (11)               = NulError
{-# LINE 265 "src/System/CryptoBox.hsc" #-}
cboxError (12)            = EncodeError
{-# LINE 266 "src/System/CryptoBox.hsc" #-}
cboxError (13)          = IdentityError
{-# LINE 267 "src/System/CryptoBox.hsc" #-}
cboxError (14)        = NoPrekey
{-# LINE 268 "src/System/CryptoBox.hsc" #-}
cboxError (15)                   = Panic
{-# LINE 269 "src/System/CryptoBox.hsc" #-}
cboxError cint                                  = Unknown (fromIntegral cint)

success :: CInt
success :: CInt
success = CInt
0
{-# LINE 273 "src/System/CryptoBox.hsc" #-}

type CBox        = Ptr ()
type CBoxVec     = Ptr ()
type CBoxSession = Ptr ()
type CPrekey     = Ptr CUChar
type Cipher      = Ptr CUChar

-- Foreign Declarations -----------------------------------------------------

foreign import ccall unsafe "cbox.h cbox_vec_data"
    cbox_vec_data :: CBoxVec -> IO (Ptr CUChar)

foreign import ccall unsafe "cbox.h cbox_vec_len"
    cbox_vec_len :: CBoxVec -> IO CUInt

foreign import ccall "cbox.h &cbox_vec_free"
    cbox_vec_free :: FunPtr (CBoxVec -> IO ())

foreign import ccall unsafe "cbox.h cbox_file_open"
    cbox_file_open :: CString -> Ptr CBox -> IO CInt

foreign import ccall "cbox.h &cbox_close"
    cbox_close :: FunPtr (CBox  -> IO ())

foreign import ccall unsafe "cbox.h cbox_random_bytes"
    cbox_random_bytes :: CBox -> CUInt -> Ptr CBoxVec -> IO CInt

foreign import ccall unsafe "cbox.h cbox_new_prekey"
    cbox_new_prekey :: CBox -> CUShort -> Ptr CBoxVec -> IO CInt

foreign import ccall unsafe "cbox.h cbox_session_init_from_prekey"
    cbox_session_init_from_prekey :: CBox
                                  -> CString
                                  -> CPrekey
                                  -> CUInt
                                  -> Ptr CBoxSession
                                  -> IO CInt

foreign import ccall unsafe "cbox.h cbox_session_init_from_message"
    cbox_session_init_from_message :: CBox
                                   -> CString
                                   -> Cipher
                                   -> CUInt
                                   -> Ptr CBoxSession
                                   -> Ptr CBoxVec
                                   -> IO CInt

foreign import ccall unsafe "cbox.h cbox_session_load"
    cbox_session_load :: CBox -> CString -> Ptr CBoxSession -> IO CInt

foreign import ccall unsafe "cbox.h cbox_session_save"
    cbox_session_save :: CBoxSession -> IO CInt

foreign import ccall "cbox.h &cbox_session_close"
    cbox_session_close :: FunPtr (CBoxSession  -> IO ())

foreign import ccall "cbox.h cbox_session_delete"
    cbox_session_delete :: CBoxSession -> CString -> IO CInt

foreign import ccall unsafe "cbox.h cbox_encrypt"
    cbox_encrypt :: CBoxSession -> Ptr Word8 -> CUInt -> Ptr CBoxVec -> IO CInt

foreign import ccall unsafe "cbox.h cbox_decrypt"
    cbox_decrypt :: CBoxSession -> Ptr Word8 -> CUInt -> Ptr CBoxVec -> IO CInt

foreign import ccall unsafe "cbox.h cbox_fingerprint_local"
    cbox_fingerprint_local :: CBox -> Ptr CBoxVec -> IO CInt

foreign import ccall unsafe "cbox.h cbox_fingerprint_remote"
    cbox_fingerprint_remote :: CBoxSession -> Ptr CBoxVec -> IO CInt

foreign import ccall unsafe "cbox.h cbox_is_prekey"
    cbox_is_prekey :: Ptr Word8 -> CUInt -> Ptr Word16 -> IO CInt