blob: 6ca24d88d4fa32544d022032253033be4326f242 (
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
78
79
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Main (main) where
import Data.Word
import Foreign.Storable
import GHC.Prim
import GHC.Ptr
import GHC.Types
import System.IO.Unsafe
----------------------------------------------------------------
allocAndFreeze :: Int -> Bytes
allocAndFreeze sz = unsafePerformIO (bytesAllocRet sz)
data Bytes = Bytes (MutableByteArray# RealWorld)
data IBA = IBA (ByteArray#)
instance Show Bytes where
showsPrec p b = showsPrec p (bytesUnpackChars b)
------------------------------------------------------------------------
bytesAllocRet :: Int -> IO Bytes
bytesAllocRet (I# sz) =
IO $ \s -> case newAlignedPinnedByteArray# sz 8# s of
(# s', mba #) -> (# s', Bytes mba #)
------------------------------------------------------------------------
bytesEq :: Bytes -> Bytes -> Bool
bytesEq (Bytes m1) (Bytes m2)
| isTrue# (len /=# len') = False
| otherwise = unsafePerformIO $ IO $ \s -> loop 0# s
where
!len = sizeofMutableByteArray# m1
!len' = sizeofMutableByteArray# m2
loop i s
| isTrue# (i ==# len) = (# s, True #)
| otherwise =
case readWord8Array# m1 i s of
(# s', e1 #) ->
case readWord8Array# m2 i s' of
(# s'', e2 #) ->
if isTrue# (eqWord8# e1 e2)
then loop (i +# 1#) s''
else (# s'', False #)
bytesUnpackChars :: Bytes -> String
bytesUnpackChars (Bytes mba)
| I# (sizeofMutableByteArray# mba) == 0 = []
| otherwise = unsafePerformIO $ do
c <- IO $ \s -> case readWord8Array# mba 0# s of
(# s'', w #) -> (# s'', C# (chr# (word2Int# (word8ToWord# w))) #)
return [c]
----------------------------------------------------------------
publicKeyStream :: [Bytes]
publicKeyStream
= take 10000
$ map (go . fromIntegral) [1::Int ..]
where
go :: Word8 -> Bytes
go a = allocAndFreeze 1
main :: IO ()
main = do
let !pubK = head publicKeyStream
let (!k1) : _ = [ pk
| pk <- reverse publicKeyStream
, bytesEq pk pubK
]
print k1
|
