{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
--
-- Module: Sel.HMAC.SHA512
-- Description: HMAC-SHA-512
-- Copyright: (C) Hécate Moonlight 2022
-- License: BSD-3-Clause
-- Maintainer: The Haskell Cryptography Group
-- Portability: GHC only
module Sel.HMAC.SHA512
  ( -- ** Introduction
    -- $introduction

    -- ** Usage
    -- $usage

    -- ** Operations

    -- *** Authenticating a single messsage
    authenticate

    -- *** Authenticating a multi-part message
  , Multipart
  , withMultipart
  , updateMultipart

    -- *** Verifying a message
  , verify

    -- ** Authentication key
  , AuthenticationKey
  , newAuthenticationKey
  , authenticationKeyFromHexByteString
  , unsafeAuthenticationKeyToHexByteString
  , unsafeAuthenticationKeyToBinary

    -- ** Authentication tag
  , AuthenticationTag
  , authenticationTagToHexByteString
  , authenticationTagToBinary
  , authenticationTagFromHexByteString
  ) where

--

import Control.Monad (void, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.Base16.Types as Base16
import Data.ByteString (StrictByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Kind (Type)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Display
import Foreign (ForeignPtr, Ptr, Word8)
import qualified Foreign
import Foreign.C (CChar, CSize, CUChar, CULLong)
import Foreign.C.Error (throwErrno)
import System.IO.Unsafe (unsafeDupablePerformIO)

import LibSodium.Bindings.SHA2
  ( CryptoAuthHMACSHA512State
  , cryptoAuthHMACSHA512
  , cryptoAuthHMACSHA512Bytes
  , cryptoAuthHMACSHA512Final
  , cryptoAuthHMACSHA512Init
  , cryptoAuthHMACSHA512KeyBytes
  , cryptoAuthHMACSHA512Keygen
  , cryptoAuthHMACSHA512StateBytes
  , cryptoAuthHMACSHA512Update
  , cryptoAuthHMACSHA512Verify
  )
import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc)
import Sel.Internal (allocateWith, foreignPtrEq, foreignPtrOrd)

-- $introduction
-- The 'authenticate' function computes an authentication tag for a message and a secret key,
-- and provides a way to verify that a given tag is valid for a given message and a key.
--
-- The function computing the tag deterministic: the same @(message, key)@ tuple will always
-- produce the same output. However, even if the message is public, knowing the key is required
-- in order to be able to compute a valid tag.
-- Therefore, the key should remain confidential. The tag, however, can be public.

-- $usage
--
-- > import Sel.HMAC.SHA512 qualified as HMAC
-- >
-- > main = do
-- >   -- The parties agree on a shared secret key
-- >   authKey <- HMAC.newAuthenticationKey
-- >   -- An authentication tag is computed for the message by the server
-- >   let message = ("Hello, world!" :: StrictByteString)
-- >   tag <- HMAC.authenticate message
-- >   -- The server sends the message and its authentication tag
-- >   -- […]
-- >   -- The recipient of the message uses the shared secret to validate the message's tag
-- >   HMAC.verify tag authKey message
-- >   -- => True

-- | Compute an authentication tag for a message with a secret key shared by all parties.
--
-- @since 0.0.1.0
authenticate
  :: StrictByteString
  -- ^ Message to authenticate
  -> AuthenticationKey
  -- ^ Secret key for authentication
  -> IO AuthenticationTag
  -- ^ Cryptographic tag for authentication
authenticate :: StrictByteString -> AuthenticationKey -> IO AuthenticationTag
authenticate StrictByteString
message (AuthenticationKey ForeignPtr CUChar
authenticationKeyForeignPtr) =
  StrictByteString
-> (CStringLen -> IO AuthenticationTag) -> IO AuthenticationTag
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO AuthenticationTag) -> IO AuthenticationTag)
-> (CStringLen -> IO AuthenticationTag) -> IO AuthenticationTag
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    ForeignPtr CUChar
authenticationTagForeignPtr <-
      Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes
        (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoAuthHMACSHA512Bytes)
    ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
authenticationTagForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
authTagPtr ->
      ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
authenticationKeyForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
authKeyPtr ->
        IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
          Ptr CUChar -> Ptr CUChar -> CULLong -> Ptr CUChar -> IO CInt
cryptoAuthHMACSHA512
            Ptr CUChar
authTagPtr
            (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
cString)
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen)
            Ptr CUChar
authKeyPtr
    AuthenticationTag -> IO AuthenticationTag
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticationTag -> IO AuthenticationTag)
-> AuthenticationTag -> IO AuthenticationTag
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> AuthenticationTag
AuthenticationTag ForeignPtr CUChar
authenticationTagForeignPtr

-- ** Authenticating a multi-part message

-- | 'Multipart' is a cryptographic context for streaming hashing.
-- This API can be used when a message is too big to fit
-- in memory or when the message is received in portions.
--
-- Use it like this:
--
-- >>> secretKey <- HMAC.newSecreKey
-- >>> hash <- HMAC.withMultipart secretKey $ \multipartState -> do -- we are in MonadIO
-- ...   message1 <- getMessage
-- ...   HMAC.updateMultipart multipartState message1
-- ...   message2 <- getMessage
-- ...   HMAC.updateMultipart multipartState message2
--
-- @since 0.0.1.0
newtype Multipart s = Multipart (Ptr CryptoAuthHMACSHA512State)

type role Multipart nominal

-- | Perform streaming hashing with a 'Multipart' cryptographic context.
--
-- Use 'HMAC.updateMultipart' within the continuation.
--
-- The context is safely allocated first, then the continuation is run
-- and then it is deallocated after that.
--
-- @since 0.0.1.0
withMultipart
  :: forall (a :: Type) (m :: Type -> Type)
   . MonadIO m
  => AuthenticationKey
  -> (forall s. Multipart s -> m a)
  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context
  -> m AuthenticationTag
withMultipart :: forall a (m :: * -> *).
MonadIO m =>
AuthenticationKey
-> (forall s. Multipart s -> m a) -> m AuthenticationTag
withMultipart (AuthenticationKey ForeignPtr CUChar
secretKeyForeignPtr) forall s. Multipart s -> m a
actions = do
  CSize
-> (Ptr CryptoAuthHMACSHA512State -> m AuthenticationTag)
-> m AuthenticationTag
forall a b (m :: * -> *).
MonadIO m =>
CSize -> (Ptr a -> m b) -> m b
allocateWith CSize
cryptoAuthHMACSHA512StateBytes ((Ptr CryptoAuthHMACSHA512State -> m AuthenticationTag)
 -> m AuthenticationTag)
-> (Ptr CryptoAuthHMACSHA512State -> m AuthenticationTag)
-> m AuthenticationTag
forall a b. (a -> b) -> a -> b
$ \Ptr CryptoAuthHMACSHA512State
statePtr -> do
    IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
secretKeyForeignPtr ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
keyPtr ->
      Ptr CryptoAuthHMACSHA512State -> Ptr CUChar -> CSize -> IO CInt
cryptoAuthHMACSHA512Init Ptr CryptoAuthHMACSHA512State
statePtr Ptr CUChar
keyPtr CSize
cryptoAuthHMACSHA512KeyBytes
    let part :: Multipart s
part = Ptr CryptoAuthHMACSHA512State -> Multipart s
forall s. Ptr CryptoAuthHMACSHA512State -> Multipart s
Multipart Ptr CryptoAuthHMACSHA512State
statePtr
    Multipart Any -> m a
forall s. Multipart s -> m a
actions Multipart Any
forall {s}. Multipart s
part
    Multipart Any -> m AuthenticationTag
