1-- |
2-- Module      : Crypto.Internal.WordArray
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : stable
6-- Portability : Good
7--
8-- Small and self contained array representation
9-- with limited safety for internal use.
10--
11-- The array produced should never be exposed to the user directly.
12--
13{-# LANGUAGE BangPatterns #-}
14{-# LANGUAGE MagicHash #-}
15{-# LANGUAGE UnboxedTuples #-}
16module Crypto.Internal.WordArray
17    ( Array8
18    , Array32
19    , Array64
20    , MutableArray32
21    , array8
22    , array32
23    , array32FromAddrBE
24    , allocArray32AndFreeze
25    , mutableArray32
26    , array64
27    , arrayRead8
28    , arrayRead32
29    , arrayRead64
30    , mutableArrayRead32
31    , mutableArrayWrite32
32    , mutableArrayWriteXor32
33    , mutableArray32FromAddrBE
34    , mutableArray32Freeze
35    ) where
36
37import Data.Word
38import Data.Bits (xor)
39import Crypto.Internal.Compat
40import Crypto.Internal.CompatPrim
41import GHC.Prim
42import GHC.Types
43import GHC.Word
44
45-- | Array of Word8
46data Array8 = Array8 Addr#
47
48-- | Array of Word32
49data Array32 = Array32 ByteArray#
50
51-- | Array of Word64
52data Array64 = Array64 ByteArray#
53
54-- | Array of mutable Word32
55data MutableArray32 = MutableArray32 (MutableByteArray# RealWorld)
56
57-- | Create an array of Word8 aliasing an Addr#
58array8 :: Addr# -> Array8
59array8 = Array8
60
61-- | Create an Array of Word32 of specific size from a list of Word32
62array32 :: Int -> [Word32] -> Array32
63array32 n l = unsafeDoIO (mutableArray32 n l >>= mutableArray32Freeze)
64{-# NOINLINE array32 #-}
65
66-- | Create an Array of BE Word32 aliasing an Addr
67array32FromAddrBE :: Int -> Addr# -> Array32
68array32FromAddrBE n a =
69    unsafeDoIO (mutableArray32FromAddrBE n a >>= mutableArray32Freeze)
70{-# NOINLINE array32FromAddrBE #-}
71
72-- | Create an Array of Word32 using an initializer
73allocArray32AndFreeze :: Int -> (MutableArray32 -> IO ()) -> Array32
74allocArray32AndFreeze n f =
75    unsafeDoIO (mutableArray32 n [] >>= \m -> f m >> mutableArray32Freeze m)
76{-# NOINLINE allocArray32AndFreeze #-}
77
78-- | Create an Array of Word64 of specific size from a list of Word64
79array64 :: Int -> [Word64] -> Array64
80array64 (I# n) l = unsafeDoIO $ IO $ \s ->
81    case newAlignedPinnedByteArray# (n *# 8#) 8# s of
82        (# s', mbarr #) -> loop 0# s' mbarr l
83  where
84        loop _ st mb [] = freezeArray mb st
85        loop i st mb ((W64# x):xs)
86            | booleanPrim (i ==# n) = freezeArray mb st
87            | otherwise =
88                let !st' = writeWord64Array# mb i x st
89                 in loop (i +# 1#) st' mb xs
90        freezeArray mb st =
91            case unsafeFreezeByteArray# mb st of
92                (# st', b #) -> (# st', Array64 b #)
93{-# NOINLINE array64 #-}
94
95-- | Create a Mutable Array of Word32 of specific size from a list of Word32
96mutableArray32 :: Int -> [Word32] -> IO MutableArray32
97mutableArray32 (I# n) l = IO $ \s ->
98    case newAlignedPinnedByteArray# (n *# 4#) 4# s of
99        (# s', mbarr #) -> loop 0# s' mbarr l
100  where
101        loop _ st mb [] = (# st, MutableArray32 mb #)
102        loop i st mb ((W32# x):xs)
103            | booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
104            | otherwise =
105                let !st' = writeWord32Array# mb i x st
106                 in loop (i +# 1#) st' mb xs
107
108-- | Create a Mutable Array of BE Word32 aliasing an Addr
109mutableArray32FromAddrBE :: Int -> Addr# -> IO MutableArray32
110mutableArray32FromAddrBE (I# n) a = IO $ \s ->
111    case newAlignedPinnedByteArray# (n *# 4#) 4# s of
112        (# s', mbarr #) -> loop 0# s' mbarr
113  where
114        loop i st mb
115            | booleanPrim (i ==# n) = (# st, MutableArray32 mb #)
116            | otherwise             =
117                let !st' = writeWord32Array# mb i (be32Prim (indexWord32OffAddr# a i)) st
118                 in loop (i +# 1#) st' mb
119
120-- | freeze a Mutable Array of Word32 into a immutable Array of Word32
121mutableArray32Freeze :: MutableArray32 -> IO Array32
122mutableArray32Freeze (MutableArray32 mb) = IO $ \st ->
123    case unsafeFreezeByteArray# mb st of
124        (# st', b #) -> (# st', Array32 b #)
125
126-- | Read a Word8 from an Array
127arrayRead8 :: Array8 -> Int -> Word8
128arrayRead8 (Array8 a) (I# o) = W8# (indexWord8OffAddr# a o)
129{-# INLINE arrayRead8 #-}
130
131-- | Read a Word32 from an Array
132arrayRead32 :: Array32 -> Int -> Word32
133arrayRead32 (Array32 b) (I# o) = W32# (indexWord32Array# b o)
134{-# INLINE arrayRead32 #-}
135
136-- | Read a Word64 from an Array
137arrayRead64 :: Array64 -> Int -> Word64
138arrayRead64 (Array64 b) (I# o) = W64# (indexWord64Array# b o)
139{-# INLINE arrayRead64 #-}
140
141-- | Read a Word32 from a Mutable Array of Word32
142mutableArrayRead32 :: MutableArray32 -> Int -> IO Word32
143mutableArrayRead32 (MutableArray32 m) (I# o) = IO $ \s -> case readWord32Array# m o s of (# s', e #) -> (# s', W32# e #)
144{-# INLINE mutableArrayRead32 #-}
145
146-- | Write a Word32 from a Mutable Array of Word32
147mutableArrayWrite32 :: MutableArray32 -> Int -> Word32 -> IO ()
148mutableArrayWrite32 (MutableArray32 m) (I# o) (W32# w) = IO $ \s -> let !s' = writeWord32Array# m o w s in (# s', () #)
149{-# INLINE mutableArrayWrite32 #-}
150
151-- | Write into the Mutable Array of Word32 by combining through xor the current value and the new value.
152--
153-- > x[i] = x[i] xor value
154mutableArrayWriteXor32 :: MutableArray32 -> Int -> Word32 -> IO ()
155mutableArrayWriteXor32 m o w =
156    mutableArrayRead32 m o >>= \wOld -> mutableArrayWrite32 m o (wOld `xor` w)
157{-# INLINE mutableArrayWriteXor32 #-}
158