-- |
-- Module      : Crypto.Saltine.Core.SecretBox
-- Copyright   : (c) Joseph Abrahamson 2013
-- License     : MIT
--
-- Maintainer  : max@lambdalifting.org
-- Stability   : experimental
-- Portability : non-portable
--
-- Secret-key authenticated encryption:
-- "Crypto.Saltine.Core.SecretBox"
--
-- The 'secretbox' function encrypts and authenticates a message
-- 'ByteString' using a secret key and a nonce. The 'secretboxOpen'
-- function verifies and decrypts a ciphertext 'ByteString' using a
-- secret key and a nonce. If the ciphertext fails validation,
-- 'secretboxOpen' returns 'Nothing'.
--
-- The "Crypto.Saltine.Core.SecretBox" module is designed to meet
-- the standard notions of privacy and authenticity for a secret-key
-- authenticated-encryption scheme using nonces. For formal
-- definitions see, e.g., Bellare and Namprempre, "Authenticated
-- encryption: relations among notions and analysis of the generic
-- composition paradigm," Lecture Notes in Computer Science 1976
-- (2000), 531–545, <http://www-cse.ucsd.edu/~mihir/papers/oem.html>.
--
-- Note that the length is not hidden. Note also that it is the
-- caller's responsibility to ensure the uniqueness of nonces—for
-- example, by using nonce 1 for the first message, nonce 2 for the
-- second message, etc. Nonces are long enough that randomly generated
-- nonces have negligible risk of collision.
--
-- "Crypto.Saltine.Core.SecretBox" is
-- @crypto_secretbox_xsalsa20poly1305@, a particular combination of
-- Salsa20 and Poly1305 specified in \"Cryptography in NaCl\"
-- (<http://nacl.cr.yp.to/valid.html>). This function is conjectured
-- to meet the standard notions of privacy and authenticity.
--
-- This is version 2010.08.30 of the secretbox.html web page.
module Crypto.Saltine.Core.SecretBox (
  Key, Nonce, Authenticator,
  secretbox, secretboxOpen,
  secretboxDetached, secretboxOpenDetached,
  newKey, newNonce
  ) where

import Crypto.Saltine.Internal.SecretBox
            ( c_secretbox
            , c_secretbox_detached
            , c_secretbox_open
            , c_secretbox_open_detached
            , Key(..)
            , Nonce(..)
            , Authenticator(..)
            )
import Crypto.Saltine.Internal.Util as U
import Data.ByteString              (ByteString)

import qualified Crypto.Saltine.Internal.SecretBox as Bytes
import qualified Data.ByteString                   as S

-- | Creates a random key of the correct size for 'secretbox'.
newKey :: IO Key
newKey :: IO Key
newKey = ByteString -> Key
Key (ByteString -> Key) -> IO ByteString -> IO Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
randomByteString Int
Bytes.secretbox_keybytes

-- | Creates a random nonce of the correct size for 'secretbox'.
newNonce :: IO Nonce
newNonce :: IO Nonce
newNonce = ByteString -> Nonce
Nonce (ByteString -> Nonce) -> IO ByteString -> IO Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
randomByteString Int
Bytes.secretbox_noncebytes

-- | Encrypts a message. It is infeasible for an attacker to decrypt
-- the message so long as the 'Nonce' is never repeated.
secretbox
    :: Key
    -> Nonce
    -> ByteString
    -- ^ Message
    -> ByteString
    -- ^ Ciphertext
secretbox :: Key -> Nonce -> ByteString -> ByteString
secretbox (Key ByteString
key) (Nonce ByteString
nonce) ByteString
msg =
  ByteString -> ByteString
unpad' (ByteString -> ByteString)
-> ((Ptr CChar -> IO CInt) -> ByteString)
-> (Ptr CChar -> IO CInt)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CInt, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((CInt, ByteString) -> ByteString)
-> ((Ptr CChar -> IO CInt) -> (CInt, ByteString))
-> (Ptr CChar -> IO CInt)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr CChar -> IO CInt) -> (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> (b, ByteString)
buildUnsafeByteString Int
len ((Ptr CChar -> IO CInt) -> ByteString)
-> (Ptr CChar -> IO CInt) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pc ->
    [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
key, ByteString -> ByteString
pad' ByteString
msg, ByteString
nonce] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \
      [(Ptr CChar
pk, Int
_), (Ptr CChar
pm, Int
_), (Ptr CChar
pn, Int
_)] ->
        Ptr CChar
-> Ptr CChar -> CULLong -> Ptr CChar -> Ptr CChar -> IO CInt
c_secretbox Ptr CChar
pc Ptr CChar
pm (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr CChar
pn Ptr CChar
pk
  where len :: Int
len    = ByteString -> Int
S.length ByteString
msg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
Bytes.secretbox_zerobytes
        pad' :: ByteString -> ByteString
pad'   = Int -> ByteString -> ByteString
pad Int
Bytes.secretbox_zerobytes
        unpad' :: ByteString -> ByteString
unpad' = Int -> ByteString -> ByteString
unpad Int
Bytes.secretbox_boxzerobytes

-- | Encrypts a message. In contrast with 'secretbox', the result is not
-- serialized as one element and instead provided as an authentication tag and
-- ciphertext.
secretboxDetached
    :: Key
    -> Nonce
    -> ByteString
    -- ^ Message
    -> (Authenticator,ByteString)
    -- ^ (Authentication Tag, Ciphertext)
secretboxDetached :: Key -> Nonce -> ByteString -> (Authenticator, ByteString)
secretboxDetached (Key ByteString
key) (Nonce ByteString
nonce) ByteString
msg =
  Int
-> (Ptr CChar -> IO Authenticator) -> (Authenticator, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> (b, ByteString)
buildUnsafeByteString Int
ctLen ((Ptr CChar -> IO Authenticator) -> (Authenticator, ByteString))
-> (Ptr CChar -> IO Authenticator) -> (Authenticator, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pc ->
    ((CInt, ByteString) -> Authenticator)
-> IO (CInt, ByteString) -> IO Authenticator
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Authenticator
Au (ByteString -> Authenticator)
-> ((CInt, ByteString) -> ByteString)
-> (CInt, ByteString)
-> Authenticator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CInt, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) (IO (CInt, ByteString) -> IO Authenticator)
-> ((Ptr CChar -> IO CInt) -> IO (CInt, ByteString))
-> (Ptr CChar -> IO CInt)
-> IO Authenticator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr CChar -> IO CInt) -> IO (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' Int
tagLen ((Ptr CChar -> IO CInt) -> IO Authenticator)
-> (Ptr CChar -> IO CInt) -> IO Authenticator
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptag ->
      [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
key, ByteString
msg, ByteString
nonce] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \
        [(Ptr CChar
pk, Int
_), (Ptr CChar
pmsg, Int
_), (Ptr CChar
pn, Int
_)] ->
          Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> CULLong
-> Ptr CChar
-> Ptr CChar
-> IO CInt
c_secretbox_detached Ptr CChar
pc Ptr CChar
ptag Ptr CChar
pmsg (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ptLen) Ptr CChar
pn Ptr CChar
pk
  where ctLen :: Int
ctLen  = Int
ptLen
        ptLen :: Int
ptLen  = ByteString -> Int
S.length ByteString
msg
        tagLen :: Int
tagLen = Int
Bytes.secretbox_macbytes

-- | Decrypts a message. Returns 'Nothing' if the keys and message do
-- not match.
secretboxOpen
    :: Key
    -> Nonce
    -> ByteString
    -- ^ Ciphertext
    -> Maybe ByteString
    -- ^ Message
secretboxOpen :: Key -> Nonce -> ByteString -> Maybe ByteString
secretboxOpen (Key ByteString
key) (Nonce ByteString
nonce) ByteString
cipher =
  let (CInt
err, ByteString
vec) = Int -> (Ptr CChar -> IO CInt) -> (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> (b, ByteString)
buildUnsafeByteString Int
len ((Ptr CChar -> IO CInt) -> (CInt, ByteString))
-> (Ptr CChar -> IO CInt) -> (CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pm ->
        [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
key, ByteString -> ByteString
pad' ByteString
cipher, ByteString
nonce] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \
          [(Ptr CChar
pk, Int
_), (Ptr CChar
pc, Int
_), (Ptr CChar
pn, Int
_)] ->
            Ptr CChar
-> Ptr CChar -> CULLong -> Ptr CChar -> Ptr CChar -> IO CInt
c_secretbox_open Ptr CChar
pm Ptr CChar
pc (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr CChar
pn Ptr CChar
pk
  in Either String ByteString -> Maybe ByteString
forall s a. Either s a -> Maybe a
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ByteString -> Either String ByteString
forall a. CInt -> a -> Either String a
handleErrno CInt
err (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
unpad' ByteString
vec
  where len :: Int
len    = ByteString -> Int
S.length ByteString
cipher Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
Bytes.secretbox_boxzerobytes
        pad' :: ByteString -> ByteString
pad'   = Int -> ByteString -> ByteString
pad Int
Bytes.secretbox_boxzerobytes
        unpad' :: ByteString -> ByteString
unpad' = Int -> ByteString -> ByteString
unpad Int
Bytes.secretbox_zerobytes

-- | Decrypts a message. Returns 'Nothing' if the keys and message do
-- not match.
secretboxOpenDetached
    :: Key
    -> Nonce
    -> Authenticator
    -- ^ Auth Tag
    -> ByteString
    -- ^ Ciphertext
    -> Maybe ByteString
    -- ^ Message
secretboxOpenDetached :: Key -> Nonce -> Authenticator -> ByteString -> Maybe ByteString
secretboxOpenDetached (Key ByteString
key) (Nonce ByteString
nonce) (Au ByteString
tag) ByteString
cipher
    | ByteString -> Int
S.length ByteString
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
Bytes.secretbox_macbytes = Maybe ByteString
forall a. Maybe a
Nothing
    | Bool
otherwise =
  let (CInt
err, ByteString
vec) = Int -> (Ptr CChar -> IO CInt) -> (CInt, ByteString)
forall b. Int -> (Ptr CChar -> IO b) -> (b, ByteString)
buildUnsafeByteString Int
len ((Ptr CChar -> IO CInt) -> (CInt, ByteString))
-> (Ptr CChar -> IO CInt) -> (CInt, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pm ->
        [ByteString] -> ([CStringLen] -> IO CInt) -> IO CInt
forall b. [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings [ByteString
key, ByteString
cipher, ByteString
tag, ByteString
nonce] (([CStringLen] -> IO CInt) -> IO CInt)
-> ([CStringLen] -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \
          [(Ptr CChar
pk, Int
_), (Ptr CChar
pc, Int
_), (Ptr CChar
pt, Int
_), (Ptr CChar
pn, Int
_)] ->
            Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> CULLong
-> Ptr CChar
-> Ptr CChar
-> IO CInt
c_secretbox_open_detached Ptr CChar
pm Ptr CChar
pc Ptr CChar
pt (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr CChar
pn Ptr CChar
pk
  in Either String ByteString -> Maybe ByteString
forall s a. Either s a -> Maybe a
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ByteString -> Either String ByteString
forall a. CInt -> a -> Either String a
handleErrno CInt
err (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
vec
  where len :: Int
len    = ByteString -> Int
S.length ByteString
cipher