content: {-# 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.Types.Pointer.Internal
  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 { unTransferM :: IO () }
  
  instance Semigroup (TransferM t) where
    (<>) wa wb = TransferM $ unTransferM wa >> unTransferM wb
    {-# INLINE (<>) #-}
  
  instance Monoid (TransferM t) where
    mempty        = TransferM $ return ()
    {-# INLINE mempty #-}
  
    mappend = (<>)
    {-# INLINE mappend #-}
  
    mconcat = TransferM . mapM_ 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
    offset <.> action = action . (offset<.>)
    {-# 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 = 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 sz action = SemiR (TransferM . action) $ inBytes 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 = unsafeMakeTransfer (0 :: BYTES Int) . const . 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 tr = unsafeWithPointerCast transferIt
    where transferIt = unTransferM . semiRSpace 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 = unsafeMakeTransfer sz
                              $ \ ptr -> memcpy dest (source ptr) 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 n dest = unsafeMakeTransfer (sz dest)
                    $ \ ptr -> copyFromBytes dest (source ptr) n
    where sz  = (*) (toEnum n) . sizeOf . proxy
          proxy :: Dest (Ptr a) -> Proxy a
          proxy = const 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 n src = unsafeMakeTransfer (sz src)
                    $ \ ptr -> copyToBytes (destination ptr) src n
    where sz = (*) (toEnum n) . sizeOf . proxy
          proxy :: Src (Ptr a) -> Proxy a
          proxy = const 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 = unsafeMakeTransfer sz
                              $ \ ptr -> memcpy (destination ptr) src sz
  
  
  
  instance IsString WriteTo where
    fromString = writeByteString . fromString
  
  instance Encodable WriteTo where
    {-# INLINE toByteString #-}
    toByteString w  = unsafeCreate n $ unsafeTransfer w
      where BYTES n = transferSize w
  
    {-# INLINE unsafeFromByteString #-}
    unsafeFromByteString = writeByteString
  
    {-# INLINE fromByteString #-}
    fromByteString       = Just . writeByteString
  
  
  
  -- | Writes a strict bytestring.
  writeByteString :: ByteString -> WriteTo
  writeByteString bs = unsafeMakeTransfer (BU.length bs) $ BU.unsafeCopyToPointer bs
  