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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
| #!/usr/bin/env stack
{- stack
--resolver lts-12.0
--install-ghc
script
--ghc-options -Werror
--ghc-options -Wall
--package bytestring
--package random
--
-}
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
--------------------------------------------------------------------------------
module Main (main) where
--------------------------------------------------------------------------------
import Data.Bits
( Bits
, shiftL
, shiftR
, xor
, (.&.)
)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Word
( Word8
)
import Prelude hiding
( min
)
import System.Random
( newStdGen
, randomRs
)
--------------------------------------------------------------------------------
-- FNV Hash
--
-- http://isthe.com/chongo/tech/comp/fnv/#FNV-1a
data FNV
= B0032
| B0064
| B0128
{-
| B0256
| B0512
| B1024
-}
instance Show FNV where
show B0032 = " 32"
show B0064 = " 64"
show B0128 = "128"
fnvprm :: FNV -> Integer
fnvprm B0032 = 16777619
fnvprm B0064 = 1099511628211
fnvprm B0128 = 309485009821345068724781371
offset :: FNV -> Integer
offset B0032 = 2166136261
offset B0064 = 14695981039346656037
offset B0128 = 144066263297769815596495629667062367629
binary :: FNV -> Integer
binary B0032 = 4294967295
binary B0064 = 18446744073709551615
binary B0128 = 340282366920938463463374607431768211455
fnv1a :: FNV -> BS.ByteString -> Integer
fnv1a b =
foldl ( \ a x -> ((a `xor` x) * prm) .&. bin) off . aux . BS.unpack
where
aux = map fromIntegral
prm = fnvprm b
off = offset b
bin = binary b
--------------------------------------------------------------------------------
(.<.) :: Bits a => a -> Int -> a
(.>.) :: Bits a => a -> Int -> a
(.<.) x y = x `shiftL` y
(.>.) x y = x `shiftR` y
toBase
:: Int
-> (Integer -> Integer)
-> Integer
-> BS.ByteString
toBase base f =
LBS.toStrict . aux ""
where
aux acc 0 = acc
aux acc n =
aux (LBS.cons r acc) c
where
c = n .>. base
r = toEnum . fromIntegral $ f (n - c * 1 .<. base)
toByte
:: Integer
-> BS.ByteString
toByte =
toBase 8 {- 2^8 = 256 -} id
digest :: Integer -> BS.ByteString
digest =
toByte
--------------------------------------------------------------------------------
seeds :: Int -> IO BS.ByteString
seeds n =
LBS.toStrict . LBS.pack . take n . randomRs (0,255) <$> newStdGen
--------------------------------------------------------------------------------
hlp :: FNV -> BS.ByteString -> Word8 -> Integer
hlp bits seed n =
aux (hash seed) n
where
hash = fnv1a bits
aux c 0 = c
aux c i = aux (hash $ digest $ c) (i - 1)
carol :: FNV -> Word8 -> Word8 -> BS.ByteString -> Integer
carol bits age prove seed =
hlp bits seed (max 0 $ age - prove)
alice :: FNV -> Word8 -> BS.ByteString -> Integer
alice bits age seed =
hlp bits seed age
bobby :: FNV -> Word8 -> BS.ByteString -> Integer
bobby bits prove seed =
hlp bits seed (prove - 1)
action01 :: FNV -> Word8 -> IO (Integer, Integer)
action01 bits must =
-- Alice moved from Europe to the States to study abroad a semester.
--
-- As she is used to go to parties and drink, she would like to see how
-- `College` parties are in the States. She knows that the drinking age in the
-- States is 21, but that's fine as She is 22.
--
-- What she dislikes is that she will have to walk around with her passport,
-- which is the only official documentation that has the information,
-- specially because she is afraid that students checking IDs will just take a
-- picture of her passport with their mobile phones and misuse her personal
-- information. As somebody from Europe, Alice is very GDPR-aware.
--
-- She speaks with her Faculty's Dean (Carol) to see if she can help.
--
-- Carol, who is respected by everybody at the Campus, decides to help by
-- providing a `proof` that states that Alice is actually allowed to drink at
-- College parties. Carol prints the value of the `proof` to a business card
-- and sings it.
--
-- In order to ensure that other students can check whether Alice is allowed
-- to drink while the `proof` is not a fake, she gives the `seed`, used for
-- the `proof`, to Alice for her to create an `obfuscated` value of her age.
seeds 32 >>= \ seed ->
(pure $ carol bits age must seed) >>= \ bc01 ->
-- Alice calculates the value and also prints it to another business card
(pure $ alice bits age seed) >>= \ bc02 ->
pure $ (bc01, bc02)
where
age = 22
action02 :: FNV -> Word8 -> (Integer, Integer) -> Bool
action02 bits must (proof, obfus) =
-- Bobby stands at the door and is checking students for IDs. When he asks
-- Alice for ID, she says that she doesn't want to walk around with her
-- passport and that she spoke with Carol who made a `proof` to show that she
-- is allowed to drink.
--
-- Since Bobby is aware of Carols proofs, he ask for the business cards and
-- scans the value of the `proof` with a mobile app he has created for the
-- purpose. He can easily see that the verified number, matches the one that
-- Alice has on her business card and allows her to join the party.
(== obfus) $ bobby bits must $ digest $ proof
--------------------------------------------------------------------------------
main :: IO ()
main =
action01 b m >>= \ cs@(p,o) ->
(putStrLn $ "The minimum drinking age in the States is: \n " ++ show m) >>
(putStrLn $ "Bits used for the hashing algorithm FNV-1a:\n " ++ show b) >>
(putStrLn $ "Carol creates a `proof value` and signs it:\n " ++ show p) >>
(putStrLn $ "Alice creates a `obfuscated value` (seed): \n " ++ show o) >>
(putStrLn $ "Bobby verifies the `obfuscated` value with the `proof`:\n " ++
show (action02 b m cs)
)
where
b = B0128
m = 21
|