77 lines
2.8 KiB
Haskell
77 lines
2.8 KiB
Haskell
{-# 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) |