forall (m :: * -> *) s.
MonadIO m =>
Multipart s -> m AuthenticationTag
finaliseMultipart Multipart Any
forall {s}. Multipart s
part

-- | Compute the 'AuthenticationTag' of all the portions that were fed to the cryptographic context.
--
--  this function is only used within 'withMultipart'
--
--  @since 0.0.1.0
finaliseMultipart :: MonadIO m => Multipart s -> m AuthenticationTag
finaliseMultipart :: forall (m :: * -> *) s.
MonadIO m =>
Multipart s -> m AuthenticationTag
finaliseMultipart (Multipart Ptr CryptoAuthHMACSHA512State
statePtr) = do
  ForeignPtr CUChar
authenticatorForeignPtr <- IO (ForeignPtr CUChar) -> m (ForeignPtr CUChar)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForeignPtr CUChar) -> m (ForeignPtr CUChar))
-> IO (ForeignPtr CUChar) -> m (ForeignPtr CUChar)
forall a b. (a -> b) -> a -> b
$ Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoAuthHMACSHA512Bytes)
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
authenticatorForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CUChar
authenticatorPtr :: Ptr CUChar) ->
    IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      Ptr CryptoAuthHMACSHA512State -> Ptr CUChar -> IO CInt
cryptoAuthHMACSHA512Final
        Ptr CryptoAuthHMACSHA512State
statePtr
        Ptr CUChar
authenticatorPtr
  AuthenticationTag -> m AuthenticationTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticationTag -> m AuthenticationTag)
-> AuthenticationTag -> m AuthenticationTag
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> AuthenticationTag
AuthenticationTag ForeignPtr CUChar
authenticatorForeignPtr

-- | Add a message portion to be hashed.
--
-- This function should be used within 'withMultipart'.
--
-- @since 0.0.1.0
updateMultipart :: Multipart s -> StrictByteString -> IO ()
updateMultipart :: forall s. Multipart s -> StrictByteString -> IO ()
updateMultipart (Multipart Ptr CryptoAuthHMACSHA512State
statePtr) StrictByteString
message = do
  StrictByteString -> (CStringLen -> IO ()) -> IO ()
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    let messagePtr :: Ptr CUChar
messagePtr = forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
cString
    let messageLen :: CULLong
messageLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen
    IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      Ptr CryptoAuthHMACSHA512State -> Ptr CUChar -> CULLong -> IO CInt
cryptoAuthHMACSHA512Update
        Ptr CryptoAuthHMACSHA512State
statePtr
        Ptr CUChar
messagePtr
        CULLong
messageLen

-- | Verify that the tag is valid for the provided message and secret key.
--
-- @since 0.0.1.0
verify
  :: AuthenticationTag
  -> AuthenticationKey
  -> StrictByteString
  -> Bool
