packages feed

raaz-0.3.0: monocypher/tests/Monocypher/ChaCha20Spec.hs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE FlexibleContexts         #-}

{- HLINT ignore "Use camelCase" -}

-- | These tests compare the implementation of chacha20 of raaz and
-- that of monocypher. Raaz implements the ietf variants and hence
-- should be tested against crypto_ietf_chacha and not crypto_chacha C
-- function of Monocyper (>=3.0).
module Monocypher.ChaCha20Spec where


import qualified Data.ByteString as BS
import           Data.ByteString.Internal (unsafeCreate, createAndTrim')
import           Data.ByteString.Unsafe   (unsafeUseAsCStringLen)
import qualified Foreign.Storable as Storable
import           Foreign.Ptr
import           Foreign.C.Types
import           Foreign.C.String
import           Foreign.Marshal.Alloc
import           System.IO.Unsafe  (unsafePerformIO)

import           Raaz.Core
import qualified Raaz.Encrypt.ChaCha20  as ChaCha20
import qualified Raaz.Encrypt.XChaCha20 as XChaCha20
import qualified Raaz.AuthEncrypt.Unsafe.ChaCha20Poly1305  as CP
import qualified Raaz.AuthEncrypt.Unsafe.XChaCha20Poly1305 as XP

import           Tests.Core

foreign import ccall unsafe
      crypto_ietf_chacha20 :: Ptr Word8  -- cipher text
                           -> Ptr CChar  -- plain text
                           -> Int        -- Size
                           -> Ptr Word8  -- key
                           -> Ptr Word8  -- nounce
                           -> IO ()

foreign import ccall unsafe
    crypto_xchacha20 :: Ptr Word8  -- cipher text
                     -> Ptr CChar  -- plain text
                     -> Int        -- Size
                     -> Ptr Word8  -- key
                     -> Ptr Word8  -- nounce
                     -> IO ()

foreign import ccall unsafe
    crypto_unlock :: Ptr Word8 -- plain
                  -> Ptr Word8 -- key
                  -> Ptr Word8 -- nounce
                  -> Ptr Word8 -- mac
                  -> Ptr CChar -- cipher
                  -> Int       -- size
                  -> IO Int

foreign import ccall unsafe
   crypto_unlock_aead :: Ptr Word8 -- plain_text,
                      -> Ptr Word8 -- key
                      -> Ptr Word8 -- nounce
                      -> Ptr Word8 -- mac
                      -> Ptr CChar -- aad
                      -> Int       -- aad size
                      -> Ptr CChar -- cipher text
                      -> Int       -- cipher text size
                      -> IO Int
----------------------------------------------------------------------------------
call :: EndianStore a
     => a
     -> (Ptr b -> IO something)
     -> IO something
call a action =
  allocaBytes aSize $ \ aptr -> do store (castPtr aptr) a; action aptr
  where aSize = Storable.sizeOf (undefined `asTypeOf` a)

call2 :: (EndianStore a,  EndianStore b)
      => a
      -> b
      -> (Ptr a1 -> Ptr b1 -> IO something)
      -> IO something
call2 a b action = call a (call b . action)

------------------- Monocypher encryption -----------------------------------------

monocypher_chacha20_io :: Key ChaCha20
                       -> Nounce ChaCha20
                       -> Ptr Word8
                       -> CStringLen     -- plain text
                       -> IO ()
monocypher_chacha20_io k n cPtr (pPtr, l)
  = call k $ call n . crypto_ietf_chacha20 cPtr pPtr l

monocypher_xchacha20_io :: Key XChaCha20
                        -> Nounce XChaCha20
                        -> Ptr Word8
                        -> CStringLen     -- plain text
                        -> IO ()
monocypher_xchacha20_io k n cPtr (pPtr, l)
  = call k $ call n . crypto_xchacha20 cPtr pPtr l


monocypher_chacha20_encrypt :: Key ChaCha20
                            -> Nounce ChaCha20
                            -> ByteString
                            -> ByteString
monocypher_chacha20_encrypt k n bs = unsafeFromByteString $ unsafeCreate l creator
  where l = BS.length bs
        creator = unsafeUseAsCStringLen bs . monocypher_chacha20_io k n


monocypher_xchacha20_encrypt :: Key XChaCha20
                             -> Nounce XChaCha20
                             -> ByteString
                             -> ByteString
monocypher_xchacha20_encrypt k n bs = unsafeFromByteString $ unsafeCreate l creator
  where l = BS.length bs
        creator = unsafeUseAsCStringLen bs . monocypher_xchacha20_io k n

-------------------- Monocypher encrypted auth ----------------------------------------

monocypher_unlock_aead_io :: ByteString    -- aad
                          -> ByteString    -- cipher text
                          -> Key XChaCha20
                          -> Nounce XChaCha20
                          -> Poly1305
                          -> Ptr Word8  -- Place to write the result.
                          -> IO (Int, Int, Bool)
monocypher_unlock_aead_io aad cText k n mac outPtr
  = let unlockAction kPtr nPtr mPtr
          = unsafeUseAsCStringLen aad
          $ \ (aadPtr, aadLen)     -> unsafeUseAsCStringLen cText
          $ \ (cTextPtr, cTextLen) ->
              do res <- crypto_unlock_aead outPtr kPtr nPtr mPtr aadPtr aadLen cTextPtr cTextLen
                 return (0, cTextLen, res == 0)
    in  call k $ call2 n mac . unlockAction


monocypher_unlock_io :: ByteString    -- cipher text
                     -> Key XChaCha20
                     -> Nounce XChaCha20
                     -> Poly1305
                     -> Ptr Word8  -- Place to write the result.
                     -> IO (Int, Int, Bool)
monocypher_unlock_io cText k n mac outPtr
  = let unlockAction kPtr nPtr mPtr
          = unsafeUseAsCStringLen cText
            $ \ (cTextPtr, cTextLen) ->
                do res <- crypto_unlock outPtr kPtr nPtr mPtr cTextPtr cTextLen
                   return (0, cTextLen, res == 0)
    in  call k $ call2 n mac . unlockAction


monocypher_unlock      :: Key XChaCha20
                       -> Nounce XChaCha20
                       -> XP.Locked
                       -> Maybe ByteString
monocypher_unlock k n locked =
  let cText = XP.unsafeToCipherText locked
      mac   = XP.unsafeToAuthTag locked
      len   = BS.length cText
  in unsafePerformIO $
     do (s, status) <- createAndTrim' len
                       $ monocypher_unlock_io cText k n mac
        if status then return (Just s) else return Nothing

monocypher_unlock_aead :: ByteString        -- aad
                       -> Key XChaCha20
                       -> Nounce XChaCha20
                       -> XP.Locked
                       -> Maybe ByteString
monocypher_unlock_aead aad k n aead =
  let cText = XP.unsafeToCipherText aead
      mac   = XP.unsafeToAuthTag aead
      len   = BS.length cText
  in unsafePerformIO $
     do (s, status) <- createAndTrim' len
                       $ monocypher_unlock_aead_io aad cText k n mac
        if status then return (Just s) else return Nothing

spec :: Spec
spec = do
  describe "monocypher vs raaz" $ do

    prop "chacha20 encryption" $
      \ k n x ->  monocypher_chacha20_encrypt k n x `shouldBe` ChaCha20.encrypt k n x

    prop "xchacha20 encryption" $
      \ k n x -> monocypher_xchacha20_encrypt k n x `shouldBe` XChaCha20.encrypt k n x

    prop "raaz lock and monocypher unlock are inverses" $
      \ k n (x :: ByteString) -> monocypher_unlock k n (XP.unsafeLock k n x) `shouldBe` Just x

    prop "raaz lockWith vs monocypher unlockAead are inverses" $
      \ k n (aad :: ByteString) (x :: ByteString)
      -> monocypher_unlock_aead aad k n (XP.unsafeLockWith aad k n x) `shouldBe` Just x

  describe "raaz - lock/unlock are inverses" $ do

    prop "chacha20poly1305 " $
      \ k n (x :: ByteString) -> CP.unlock k (CP.unsafeLock k n x) `shouldBe` Just x

    prop "xchacha20poly1305" $
      \ k n (x :: ByteString) -> XP.unlock k (XP.unsafeLock k n x) `shouldBe` Just x

    prop "chacha20poly1305-aead" $
      \ k n (aad :: ByteString) (x :: ByteString)
      -> CP.unlockWith aad k (CP.unsafeLockWith aad k n x) `shouldBe` Just x

    prop "xchacha20poly1305-aead" $
      \ k n (aad :: ByteString) (x :: ByteString)
      -> XP.unlockWith aad  k (XP.unsafeLockWith aad k n x) `shouldBe` Just x