{-# LANGUAGE ForeignFunctionInterface #-}
module Crypto.Cipher.XSalsa
( initialize
, derive
, combine
, generate
, State
) where
import Crypto.Internal.ByteArray (ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import Crypto.Internal.Imports
import Foreign.Ptr
import Crypto.Cipher.Salsa hiding (initialize)
initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
=> Int
-> key
-> nonce
-> State
initialize :: forall key nonce.
(ByteArrayAccess key, ByteArrayAccess nonce) =>
Int -> key -> nonce -> State
initialize Int
nbRounds key
key nonce
nonce
| Int
kLen forall a. Eq a => a -> a -> Bool
/= Int
32 = forall a. HasCallStack => [Char] -> a
error [Char]
"XSalsa: key length should be 256 bits"
| Int
nonceLen forall a. Eq a => a -> a -> Bool
/= Int
24 = forall a. HasCallStack => [Char] -> a
error [Char]
"XSalsa: nonce length should be 192 bits"
| Int
nbRounds forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
8,Int
12,Int
20] = forall a. HasCallStack => [Char] -> a
error [Char]
"XSalsa: rounds should be 8, 12 or 20"
| Bool
otherwise = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
ScrubbedBytes
stPtr <- forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
132 forall a b. (a -> b) -> a -> b
$ \Ptr State
stPtr ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray nonce
nonce forall a b. (a -> b) -> a -> b
$ \Ptr Word8
noncePtr ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray key
key forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyPtr ->
Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
ccrypton_xsalsa_init Ptr State
stPtr Int
nbRounds Int
kLen Ptr Word8
keyPtr Int
nonceLen Ptr Word8
noncePtr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> State
State ScrubbedBytes
stPtr
where kLen :: Int
kLen = forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key
nonceLen :: Int
nonceLen = forall ba. ByteArrayAccess ba => ba -> Int
B.length nonce
nonce
derive :: ByteArrayAccess nonce
=> State
-> nonce
-> State
derive :: forall nonce. ByteArrayAccess nonce => State -> nonce -> State
derive (State ScrubbedBytes
stPtr') nonce
nonce
| Int
nonceLen forall a. Eq a => a -> a -> Bool
/= Int
16 = forall a. HasCallStack => [Char] -> a
error [Char]
"XSalsa: nonce length should be 128 bits"
| Bool
otherwise = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
ScrubbedBytes
stPtr <- forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy ScrubbedBytes
stPtr' forall a b. (a -> b) -> a -> b
$ \Ptr State
stPtr ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray nonce
nonce forall a b. (a -> b) -> a -> b
$ \Ptr Word8
noncePtr ->
Ptr State -> Int -> Ptr Word8 -> IO ()
ccrypton_xsalsa_derive Ptr State
stPtr Int
nonceLen Ptr Word8
noncePtr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> State
State ScrubbedBytes
stPtr
where nonceLen :: Int
nonceLen = forall ba. ByteArrayAccess ba => ba -> Int
B.length nonce
nonce
foreign import ccall "crypton_xsalsa_init"
ccrypton_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
foreign import ccall "crypton_xsalsa_derive"
ccrypton_xsalsa_derive :: Ptr State -> Int -> Ptr Word8 -> IO ()