verify :: AuthenticationTag -> AuthenticationKey -> StrictByteString -> Bool
verify (AuthenticationTag ForeignPtr CUChar
tagForeignPtr) (AuthenticationKey ForeignPtr CUChar
keyForeignPtr) StrictByteString
message = IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  StrictByteString -> (CStringLen -> IO Bool) -> IO Bool
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) ->
    ForeignPtr CUChar -> (Ptr CUChar -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
tagForeignPtr ((Ptr CUChar -> IO Bool) -> IO Bool)
-> (Ptr CUChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
authTagPtr ->
      ForeignPtr CUChar -> (Ptr CUChar -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
keyForeignPtr ((Ptr CUChar -> IO Bool) -> IO Bool)
-> (Ptr CUChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
authKeyPtr -> do
        CInt
result <-
          Ptr CUChar -> Ptr CUChar -> CULLong -> Ptr CUChar -> IO CInt
cryptoAuthHMACSHA512Verify
            Ptr CUChar
authTagPtr
            (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
cString)
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen)
            Ptr CUChar
authKeyPtr
        Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt
result CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0

-- | A secret authentication key of size 'cryptoAuthHMACSHA512Bytes'.
--
-- @since 0.0.1.0
newtype AuthenticationKey = AuthenticationKey (ForeignPtr CUChar)
  deriving
    ( Int -> AuthenticationKey -> Builder
[AuthenticationKey] -> Builder
AuthenticationKey -> Builder
(AuthenticationKey -> Builder)
-> ([AuthenticationKey] -> Builder)
-> (Int -> AuthenticationKey -> Builder)
-> Display AuthenticationKey
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: AuthenticationKey -> Builder
displayBuilder :: AuthenticationKey -> Builder
$cdisplayList :: [AuthenticationKey] -> Builder
displayList :: [AuthenticationKey] -> Builder
$cdisplayPrec :: Int -> AuthenticationKey -> Builder
displayPrec :: Int -> AuthenticationKey -> Builder
Display
      -- ^ @since 0.0.1.0
      -- > display authenticatonKey == "[REDACTED]"
    )
    via (OpaqueInstance "[REDACTED]" AuthenticationKey)

-- |
--
-- @since 0.0.1.0
instance Eq AuthenticationKey where
  (AuthenticationKey ForeignPtr CUChar
hk1) == :: AuthenticationKey -> AuthenticationKey -> Bool
== (AuthenticationKey ForeignPtr CUChar
hk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoAuthHMACSHA512KeyBytes

-- |
--
-- @since 0.0.1.0
instance Ord AuthenticationKey where
  compare :: AuthenticationKey -> AuthenticationKey -> Ordering
compare (AuthenticationKey ForeignPtr CUChar
hk1) (AuthenticationKey ForeignPtr CUChar
hk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoAuthHMACSHA512KeyBytes

-- | > show authenticationKey == "[REDACTED]"
--
-- @since 0.0.1.0
instance Show AuthenticationKey where
  show :: AuthenticationKey -> String
show AuthenticationKey
_ = String
"[REDACTED]"

-- | Generate a new random secret key of size 'cryptoAuthHMACSHA512KeyBytes'.
--
-- @since 0.0.1.0
newAuthenticationKey :: IO AuthenticationKey
newAuthenticationKey :: IO AuthenticationKey
newAuthenticationKey = (Ptr CUChar -> IO ()) -> IO AuthenticationKey
newAuthenticationKeyWith Ptr CUChar -> IO ()
cryptoAuthHMACSHA512Keygen

-- | Prepare memory for a 'AuthenticationKey' and use the provided action to fill it.
--
-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc'
-- (see the note attached there).
-- A finalizer is run when the key is goes out of scope.
newAuthenticationKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO AuthenticationKey
newAuthenticationKeyWith :: (Ptr CUChar -> IO ()) -> IO AuthenticationKey
newAuthenticationKeyWith Ptr CUChar -> IO ()
action = do
  Ptr CUChar
ptr <- CSize -> IO (Ptr CUChar)
forall a. CSize -> IO (Ptr a)
sodiumMalloc CSize
cryptoAuthHMACSHA512KeyBytes
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr CUChar
ptr Ptr CUChar -> Ptr CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CUChar
forall a. Ptr a
Foreign.nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
forall a. String -> IO a
throwErrno String
"sodium_malloc"

  ForeignPtr CUChar
fPtr <- Ptr CUChar -> IO (ForeignPtr CUChar)
forall a. Ptr a -> IO (ForeignPtr a)
Foreign.newForeignPtr_ Ptr CUChar
ptr
  FinalizerPtr CUChar -> ForeignPtr CUChar -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
Foreign.addForeignPtrFinalizer FinalizerPtr CUChar
forall a. FinalizerPtr a
finalizerSodiumFree ForeignPtr CUChar
fPtr
  Ptr CUChar -> IO ()
action Ptr CUChar
ptr
  AuthenticationKey -> IO AuthenticationKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthenticationKey -> IO AuthenticationKey)
-> AuthenticationKey -> IO AuthenticationKey
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> AuthenticationKey
AuthenticationKey ForeignPtr CUChar
fPtr

-- | Create an 'AuthenticationKey' from a binary 'StrictByteString' that you have obtained on your own,
-- usually from the network or disk.
--
-- The input secret key, once decoded from base16, must be of length
-- 'cryptoAuthHMACSHA512Bytes'.
--
-- @since 0.0.1.0
authenticationKeyFromHexByteString :: StrictByteString -> Either Text AuthenticationKey
authenticationKeyFromHexByteString :: StrictByteString -> Either Text AuthenticationKey
authenticationKeyFromHexByteString StrictByteString
hexKey = IO (Either Text AuthenticationKey) -> Either Text AuthenticationKey
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text AuthenticationKey)
 -> Either Text AuthenticationKey)
-> IO (Either Text AuthenticationKey)
-> Either Text AuthenticationKey
forall a b. (a -> b) -> a -> b
$
  case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped StrictByteString
hexKey of
    Right StrictByteString
bytestring ->
      if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoAuthHMACSHA512KeyBytes
        then StrictByteString
-> (CStringLen -> IO (Either Text AuthenticationKey))
-> IO (Either Text AuthenticationKey)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text AuthenticationKey))
 -> IO (Either Text AuthenticationKey))
