{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE KindSignatures             #-}

-- |
--
-- Module      : Raaz.Core.Transfer.Unsafe
-- Copyright   : (c) Piyush P Kurur, 2019
-- License     : Apache-2.0 OR BSD-3-Clause
-- Maintainer  : Piyush P Kurur <ppk@iitpkd.ac.in>
-- Stability   : experimental
--

module Raaz.Core.Transfer.Unsafe
       ( -- * Transfer actions.
         -- $transfer$
         Transfer, ReadFrom, WriteTo
       , unsafeMakeTransfer
       , unsafeTransfer
       , unsafeInterleave
       , unsafeReadIntoPtr, unsafeReadInto
       , unsafeWriteFrom
       , unsafeWriteFromPtr
       , writeByteString
       , transferSize
       ) where

import           Data.ByteString          (ByteString)
import           Data.ByteString.Internal (unsafeCreate)

import           Raaz.Core.Prelude
import           Raaz.Core.MonoidalAction
import           Raaz.Core.Types.Copying
import           Raaz.Core.Types.Endian
import           Raaz.Core.Types.Pointer
import           Raaz.Core.Encode
import           Raaz.Core.Util.ByteString as BU

-- $transfer$
--
-- Low level buffer operations are problematic portions of any
-- crypto-library. Buffers are usually represented by the starting
-- pointer and one needs to keep track of the buffer sizes
-- carefully. An operation that writes into a buffer, if it writes
-- beyond the actual size of the buffer, can lead to a possible remote
-- code execution. On the other hand, when reading from a buffer, if
-- we read beyond the buffer it can leak private data to the attacker
-- (as in the case of Heart bleed bug). This module is indented to
-- give a relatively high level interface to this problem. We expose
-- two types, the `ReadM` and the `Write` type which deals with these
-- two aspects. Both these actions keep track of the number of bytes
-- that they transfer.

-- Complex reads and writes can be constructed using the monoid
-- instance of these types.

data Mode = ReadFromBuffer
          | WriteToBuffer


-- | This monoid captures a transfer action.
newtype TransferM (t :: Mode) = TransferM { TransferM t -> IO ()
unTransferM :: IO () }

instance Semigroup (TransferM t) where
  <> :: TransferM t -> TransferM t -> TransferM t
(<>) TransferM t
wa TransferM t
wb = IO () -> TransferM t
forall (t :: Mode). IO () -> TransferM t
TransferM (IO () -> TransferM t) -> IO () -> TransferM t
forall a b. (a -> b) -> a -> b
$ TransferM t -> IO ()
forall (t :: Mode). TransferM t -> IO ()
unTransferM TransferM t
wa IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TransferM t -> IO ()
forall (t :: Mode). TransferM t -> IO ()
unTransferM TransferM t
wb
  {-# INLINE (<>) #-}

instance Monoid (TransferM t) where
  mempty :: TransferM t
mempty        = IO () -> TransferM t
forall (t :: Mode). IO () -> TransferM t
TransferM (IO () -> TransferM t) -> IO () -> TransferM t
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  {-# INLINE mempty #-}

  mappend :: TransferM t -> TransferM t -> TransferM t
mappend = TransferM t -> TransferM t -> TransferM t
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}

  mconcat :: [TransferM t] -> TransferM t
mconcat = IO () -> TransferM t
forall (t :: Mode). IO () -> TransferM t
TransferM (IO () -> TransferM t)
-> ([TransferM t] -> IO ()) -> [TransferM t] -> TransferM t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransferM t -> IO ()) -> [TransferM t] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TransferM t -> IO ()
forall (t :: Mode). TransferM t -> IO ()
unTransferM
  {-# INLINE mconcat #-}

-- | A action that transfers bytes from its input pointer. Transfer
-- could either be writing or reading.
type TransferAction t = Ptr Word8 -> TransferM t

instance LAction (BYTES Int) (TransferAction t) where
  BYTES Int
offset <.> :: BYTES Int -> TransferAction t -> TransferAction t
<.> TransferAction t
action = TransferAction t
action TransferAction t -> (Ptr Word8 -> Ptr Word8) -> TransferAction t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BYTES Int
offsetBYTES Int -> Ptr Word8 -> Ptr Word8
forall m space. LAction m space => m -> space -> space
<.>)
  {-# INLINE (<.>) #-}

instance Distributive (BYTES Int) (TransferAction t)

-- | An element of type `Tranfer t m` is an action which when executed
-- transfers bytes /into/ or out of its input buffer.  The type
-- @`Transfer` t m@ forms a monoid and hence can be concatenated using
-- the `<>` operator.

type Transfer t = SemiR (TransferAction t) (BYTES Int)

-- | Returns the bytes that will be written when the write action is performed.
transferSize :: Transfer t -> BYTES Int
transferSize :: Transfer t -> BYTES Int
transferSize = Transfer t -> BYTES Int
forall space m. SemiR space m -> m
semiRMonoid


-- | Make an explicit transfer action.
unsafeMakeTransfer :: LengthUnit u
                   => u                    -- ^ length of pointer accessed
                   -> (Ptr Word8 -> IO ()) -- ^ Pointer action to run
                   -> Transfer t
{-# INLINE unsafeMakeTransfer #-}
unsafeMakeTransfer :: u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer u
sz Ptr Word8 -> IO ()
action = (Ptr Word8 -> TransferM t) -> BYTES Int -> Transfer t
forall space m. space -> m -> SemiR space m
SemiR (IO () -> TransferM t
forall (t :: Mode). IO () -> TransferM t
TransferM (IO () -> TransferM t)
-> (Ptr Word8 -> IO ()) -> Ptr Word8 -> TransferM t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> IO ()
action) (BYTES Int -> Transfer t) -> BYTES Int -> Transfer t
forall a b. (a -> b) -> a -> b
$ u -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes u
sz


-- | This combinator runs an IO action which does not read/write any
-- bytes form the input buffer. This can be used to interleave some
-- side action in between the transfer.
unsafeInterleave :: IO a       -- ^
                 -> Transfer t
unsafeInterleave :: IO a -> Transfer t
unsafeInterleave = BYTES Int -> (Ptr Word8 -> IO ()) -> Transfer t
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer (BYTES Int
0 :: BYTES Int) ((Ptr Word8 -> IO ()) -> Transfer t)
-> (IO a -> Ptr Word8 -> IO ()) -> IO a -> Transfer t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Ptr Word8 -> IO ()
forall a b. a -> b -> a
const (IO () -> Ptr Word8 -> IO ())
-> (IO a -> IO ()) -> IO a -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

-- | Perform the transfer without checking the bounds.
unsafeTransfer :: Pointer ptr
               => Transfer t
               -> ptr a       -- ^ The pointer to the buffer to/from which transfer occurs.
               -> IO ()
unsafeTransfer :: Transfer t -> ptr a -> IO ()
unsafeTransfer Transfer t
tr = (Ptr Word8 -> IO ()) -> ptr a -> IO ()
forall (ptr :: * -> *) a b something.
Pointer ptr =>
(Ptr a -> b) -> ptr something -> b
unsafeWithPointerCast Ptr Word8 -> IO ()
transferIt
  where transferIt :: Ptr Word8 -> IO ()
transferIt = TransferM t -> IO ()
forall (t :: Mode). TransferM t -> IO ()
unTransferM (TransferM t -> IO ())
-> (Ptr Word8 -> TransferM t) -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transfer t -> Ptr Word8 -> TransferM t
forall space m. SemiR space m -> space
semiRSpace Transfer t
tr


------------------------  Read action ----------------------------

-- | The `ReadFrom` is the type that captures the act of reading from a
-- buffer and possibly doing some action on the bytes read. Although
-- inaccurate, it is helpful to think of elements of `ReadFromM` as action
-- that on an input buffer transfers data from it to some unspecified
-- source.
--
-- ReadFrom actions form a monoid with the following semantics: if @r1@
-- and @r2@ are two read actions then @r1 `<>` r2@ first reads the the
-- data associated with @r1@ and then reads the data associated with
-- @r2@.
type ReadFrom     = Transfer 'ReadFromBuffer



-- | The action @unsafeReadIntoPtr sz dptr@ gives a read action, which
-- if run on an input buffer, will transfers @sz@ bytes to the
-- destination pointer @dptr@. This action is unsafe because no checks
-- are done (or is it possible) to see if the destination pointer has
-- enough space to accommodate the bytes read.
unsafeReadIntoPtr :: (Pointer ptr, LengthUnit sz)
                  => sz               -- ^ how much to read.
                  -> Dest (ptr Word8) -- ^ buffer to read the bytes into
                  -> ReadFrom
unsafeReadIntoPtr :: sz -> Dest (ptr Word8) -> ReadFrom
unsafeReadIntoPtr sz
sz Dest (ptr Word8)
dest = sz -> (Ptr Word8 -> IO ()) -> ReadFrom
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer sz
sz
                            ((Ptr Word8 -> IO ()) -> ReadFrom)
-> (Ptr Word8 -> IO ()) -> ReadFrom
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Dest (ptr Word8) -> Src (Ptr Word8) -> sz -> IO ()
forall l (ptrS :: * -> *) (ptrD :: * -> *) dest src.
(LengthUnit l, Pointer ptrS, Pointer ptrD) =>
Dest (ptrD dest) -> Src (ptrS src) -> l -> IO ()
memcpy Dest (ptr Word8)
dest (Ptr Word8 -> Src (Ptr Word8)
forall a. a -> Src a
source Ptr Word8
ptr) sz
sz

-- | The action @unsafeReadInto n dptr@ gives a read action which if
-- run on an input buffer, will transfers @n@ elements of type @a@
-- into the buffer pointed by @dptr@. Like @unsafeReadIntoPtr@ this
-- function does no checks on the destination pointer and hence is
-- unsafe.
unsafeReadInto :: EndianStore a
               => Int             -- ^ how many elements to read.
               -> Dest (Ptr a)    -- ^ buffer to read the elements into
               -> ReadFrom
unsafeReadInto :: Int -> Dest (Ptr a) -> ReadFrom
unsafeReadInto Int
n Dest (Ptr a)
dest = BYTES Int -> (Ptr Word8 -> IO ()) -> ReadFrom
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer (Dest (Ptr a) -> BYTES Int
sz Dest (Ptr a)
dest)
                  ((Ptr Word8 -> IO ()) -> ReadFrom)
-> (Ptr Word8 -> IO ()) -> ReadFrom
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Dest (Ptr a) -> Src (Ptr Word8) -> Int -> IO ()
forall w.
EndianStore w =>
Dest (Ptr w) -> Src (Ptr Word8) -> Int -> IO ()
copyFromBytes Dest (Ptr a)
dest (Ptr Word8 -> Src (Ptr Word8)
forall a. a -> Src a
source Ptr Word8
ptr) Int
n
  where sz :: Dest (Ptr a) -> BYTES Int
sz  = BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
(*) (Int -> BYTES Int
forall a. Enum a => Int -> a
toEnum Int
n) (BYTES Int -> BYTES Int)
-> (Dest (Ptr a) -> BYTES Int) -> Dest (Ptr a) -> BYTES Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int)
-> (Dest (Ptr a) -> Proxy a) -> Dest (Ptr a) -> BYTES Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dest (Ptr a) -> Proxy a
forall a. Dest (Ptr a) -> Proxy a
proxy
        proxy :: Dest (Ptr a) -> Proxy a
        proxy :: Dest (Ptr a) -> Proxy a
proxy = Proxy a -> Dest (Ptr a) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy


-- | The `Write` is the type that captures the act of writing to a
-- buffer. Although inaccurate, it is helpful to think of elements of
-- `Write` as source of bytes of a fixed size.
--
-- Write actions form a monoid with the following semantics: if @w1@
-- and @w2@ are two write actions then @w1 `<>` w2@ first writes the
-- data associated from @w1@ and then the writes the data associated
-- with  @w2@.
type WriteTo     = Transfer 'WriteToBuffer



-- | Write many elements from the given buffer
unsafeWriteFrom :: EndianStore a => Int -> Src (Ptr a) -> WriteTo
unsafeWriteFrom :: Int -> Src (Ptr a) -> WriteTo
unsafeWriteFrom Int
n Src (Ptr a)
src = BYTES Int -> (Ptr Word8 -> IO ()) -> WriteTo
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer (Src (Ptr a) -> BYTES Int
sz Src (Ptr a)
src)
                  ((Ptr Word8 -> IO ()) -> WriteTo)
-> (Ptr Word8 -> IO ()) -> WriteTo
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Dest (Ptr Word8) -> Src (Ptr a) -> Int -> IO ()
forall w.
EndianStore w =>
Dest (Ptr Word8) -> Src (Ptr w) -> Int -> IO ()
copyToBytes (Ptr Word8 -> Dest (Ptr Word8)
forall a. a -> Dest a
destination Ptr Word8
ptr) Src (Ptr a)
src Int
n
  where sz :: Src (Ptr a) -> BYTES Int
sz = BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
(*) (Int -> BYTES Int
forall a. Enum a => Int -> a
toEnum Int
n) (BYTES Int -> BYTES Int)
-> (Src (Ptr a) -> BYTES Int) -> Src (Ptr a) -> BYTES Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int)
-> (Src (Ptr a) -> Proxy a) -> Src (Ptr a) -> BYTES Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Src (Ptr a) -> Proxy a
forall a. Src (Ptr a) -> Proxy a
proxy
        proxy :: Src (Ptr a) -> Proxy a
        proxy :: Src (Ptr a) -> Proxy a
proxy = Proxy a -> Src (Ptr a) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy



-- | The action @writeFromPtr sz sptr@ gives a write action, which if
-- run on an input buffer @buf@, will transfers @sz@ bytes from the
-- source pointer @sptr@ to the given buffer. Note that it is the
-- responsibility of the user to make sure that the input buffer @buf@
-- has enough space to receive @sz@ units of data if and when the read
-- action is executed.
--
unsafeWriteFromPtr ::(Pointer ptr, LengthUnit sz)
                   => sz
                   -> Src (ptr Word8)
                   -> WriteTo
unsafeWriteFromPtr :: sz -> Src (ptr Word8) -> WriteTo
unsafeWriteFromPtr sz
sz Src (ptr Word8)
src = sz -> (Ptr Word8 -> IO ()) -> WriteTo
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer sz
sz
                            ((Ptr Word8 -> IO ()) -> WriteTo)
-> (Ptr Word8 -> IO ()) -> WriteTo
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
ptr -> Dest (Ptr Word8) -> Src (ptr Word8) -> sz -> IO ()
forall l (ptrS :: * -> *) (ptrD :: * -> *) dest src.
(LengthUnit l, Pointer ptrS, Pointer ptrD) =>
Dest (ptrD dest) -> Src (ptrS src) -> l -> IO ()
memcpy (Ptr Word8 -> Dest (Ptr Word8)
forall a. a -> Dest a
destination Ptr Word8
ptr) Src (ptr Word8)
src sz
sz



instance IsString WriteTo where
  fromString :: String -> WriteTo
fromString = ByteString -> WriteTo
writeByteString (ByteString -> WriteTo)
-> (String -> ByteString) -> String -> WriteTo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString

instance Encodable WriteTo where
  {-# INLINE toByteString #-}
  toByteString :: WriteTo -> ByteString
toByteString WriteTo
w  = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
n ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ WriteTo -> Ptr Word8 -> IO ()
forall (ptr :: * -> *) (t :: Mode) a.
Pointer ptr =>
Transfer t -> ptr a -> IO ()
unsafeTransfer WriteTo
w
    where BYTES Int
n = WriteTo -> BYTES Int
forall (t :: Mode). Transfer t -> BYTES Int
transferSize WriteTo
w

  {-# INLINE unsafeFromByteString #-}
  unsafeFromByteString :: ByteString -> WriteTo
unsafeFromByteString = ByteString -> WriteTo
writeByteString

  {-# INLINE fromByteString #-}
  fromByteString :: ByteString -> Maybe WriteTo
fromByteString       = WriteTo -> Maybe WriteTo
forall a. a -> Maybe a
Just (WriteTo -> Maybe WriteTo)
-> (ByteString -> WriteTo) -> ByteString -> Maybe WriteTo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> WriteTo
writeByteString



-- | Writes a strict bytestring.
writeByteString :: ByteString -> WriteTo
writeByteString :: ByteString -> WriteTo
writeByteString ByteString
bs = BYTES Int -> (Ptr Word8 -> IO ()) -> WriteTo
forall u (t :: Mode).
LengthUnit u =>
u -> (Ptr Word8 -> IO ()) -> Transfer t
unsafeMakeTransfer (ByteString -> BYTES Int
BU.length ByteString
bs) ((Ptr Word8 -> IO ()) -> WriteTo)
-> (Ptr Word8 -> IO ()) -> WriteTo
forall a b. (a -> b) -> a -> b
$ ByteString -> Ptr Word8 -> IO ()
forall (ptr :: * -> *) a.
Pointer ptr =>
ByteString -> ptr a -> IO ()
BU.unsafeCopyToPointer ByteString
bs