    {-# LANGUAGE CPP, MultiParamTypeClasses #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Crypto.Nettle.UMAC
    -- Copyright   :  (c) 2013 Stefan Bühler
    -- License     :  MIT-style (see the file COPYING)
    --
    -- Maintainer  :  stbuehler@web.de
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- This module exports the UMAC algorithms supported by nettle:
    --   <http://www.lysator.liu.se/~nisse/nettle/>
    --
    -----------------------------------------------------------------------------

    module Crypto.Nettle.UMAC (
    	  UMAC(..)
    	, UMAC32
    	, UMAC64
    	, UMAC96
    	, UMAC128

    	, umacInitKeyedHash
    	) where

    import Data.SecureMem
    import Data.Tagged
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Internal as B
    import qualified Data.ByteString.Lazy as L
    import Control.Applicative ((<$>))
    import Data.List (foldl')

    import Nettle.Utils
    import Crypto.Nettle.KeyedHash
    import Crypto.Nettle.Hash.ForeignImports

    #ifdef GHCI
    -- internal functions are not camelCase on purpose
    {-# ANN module "HLint: ignore Use camelCase" #-}
    #endif

    {-|
    'UMAC' is a class of keyed hash algorithms that take an additional nonce.

    Keys for 'UMAC' are always 16 bytes; there are different digest sizes: 4, 8, 12 and 16 bytes (32, 64, 96 and 128 bits),
    and the variants are named after the digest length in bits.

    On initialization the nonce is set to 0; each finalize returns a new state with an incremented nonce.
    The nonce is interpreted as 16-byte (128-bit) big-endian integer (and for string shorter than 16 bytes padded with zeroes /on the left/; setting empty nonces is not allowed).
    -}
    class UMAC u where
    	-- | digest size in bytes
    	umacDigestSize :: Tagged u Int
    	-- | umac name ("UMAC" ++ digest size in bits)
    	umacName :: Tagged u String
    	umacName = (("UMAC" ++) . show . (8*)) <$> umacDigestSize
    	-- | initialize a new context from a @key@ with a zero @nonce@
    	umacInit :: B.ByteString {- ^ @key@ argument -} -> u
    	-- | set a @nonce@; can be called anytime before producing the digest
    	umacSetNonce :: u -> B.ByteString {- ^ @nonce@ argument -} -> u
    	-- | append @message@ data to be hashed
    	umacUpdate :: u -> B.ByteString {- ^ @message@ argument -} -> u
    	-- | append lazy @message@ data to be hashed
    	umacUpdateLazy :: u -> L.ByteString {- ^ @message@ argument -} -> u
    	umacUpdateLazy u = foldl' umacUpdate u . L.toChunks
    	-- | produce a digest, and return a new state with incremented nonce
    	umacFinalize :: u -> (B.ByteString, u)

    -- make all (UMAC u) a (KeyedHashAlgorithm u u)
    umacKHDigestSize :: UMAC u => Tagged u Int
    umacKHDigestSize = umacDigestSize
    umacKHName :: UMAC u => Tagged u String
    umacKHName = umacName
    umacKHInit :: UMAC u => B.ByteString -> u
    umacKHInit = umacInit
    umacKHUpdate :: UMAC u => u -> B.ByteString -> u
    umacKHUpdate = umacUpdate
    umacKHFinalize :: UMAC u => u -> B.ByteString
    umacKHFinalize = fst . umacFinalize

    {-|
    The default 'KeyedHash' generated for UMAC 'KeyedHashAlgorithm' instances use a zero nonce; to set a different nonce you need to use this initialization function (or use the 'UMAC' interface).

    Once the UMAC lives as 'KeyedHash' the nonce cannot be changed anymore, as 'KeyedHash' hides all internal state.
    -}
    umacInitKeyedHash :: (UMAC u, KeyedHashAlgorithm u) => B.ByteString {- ^ @key@ argument -} -> B.ByteString {- ^ @nonce@ argument -} -> Tagged u KeyedHash
    umacInitKeyedHash key nonce = KeyedHash <$> flip umacSetNonce nonce <$> tagSelf (umacInit key)

    class NettleUMAC u where
    	nu_ctx_size :: Tagged u Int
    	nu_digest_size :: Tagged u Int
    	nu_set_key :: Tagged u (Ptr Word8 -> Ptr Word8 -> IO ())
    	nu_set_nonce :: Tagged u (Ptr Word8 -> Word -> Ptr Word8 -> IO ())
    	nu_update :: Tagged u (Ptr Word8 -> Word -> Ptr Word8 -> IO ())
    	nu_digest :: Tagged u (Ptr Word8 -> Word -> Ptr Word8 -> IO ())
    	nu_ctx :: u -> SecureMem
    	nu_Ctx :: SecureMem -> u

    nettleUmacDigestSize :: NettleUMAC u => Tagged u Int
    nettleUmacDigestSize = nu_digest_size
    nettleUmacInit :: NettleUMAC u => B.ByteString -> u
    nettleUmacInit key = if B.length key /= 16 then error "wrong key length" else untag go where
    	go :: NettleUMAC u => Tagged u u
    	go = do
    		size <- nu_ctx_size
    		set_key <- nu_set_key
    		return $ nu_Ctx $ unsafeCreateSecureMem size $ \ctxptr ->
    			withByteStringPtr key $ \_ keyptr ->
    			set_key ctxptr keyptr
    nettleUmacSetNonce :: NettleUMAC u => u -> B.ByteString -> u
    nettleUmacSetNonce c nonce = if B.length nonce < 1 || B.length nonce > 16 then error "invalid nonce length" else untag $ go c where
    	go :: NettleUMAC u => u -> Tagged u u
    	go ctx = do
    		set_nonce <- nu_set_nonce
    		return $ nu_Ctx $ unsafeDupablePerformIO $
    			withSecureMemCopy (nu_ctx ctx) $ \ctxptr ->
    			withByteStringPtr nonce $ \noncelen nonceptr ->
    				set_nonce ctxptr noncelen nonceptr
    nettleUmacUpdate :: NettleUMAC u => u -> B.ByteString -> u
    nettleUmacUpdate c msg = untag $ go c where
    	go :: NettleUMAC u => u -> Tagged u u
    	go ctx = do
    		update <- nu_update
    		return $ nu_Ctx $ unsafeDupablePerformIO $
    			withSecureMemCopy (nu_ctx ctx) $ \ctxptr ->
    			withByteStringPtr msg $ \msglen msgptr ->
    				update ctxptr msglen msgptr
    nettleUmacUpdateLazy :: NettleUMAC u => u -> L.ByteString -> u
    nettleUmacUpdateLazy c msg = untag $ go c where
    	go :: NettleUMAC u => u -> Tagged u u
    	go ctx = do
    		update <- nu_update
    		return $ nu_Ctx $ unsafeDupablePerformIO $
    			withSecureMemCopy (nu_ctx ctx) $ \ctxptr ->
    			forM_ (L.toChunks msg) $ \chunk ->
    			withByteStringPtr chunk $ \chunklen chunkptr ->
    				update ctxptr chunklen chunkptr
    nettleUmacFinalize :: NettleUMAC u => u -> (B.ByteString, u)
    nettleUmacFinalize c = untag $ go c where
    	go :: NettleUMAC u => u -> Tagged u (B.ByteString, u)
    	go ctx = do
    		digestSize <- nu_digest_size
    		digest <- nu_digest
    		return $ unsafeDupablePerformIO $ do
    			ctx' <- secureMemCopy (nu_ctx ctx)
    			dig <- withSecureMemPtr ctx' $ \ctxptr ->
    				B.create digestSize $ \digestptr ->
    				digest ctxptr (fromIntegral digestSize) digestptr
    			return (dig, nu_Ctx ctx')

    #define INSTANCE_UMAC(Typ) \
    instance UMAC Typ where \
    	{ umacDigestSize = nettleUmacDigestSize \
    	; umacInit       = nettleUmacInit \
    	; umacSetNonce   = nettleUmacSetNonce \
    	; umacUpdate     = nettleUmacUpdate \
    	; umacUpdateLazy = nettleUmacUpdateLazy \
    	; umacFinalize   = nettleUmacFinalize \
    	} ; \
    instance KeyedHashAlgorithm Typ where \
    	{ implKeyedHashDigestSize = umacKHDigestSize \
    	; implKeyedHashName       = umacKHName \
    	; implKeyedHashInit       = umacKHInit \
    	; implKeyedHashUpdate     = umacKHUpdate \
    	; implKeyedHashFinalize   = umacKHFinalize \
    	}

    {-|
    'UMAC32' is the 32-bit (4 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance.
    -}
    newtype UMAC32 = UMAC32 { umac32_ctx :: SecureMem }
    instance NettleUMAC UMAC32 where
    	nu_ctx_size    = Tagged c_umac32_ctx_size
    	nu_digest_size = Tagged c_umac32_digest_size
    	nu_set_key     = Tagged c_umac32_set_key
    	nu_set_nonce   = Tagged c_umac32_set_nonce
    	nu_update      = Tagged c_umac32_update
    	nu_digest      = Tagged c_umac32_digest
    	nu_ctx         = umac32_ctx
    	nu_Ctx         = UMAC32
    INSTANCE_UMAC(UMAC32)

    {-|
    'UMAC64' is the 32-bit (4 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance.
    -}
    newtype UMAC64 = UMAC64 { umac64_ctx :: SecureMem }
    instance NettleUMAC UMAC64 where
    	nu_ctx_size    = Tagged c_umac64_ctx_size
    	nu_digest_size = Tagged c_umac64_digest_size
    	nu_set_key     = Tagged c_umac64_set_key
    	nu_set_nonce   = Tagged c_umac64_set_nonce
    	nu_update      = Tagged c_umac64_update
    	nu_digest      = Tagged c_umac64_digest
    	nu_ctx         = umac64_ctx
    	nu_Ctx         = UMAC64
    INSTANCE_UMAC(UMAC64)

    {-|
    'UMAC96' is the 32-bit (4 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance.
    -}
    newtype UMAC96 = UMAC96 { umac96_ctx :: SecureMem }
    instance NettleUMAC UMAC96 where
    	nu_ctx_size    = Tagged c_umac96_ctx_size
    	nu_digest_size = Tagged c_umac96_digest_size
    	nu_set_key     = Tagged c_umac96_set_key
    	nu_set_nonce   = Tagged c_umac96_set_nonce
    	nu_update      = Tagged c_umac96_update
    	nu_digest      = Tagged c_umac96_digest
    	nu_ctx         = umac96_ctx
    	nu_Ctx         = UMAC96
    INSTANCE_UMAC(UMAC96)

    {-|
    'UMAC128' is the 32-bit (4 byte) digest variant. See 'umacInitKeyedHash' for the 'KeyedHashAlgorithm' instance.
    -}
    newtype UMAC128 = UMAC128 { umac128_ctx :: SecureMem }
    instance NettleUMAC UMAC128 where
    	nu_ctx_size    = Tagged c_umac128_ctx_size
    	nu_digest_size = Tagged c_umac128_digest_size
    	nu_set_key     = Tagged c_umac128_set_key
    	nu_set_nonce   = Tagged c_umac128_set_nonce
    	nu_update      = Tagged c_umac128_update
    	nu_digest      = Tagged c_umac128_digest
    	nu_ctx         = umac128_ctx
    	nu_Ctx         = UMAC128
    INSTANCE_UMAC(UMAC128)