-> (CStringLen -> IO (Either Text AuthenticationKey))
-> IO (Either Text AuthenticationKey)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideAuthenticationKeyPtr, Int
_) ->
          (AuthenticationKey -> Either Text AuthenticationKey)
-> IO AuthenticationKey -> IO (Either Text AuthenticationKey)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthenticationKey -> Either Text AuthenticationKey
forall a b. b -> Either a b
Right (IO AuthenticationKey -> IO (Either Text AuthenticationKey))
-> IO AuthenticationKey -> IO (Either Text AuthenticationKey)
forall a b. (a -> b) -> a -> b
$
            (Ptr CUChar -> IO ()) -> IO AuthenticationKey
newAuthenticationKeyWith ((Ptr CUChar -> IO ()) -> IO AuthenticationKey)
-> (Ptr CUChar -> IO ()) -> IO AuthenticationKey
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
authenticationKeyPtr ->
              Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray
                (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CUChar @CChar Ptr CUChar
authenticationKeyPtr)
                Ptr CChar
outsideAuthenticationKeyPtr
                (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoAuthHMACSHA512KeyBytes)
        else Either Text AuthenticationKey -> IO (Either Text AuthenticationKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text AuthenticationKey
 -> IO (Either Text AuthenticationKey))
-> Either Text AuthenticationKey
-> IO (Either Text AuthenticationKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text AuthenticationKey
forall a b. a -> Either a b
Left (Text -> Either Text AuthenticationKey)
-> Text -> Either Text AuthenticationKey
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Authentication Key is too short"
    Left Text
msg -> Either Text AuthenticationKey -> IO (Either Text AuthenticationKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text AuthenticationKey
 -> IO (Either Text AuthenticationKey))
-> Either Text AuthenticationKey
-> IO (Either Text AuthenticationKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text AuthenticationKey
forall a b. a -> Either a b
Left Text
msg

-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.
--
-- This format is useful if you need conversion to base32 or base64.
--
-- ⚠️  Be prudent as to where you store it!
--
-- @since 0.0.1.0
unsafeAuthenticationKeyToBinary :: AuthenticationKey -> StrictByteString
unsafeAuthenticationKeyToBinary :: AuthenticationKey -> StrictByteString
unsafeAuthenticationKeyToBinary (AuthenticationKey ForeignPtr CUChar
authenticationKeyForeignPtr) =
  ForeignPtr Word8 -> Int -> StrictByteString
BS.fromForeignPtr0
    (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CUChar @Word8 ForeignPtr CUChar
authenticationKeyForeignPtr)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
cryptoAuthHMACSHA512KeyBytes)

-- | Convert a 'AuthenticationKey to a hexadecimal-encoded 'StrictByteString'.
--
-- ⚠️  Be prudent as to where you store it!
--
-- @since 0.0.1.0
unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString
unsafeAuthenticationKeyToHexByteString :: AuthenticationKey -> StrictByteString
unsafeAuthenticationKeyToHexByteString =
  Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> (AuthenticationKey -> Base16 StrictByteString)
-> AuthenticationKey
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> Base16 StrictByteString)
-> (AuthenticationKey -> StrictByteString)
-> AuthenticationKey
-> Base16 StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthenticationKey -> StrictByteString
unsafeAuthenticationKeyToBinary

