{-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-}

-- SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@uniworx.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

-- | Missing instances for saltine@0.1.1.1, backported from saltine@0.2.0.0
module Crypto.Saltine.Instances () where

import ClassyPrelude hiding (compare)

import Crypto.Saltine.Class
import Crypto.Saltine.Core.Auth hiding (Key)
import Crypto.Saltine.Core.SecretBox
import Crypto.Saltine.Core.Hash
import Crypto.Saltine.Internal.ByteSizes (shorthashKey)

import Data.ByteString.Unsafe
import Foreign.C
import Foreign.Marshal.Alloc    (mallocBytes)
import Foreign.Ptr
import System.IO.Unsafe

import qualified Data.ByteString       as S
import qualified Data.ByteString.Char8 as S8
import Data.Maybe (fromJust)


-- | Used for our `Show` instances
nullShKey :: ShorthashKey
nullShKey = fromJust . decode $ S8.replicate shorthashKey '\NUL'

-- | Extremely unsafe function, use with utmost care! Builds a new
-- ByteString using a ccall which is given access to the raw underlying
-- pointer. Overwrites are UNCHECKED and 'unsafePerformIO' is used so
-- it's difficult to predict the timing of the 'ByteString' creation.
buildUnsafeByteString :: Int -> (Ptr CChar -> IO b) -> (b, ByteString)
buildUnsafeByteString n = unsafePerformIO . buildUnsafeByteString' n

-- | Slightly safer cousin to 'buildUnsafeByteString' that remains in the
-- 'IO' monad.
buildUnsafeByteString' :: Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' n k = do
  ph  <- mallocBytes n
  bs  <- unsafePackMallocCStringLen (ph, n)
  out <- unsafeUseAsCString bs k
  return (out, bs)

-- | Convenience function for accessing constant C strings
constByteStrings :: [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings =
  foldr (\v kk k -> unsafeUseAsCStringLen v (\a -> kk (\as -> k (a:as)))) ($ [])

-- | bin2hex conversion for showing various binary types
foreign import ccall unsafe "sodium_bin2hex"
  c_sodium_bin2hex
    :: Ptr CChar            -- Target zone
    -> CInt                 -- Max. length of target string (must be min. bin_len * 2 + 1)
    -> Ptr CChar            -- Source
    -> CInt                 -- Source length
    -> IO (Ptr CChar)

bin2hex :: ByteString -> String
bin2hex bs = let tlen = S.length bs * 2 + 1 in
    S8.unpack . S8.init . snd . buildUnsafeByteString tlen $ \t ->
      let aux [(pbs, _)] = c_sodium_bin2hex t (fromIntegral tlen) pbs (fromIntegral $ S.length bs)
          aux _          = error "Crypto.Saltine.Instances.bin2hex reached an impossible computation path"
      in constByteStrings [bs] aux

instance Show Key where
    show k = "SecretBox.Key {hashesTo = \"" <> (bin2hex . shorthash nullShKey $ encode k) <> "}\""

instance Show Nonce where
    show k = "SecretBox.Nonce " <> bin2hex (encode k)

instance Show Authenticator where
    show k = "Sign.Authenticator " <> bin2hex (encode k)