aboutsummaryrefslogtreecommitdiff
path: root/src/BTLS/BoringSSLPatterns.hs
blob: e77abcb48208ac535525af485fceb95974af9e1a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
-- Copyright 2017 Google LLC
--
-- Licensed under the Apache License, Version 2.0 (the "License"); you may not
-- use this file except in compliance with the License. You may obtain a copy of
-- the License at
--
--     https://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-- License for the specific language governing permissions and limitations under
-- the License.

module BTLS.BoringSSLPatterns
  ( initUpdateFinalize
  , onBufferOfMaxSize
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe as ByteString
import qualified Data.ByteString.Lazy as ByteString.Lazy
import Foreign (ForeignPtr, Storable(peek), Ptr, alloca, allocaArray, withForeignPtr)
import Foreign.C.Types

import BTLS.BoringSSL.Digest (evpMaxMDSize)

type LazyByteString = ByteString.Lazy.ByteString

-- | Encapsulates a common pattern of operation between hashing and HMAC
-- computation. Both of these operations require an allocated context local to
-- the operation. The context gets initialized once, updated repeatedly, and
-- then finalized. Finally, we read the result out of a buffer produced by the
-- finalizer.
--
-- The updater must not mutate any argument other than the context.
--
-- If all arguments are safe to use under 'unsafeLocalState', this whole
-- function is safe to use under 'unsafeLocalState'.
initUpdateFinalize ::
     IO (ForeignPtr ctx)
  -> (Ptr ctx -> IO ())
  -> (Ptr ctx -> Ptr CChar -> CULong -> IO ())
  -> (Ptr ctx -> Ptr CChar -> Ptr CUInt -> IO ())
  -> LazyByteString
  -> IO ByteString
initUpdateFinalize mallocCtx initialize update finalize bytes = do
  ctxFP <- mallocCtx
  withForeignPtr ctxFP $ \ctx -> do
    initialize ctx
    mapM_ (updateBytes ctx) (ByteString.Lazy.toChunks bytes)
    onBufferOfMaxSize evpMaxMDSize (finalize ctx)
  where
    updateBytes ctx chunk =
      -- The updater won't mutate its arguments, so the sharing inherent in
      -- 'ByteString.unsafeUseAsCStringLen' is fine.
      ByteString.unsafeUseAsCStringLen chunk $ \(buf, len) ->
        update ctx buf (fromIntegral len)

-- | Allocates a buffer, runs a function 'f' to partially fill it, and packs the
-- filled data into a 'ByteString'. 'f' must write the size of the filled data,
-- in bytes and not including any trailing null, into its second argument.
--
-- If 'f' is safe to use under 'unsafeLocalState', this whole function is safe
-- to use under 'unsafeLocalState'.
onBufferOfMaxSize ::
     (Integral size, Storable size)
  => Int
  -> (Ptr CChar -> Ptr size -> IO ())
  -> IO ByteString
onBufferOfMaxSize maxSize f =
  allocaArray maxSize $ \pOut ->
    alloca $ \pOutLen -> do
      f pOut pOutLen
      outLen <- fromIntegral <$> peek pOutLen
      ByteString.packCStringLen (pOut, outLen)