-- | A secret authentication key of size 'cryptoAuthHMACSHA512Bytes'.
--
-- @since 0.0.1.0
newtype AuthenticationTag = AuthenticationTag (ForeignPtr CUChar)
  deriving
    ( Int -> AuthenticationTag -> Builder
[AuthenticationTag] -> Builder
AuthenticationTag -> Builder
(AuthenticationTag -> Builder)
-> ([AuthenticationTag] -> Builder)
-> (Int -> AuthenticationTag -> Builder)
-> Display AuthenticationTag
forall a.
(a -> Builder)
-> ([a] -> Builder) -> (Int -> a -> Builder) -> Display a
$cdisplayBuilder :: AuthenticationTag -> Builder
displayBuilder :: AuthenticationTag -> Builder
$cdisplayList :: [AuthenticationTag] -> Builder
displayList :: [AuthenticationTag] -> Builder
$cdisplayPrec :: Int -> AuthenticationTag -> Builder
displayPrec :: Int -> AuthenticationTag -> Builder
Display
      -- ^ @since 0.0.1.0
    )
    via (ShowInstance AuthenticationTag)

-- |
--
-- @since 0.0.1.0
instance Eq AuthenticationTag where
  (AuthenticationTag ForeignPtr CUChar
hk1) == :: AuthenticationTag -> AuthenticationTag -> Bool
== (AuthenticationTag ForeignPtr CUChar
hk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoAuthHMACSHA512Bytes

-- |
--
-- @since 0.0.1.0
instance Ord AuthenticationTag where
  compare :: AuthenticationTag -> AuthenticationTag -> Ordering
compare (AuthenticationTag ForeignPtr CUChar
hk1) (AuthenticationTag ForeignPtr CUChar
hk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoAuthHMACSHA512Bytes

-- |
--
-- @since 0.0.1.0
instance Show AuthenticationTag where
  show :: AuthenticationTag -> String
show = StrictByteString -> String
BS.unpackChars (StrictByteString -> String)
-> (AuthenticationTag -> StrictByteString)
-> AuthenticationTag
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthenticationTag -> StrictByteString
authenticationTagToHexByteString

-- | Convert an 'AuthenticationTag' to a hexadecimal-encoded 'StrictByteString'.
--
-- @since 0.0.1.0
authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString
authenticationTagToHexByteString :: AuthenticationTag -> StrictByteString
authenticationTagToHexByteString AuthenticationTag
authenticationTag =
  Base16 StrictByteString -> StrictByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 StrictByteString -> StrictByteString)
-> Base16 StrictByteString -> StrictByteString
forall a b. (a -> b) -> a -> b
$
    StrictByteString -> Base16 StrictByteString
Base16.encodeBase16' (StrictByteString -> Base16 StrictByteString)
-> StrictByteString -> Base16 StrictByteString
forall a b. (a -> b) -> a -> b
$
      AuthenticationTag -> StrictByteString
authenticationTagToBinary AuthenticationTag
authenticationTag

-- | Convert an 'AuthenticationTag' to a binary 'StrictByteString'.
--
-- @since 0.0.1.0
authenticationTagToBinary :: AuthenticationTag -> StrictByteString
authenticationTagToBinary :: AuthenticationTag -> StrictByteString
authenticationTagToBinary (AuthenticationTag ForeignPtr CUChar
fPtr) =
  ForeignPtr Word8 -> Int -> StrictByteString
BS.fromForeignPtr0
    (ForeignPtr CUChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr ForeignPtr CUChar
fPtr)
    (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoAuthHMACSHA512Bytes)

-- | Create an 'AuthenticationTag' from a binary 'StrictByteString' that you have obtained on your own,
-- usually from the network or disk.
--
-- The input secret key, once decoded from base16, must be of length
-- 'cryptoAuthHMACSHA512Bytes'.
--
-- @since 0.0.1.0
authenticationTagFromHexByteString :: StrictByteString -> Either Text AuthenticationTag
authenticationTagFromHexByteString :: StrictByteString -> Either Text AuthenticationTag
authenticationTagFromHexByteString StrictByteString
hexTag = IO (Either Text AuthenticationTag) -> Either Text AuthenticationTag
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either Text AuthenticationTag)
 -> Either Text AuthenticationTag)
-> IO (Either Text AuthenticationTag)
-> Either Text AuthenticationTag
forall a b. (a -> b) -> a -> b
$
  case StrictByteString -> Either Text StrictByteString
Base16.decodeBase16Untyped StrictByteString
hexTag of
    Right StrictByteString
bytestring ->
      if StrictByteString -> Int
BS.length StrictByteString
bytestring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoAuthHMACSHA512Bytes
        then StrictByteString
-> (CStringLen -> IO (Either Text AuthenticationTag))
-> IO (Either Text AuthenticationTag)
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen StrictByteString
bytestring ((CStringLen -> IO (Either Text AuthenticationTag))
 -> IO (Either Text AuthenticationTag))
-> (CStringLen -> IO (Either Text AuthenticationTag))
-> IO (Either Text AuthenticationTag)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
outsideTagPtr, Int
outsideTagLength) -> do
          ForeignPtr CChar
hashForeignPtr <- forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString @CChar Int
outsideTagLength -- The foreign pointer that will receive the hash data.
          ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CChar
hashForeignPtr ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
hashPtr ->
            -- We copy bytes from 'outsideTagPtr' to 'hashPtr'.
            Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CChar
hashPtr Ptr CChar
outsideTagPtr Int
outsideTagLength
          Either Text AuthenticationTag -> IO (Either Text AuthenticationTag)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text AuthenticationTag
 -> IO (Either Text AuthenticationTag))
-> Either Text AuthenticationTag
-> IO (Either Text AuthenticationTag)
forall a b. (a -> b) -> a -> b
$
            AuthenticationTag -> Either Text AuthenticationTag
forall a b. b -> Either a b
Right (AuthenticationTag -> Either Text AuthenticationTag)
-> AuthenticationTag -> Either Text AuthenticationTag
forall a b. (a -> b) -> a -> b
$
              ForeignPtr CUChar -> AuthenticationTag
AuthenticationTag
                (forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr @CChar @CUChar ForeignPtr CChar
hashForeignPtr)
        else Either Text AuthenticationTag -> IO (Either Text AuthenticationTag)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text AuthenticationTag
 -> IO (Either Text AuthenticationTag))
-> Either Text AuthenticationTag
-> IO (Either Text AuthenticationTag)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text AuthenticationTag
forall a b. a -> Either a b
Left (Text -> Either Text AuthenticationTag)
-> Text -> Either Text AuthenticationTag
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"Authentication tag is too short"
    Left Text
msg -> Either Text AuthenticationTag -> IO (Either Text AuthenticationTag)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text AuthenticationTag
 -> IO (Either Text AuthenticationTag))
-> Either Text AuthenticationTag
-> IO (Either Text AuthenticationTag)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text AuthenticationTag
forall a b. a -> Either a b
Left Text
msg