Fork me on GitHub

Files

mon@razerRamon:~/tmp/DataRegister$ ll -R
.:
total 16K
drwxrwxr-x 2 mon mon 4.0K Jul 17 13:04 dataleaks/
-rwxrwxr-x 1 mon mon 1.6K Jul 17 13:02 DataRegister.fsx*

./dataleaks:
total 0
mon@razerRamon:~/tmp/DataRegister$ 

Code Snippet

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
(* Ported from Haskell snippet *)
module Data =
  type 'a Sensitive =         Sensitive of 'a
  type 'a Register  = private Data      of 'a list
  
  let sensitive = Sensitive
  
  let init : unit -> 'a Register =
    fun () ->
      Data []
  
  let add : 'a -> 'a Register -> 'a Register =
    fun x (Data reg) ->
      if List.exists (fun y -> x = y) reg then
        Data reg
      else
        Data (x :: reg)
  
  let count : ('a -> bool) -> 'a Register -> int =
    fun cond (Data reg) ->
      reg
      |> List.filter cond
      |> List.length
  
  let get : ('a -> 'b) -> ('a -> bool) -> 'a Register -> 'b option =
    fun dto cond (Data reg) ->
      match List.tryFind cond reg with
        | Some x -> Some (dto x)
        | None   -> None

(* Sensitive data generator *)
module Random =
  open System
  let private r = new Random()
  let next () = r.Next()

open Data
open Random

(* Some domain type *)
type FooBar = { foo : int; bar : int Sensitive; }

let uids = [1 .. 10]

let data =
  uids
  |> List.fold(
    fun a x ->
      Data.add
        { foo = x; bar = Data.sensitive (Random.next ()) } a
  ) (Data.init())

(* Good person *)
let user1 : int option =
  data
  |> Data.get
    (fun { bar = (Sensitive num) } -> num)
    (fun x -> x.foo = 7)

(* Bad person *)
let user2 : int option =
  let leak : FooBar -> unit =
    fun { foo = uid; bar = (Sensitive num) } ->
    System.IO.File.WriteAllText(
      "./dataleaks/" + (Random.next ()).ToString() + ".log",
      sprintf "(%i,%i)\n" uid num
    )
    
  data
  |> Data.get
    (fun { FooBar.bar = (Sensitive num) } -> num)
    (fun x -> leak x; x.foo = 7)

(* 
Ensure to " ... implement appropriate TECHNICAL and organizational measures,
..., which are DESIGNED to implement data-protection principles, ..., in an
effective manner and to integrate the necessary SAFEGUARDS into the processing
in order to meet the requirements of this Regulation and protect the rights of
data subjects" (Article 25(1) EU GDPR).
*) 

Code output:

>
module Data = begin
  type 'a Sensitive = | Sensitive of 'a
  type 'a Register = private | Data of 'a list
  val sensitive : arg0:'a -> 'a Sensitive
  val init : unit -> 'a Register
  val add : x:'a -> 'a Register -> 'a Register when 'a : equality
  val count : cond:('a -> bool) -> 'a Register -> int
  val get : dto:('a -> 'b) -> cond:('a -> bool) -> 'a Register -> 'b option
end
module Random = begin
  val private r : System.Random
  val next : unit -> int
end
type FooBar =
  {foo: int;
   bar: int Data.Sensitive;}
val uids : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
val data : FooBar Data.Register
val user1 : int option = Some 235432072
val user2 : int option = Some 235432072

Data leak

mon@razerRamon:~/tmp/DataRegister$ ll -R && cat dataleaks/*
.:
total 16K
drwxrwxr-x 2 mon mon 4.0K Jul 17 13:19 dataleaks/
-rwxrwxr-x 1 mon mon 2.3K Jul 17 13:20 DataRegister.fsx*

./dataleaks:
total 48K
-rw-rw-r-- 1 mon mon 15 Jul 17 13:19 1213109609.log
-rw-rw-r-- 1 mon mon 14 Jul 17 13:19 1312310136.log
-rw-rw-r-- 1 mon mon 14 Jul 17 13:19 1690673176.log
-rw-rw-r-- 1 mon mon 14 Jul 17 13:19 801806650.log
(10,996092411)
(8,764617439)
(9,423553051)
(7,235432072)
mon@razerRamon:~/tmp/DataRegister$

References:

Files

mon@razerRamon:~/tmp/haskell/dataregister$ ll
total 40K
-rw-rw-r-- 1 mon mon 1.4K Jul 14 14:59 DataRegister.hs
-rw-rw-r-- 1 mon mon  130 Jul 13 14:49 Guests.csv
-rwxrwxr-x 1 mon mon 5.5K Jul 14 15:01 Script.hs*
mon@razerRamon:~/tmp/haskell/dataregister$ 

Guest list

1
2
3
4
Regular;Joe;US-CA1234;-;-;
Muhammad;Ali;US-KY1942;-;Islam;
Don;Rickles;US-NY1926;-;Judaism;
Al;Gore;US-WA1948;Vegan;Christianism;

Haskell Code Snippet

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
module DataRegister (
  {- Data (type) is not exposed. Which ensures that data processing needs to be
     performed with the exposed functions
  -}
  Register,
  Sensitive(..),
  add,count,exists,get,populate
) where

import qualified Data.List  as List
import qualified Data.Maybe as Maybe

data Sensitive a = Sensitive a  deriving (Eq)
data Register  a = Data     [a]

add :: (Eq a) => a -> Register a -> Register a
add x (Data reg) =
  if List.any (\y -> x == y) reg then
    Data reg
  else
    Data (x : reg)

count :: (a -> Bool) -> Register a -> Int
count cond (Data reg) =
  let
    xs = List.filter cond reg
  in
    List.length xs

exists :: (a -> Bool) -> Register a -> Bool
exists cond (Data reg) =
  {- Junior Dev also likes to debug a lot:
     
     putStrLn ("Debugging is the only way I know: " ++ (show reg))

     And computer says NO:
     Couldn't match type ‘IO’ with ‘Bool’
  -}
  List.any cond reg

get :: (a -> b) -> (a -> Bool) -> Register a -> Maybe b
get ___ ____ (Data [    ]) = Nothing
get dto cond (Data (x:xs)) =
  if cond x then
    Just (dto x)
  else
    get dto cond (Data xs)

populate :: FilePath -> (String -> Maybe a) -> IO (Register a)
populate path dto =
  do
    file <- readFile path
    let ls = lines file
    let ms = map dto ls
    let ds = Maybe.catMaybes ms
    return (Data ds)
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
#!/usr/bin/env stack
{- stack
   --resolver lts-8.21
   --install-ghc
   runghc
   --package split
   --
   -Wall -Werror
-}

{-

Why Are So Many Smart People So Stupid About the GDPR?

"One example: The requirement for data minimization (Article 5(1)(c)) means that
you must be able to demonstrate that every business process that touches
personal data (and every technology that contributes to it) is designed in such
a way that it uses the smallest possible amount of data for the shortest
possible period of time while exposing it to the fewest possible eyeballs and
ensuring that it is deleted as quickly as possible when the processing purpose
is completed." -- Tim Walters, Ph.D. (Customer Experience and GDPR Consultant,
Writer, and Keynote Speaker)


Possible solution:

1) Create a stateless app. Processed data is never stored, only in memory, which
will be reset when the application terminates.

2) Ensure that only necessary data is used. It's mandatory to provide the
feature of marking data as sensitive data.

3) As many people are going to use the data, ensure to narrow down each
functionality to a specific process.

4) Ensure to " ... implement appropriate technical and organizational measures,
..., which are designed to implement data-protection principles, ..., in an
effective manner and to integrate the necessary safeguards into the processing
in order to meet the requirements of this Regulation and protect the rights of
data subjects" (Article 25(1)). Haskell does a pretty good job isolating
side-effects. If you want to debug, log or simple print, you will have to build
it into the design of the system. No shortcuts allowed.


Example:

Celebrity BBQ event. A lot of well know people will participate at the BBQ. Some
of the guests will not be able to enjoy the chefs main specialty, spareribs,
due to diet or religious views. As we would like to make the event a success for
everybody we will retrieve the necessary data from the A-list guests. As some of
the data is sensitive, we will need to ensure it doesn't get misused by the
staff.

-}

module Main (main) where

import qualified Data.List.Split as Split

import DataRegister (Register,Sensitive(..),count,get,populate)

data Religion = Buddhism | Christianism | Hinduism | Islam | Judaism {- ... -}
  deriving (Eq)
data Diets    = Vegan    | Vegetarian
  deriving (Eq)
data Badge    = Badge String String
  deriving (Eq,Show)
data Guest    = Guest
  { name     :: Badge                      {- Guest must were name badges    -}
  , passid   :: Sensitive String           {- Very fancy and exclusive BBQ   -}
  , diets    :: Maybe Diets                {- No meat is a valid option      -}
  , religion :: Sensitive (Maybe Religion) {- No pork is also a valid option -}
  }
  deriving (Eq)

{- Data transfer object: From some source to our register -}
dto :: String -> Maybe Guest
dto line =
  let
    veg x =
      case x of
        "Vegan"      -> Just Vegan 
        "Vegetarian" -> Just Vegetarian
        _            -> Nothing
        
    rel x =
      case x of
        "Buddhism"     -> Just Buddhism
        "Christianism" -> Just Christianism
        "Hinduism"     -> Just Hinduism
        "Islam"        -> Just Islam
        "Judaism"      -> Just Judaism
        _              -> Nothing
    
    xs = Split.splitOn ";" line
  in
    Just Guest
    { name     = Badge (xs !! 0) (xs !! 1)
    , passid   = Sensitive (xs !! 2)
    , diets    = veg (xs !! 3)
    , religion = Sensitive (rel (xs !! 4))
    }

{- Needed by the Kitchen -}
spareribs :: Guest -> Bool
spareribs (Guest {diets = d, religion = (Sensitive r)}) =
  let
    veg = (d == (Just Vegan)) || (d == (Just Vegetarian))
    rel = (r == (Just Islam)) || (r == (Just Judaism   ))
  in
    veg || rel

{- Needed by the Bouncer -}
scandid :: String -> Guest -> Bool
scandid pid (Guest { passid = (Sensitive regpid)}) =
  pid == regpid
givebadge :: Guest -> Badge
givebadge (Guest { name = badge }) =
  badge
get' :: (Guest -> Bool) -> Register Guest -> Maybe Badge
get' =
  get givebadge 

main :: IO ()
main =
  do
    {- Receive guest list (from file but could be from DB or WS) -}
    reg <- populate "./Guests.csv" dto

    {- Junior Dev likes to log a lot:

       putStrLn ("Logging it all cos big brother syndrome: " ++ (show reg))

       And computer says NO:
       No instance for (Show (DataRegister.Register Guest))
    -}
    
    {- Notify kitchen on how many will not eat the main dish (spareribs) -}
    let n = count spareribs reg
    putStrLn ("Number of guests that will not eat spareribs: " ++ show n)

    {- White pride kitchen staff wants the list for ...:

       putStrLn ("I have a low IQ: " ++ (show reg))

       And computer says NO:
       No instance for (Show (DataRegister.Register Guest))
    -}

    {- Bouncer will check guests for valid ids and handle badges -}
    let (Just g1) = get' (scandid "US-NY1926") reg
    putStrLn ("1st Guest valid id, handle: " ++ (show g1))
    let (Just g2) = get' (scandid "US-CA1234") reg
    putStrLn ("2nd Guest valid id, handle: " ++ (show g2))
    let notguest  = get' (scandid "DK-BH0000") reg
    putStrLn ("... Guest indvalid id, handle: " ++ (show notguest))
    let (Just g3) = get' (scandid "US-KY1942") reg
    putStrLn ("3rd Guest valid id, handle: " ++ (show g3))
    let (Just g4) = get' (scandid "US-WA1948") reg
    putStrLn ("4th Guest valid id, handle: " ++ (show g4))
    
    {- Dodgy Bouncer ask for a full list of all guests:

       putStrLn ("I'm earning an extra buck (TMZ): " ++ (show reg))

       And computer says NO:
       No instance for (Show (DataRegister.Register Guest))
    -}

Haskell Code output:

mon@razerRamon:~/tmp/haskell/dataregister$ ./Script.hs 
Number of guests that will not eat spareribs: 3
1st Guest valid id, handle: Badge "Don" "Rickles"
2nd Guest valid id, handle: Badge "Regular" "Joe"
... Guest indvalid id, handle: Nothing
3rd Guest valid id, handle: Badge "Muhammad" "Ali"
4th Guest valid id, handle: Badge "Al" "Gore"
mon@razerRamon:~/tmp/haskell/dataregister$ 

References:

Files

mon@razerRamon:~/tmp/haskell/rhythm_counting$ ll
total 24K
-rwxrwxr-x 1 mon mon  960 Jul 10 21:31 Example.hs*
-rw-rw-r-- 1 mon mon 1.4K Jul 10 21:03 Rhythm.hs
mon@razerRamon:~/tmp/haskell/rhythm_counting$ 

Haskell Code Snippet

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
module Rhythm (nextBin,nextDec,nextHex,nextVar) where

import qualified Numeric   as Num
import qualified Data.Char as Char

{- The Rhythm of Counting -}

count :: Int -> Int -> Int -> [Int] -> [Int]
count up low val =
  let
    f [    ] = [val]
    f (x:xs) =
      case x == up of
        True  -> low : f xs
        False -> x + 1 : xs
  in
    f

hlp ::  Int -> Int -> Int -> [Int] -> Maybe [Int]
hlp up low val xs =
  case all (\x -> x >= low && x <= up) xs of
    True  -> Just (count up low val xs)
    False -> Nothing

nextHlp :: ([Int] -> Maybe [Int]) -> [Char] -> Maybe [Char]
nextHlp f xs =
  let
    ys = reverse xs
    ds = map Char.digitToInt ys
  in
    case f ds of
      Just vs -> Just (reverse (map Char.intToDigit vs))
      Nothing -> Nothing

nextBin :: [Char] -> Maybe [Char]
nextBin =
  nextHlp (hlp 1 0 1)

nextDec :: [Char] -> Maybe [Char]
nextDec =
  nextHlp (hlp 9 0 1)

nextHex :: [Char] -> Maybe [Char]
nextHex xs =
  let
    ys = reverse xs
    ds = map Char.digitToInt ys
  in
    case hlp 0xf 0x0 0x1 ds of
      Just vs -> Just (reverse (foldl (\a v -> a ++ Num.showHex v "") "" vs))
      Nothing -> Nothing

nextVar :: [Char] -> Maybe [Char]
nextVar xs =
  let
    ys = reverse xs
    cs = map Char.ord ys
  in
    case hlp 122 97 97 cs of
      Just vs -> Just (reverse (map Char.chr vs))
      Nothing -> Nothing
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
#!/usr/bin/env stack
{- stack
   --resolver lts-8.21
   --install-ghc
   runghc
   --
   -Wall -Werror
-}

module Main (main) where

import qualified Data.List as List
import qualified Rhythm    as Rhythm

main :: IO ()
main =
  let
    {- Infinity many unique (and optimal shortest?) variables -}
    vs x = List.unfoldr(\(Just v) -> Just (v, Rhythm.nextVar v)) (Just x)
  in
    do
      {- The next binary after 3 is 4: -}
      putStrLn (show (Just "1000" == Rhythm.nextBin "111"))
    
      {- The next number after 999 is 1000: -}
      putStrLn (show (Just "1000" == Rhythm.nextDec "999"))

      {- The next number after "fff" is 1000: -}
      putStrLn (show (Just "1000" == Rhythm.nextHex "fff"))

      {- The next variable after "zzz" is "aaaa": -}
      putStrLn (show (Just "aaaa" == Rhythm.nextVar "zzz"))

      {- We retrieve a 10 unique of the shortest variables, starting from "z" -}
      let ten = take 10 (vs "z") in putStrLn (show ten)

Haskell Code output:

mon@razerRamon:~/tmp/haskell/rhythm_counting$ ./Example.hs 
True
True
True
True
["z","aa","ab","ac","ad","ae","af","ag","ah","ai"]
mon@razerRamon:~/tmp/haskell/rhythm_counting$

References:

Idris Code Snippet

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
module Evoting

import Data.Vect
import Data.List

%default total

Name : Type
Name = String

Surname : Type
Surname = String

data Candidate = Person Name Surname
data Vote      = Blank | For Candidate
data Validity  = Valid Vote | Invalid

Eq Candidate where 
  (Person name1 surname1) == (Person name2 surname2) =
    name1 == name2 && surname1 == surname2
  (Person name1 surname1) /= (Person name2 surname2) =
    name1 /= name2 || surname1 /= surname2

validity : List Candidate -> Vote -> Validity
validity (Nil    ) __________ = Invalid
validity _________ (Blank   ) = Valid Blank
validity (x :: xs) (For vote) = 
  if x == vote then Valid (For vote) else validity xs (For vote)

invalidate : Vect n Vote -> Vect n Validity
invalidate (Nil    ) = Nil
invalidate (_ :: xs) = Invalid :: invalidate xs

election : List Candidate -> Vect n Vote -> Vect n Validity
election __________ (Nil          ) = Nil
election Nil        (votes        ) = invalidate votes
election candidates (vote :: votes) =
  validity candidates vote :: election candidates votes
                          
candidates : List Candidate
candidates =
  Person "John" "Doe" ::
  Person "Jane" "Doe" :: 
  []

{- Version 1: Replicate real life behaviour -}
votes : Vect 3 Vote {- We know the number of citizens -}
votes = 
  For (Person "Jane" "Doe") :: 
  For (Person "John" "Hoe") :: {- Invalid candidate -}
  Blank ::
  [] 

Idris Code output:

Welcome to the Idris REPL!
Idris 1.0

Type checking ./evoting.idr
λΠ> election candidates votes
[Valid (For (Person "Jane" "Doe")), Invalid, Valid Blank] : Vect 3 Validity
λΠ>

References:

Files

mon@razerRamon:~/tmp/haskell/howtoscript$ ll
total 24K
-rw-rw-r-- 1 mon mon 445 Jul  6 13:02 Logic.hs
-rwxrwxr-x 1 mon mon 457 Jul  6 14:12 Script.hs*
mon@razerRamon:~/tmp/haskell/howtoscript$

Haskell Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
module Logic (dimensions) where

{- Dependency to a Hackage pkg: https://hackage.haskell.org/package/terminfo -}
import qualified System.Console.Terminfo.Base as Term
import           System.Console.Terminfo.Cursor

dimensions :: IO (Int,Int)
dimensions =
  do
    term <- Term.setupTermFromEnv
    
    let (Just height) = Term.getCapability term termLines
    let (Just width)  = Term.getCapability term termColumns

    return (height,width)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#!/usr/bin/env stack
{- stack
   --resolver lts-8.21
   --install-ghc
   script
   --package terminfo
   --
   -Wall -Werror
-}

module Main (main) where

{- Import local file which has a dependency to a Hackage pkg:
   https://hackage.haskell.org/package/terminfo
-}
import qualified Logic as Terminal

main :: IO ()
main =
  do
    (height,width) <- Terminal.dimensions
    
    putStrLn ("Term height: " ++ (show height) ++ " & width: " ++ (show width))

Haskell Code output:

mon@razerRamon:~/tmp/haskell/howtoscript$ ./Script.hs 
Term height: 57 & width: 199
mon@razerRamon:~/tmp/haskell/howtoscript$ 

References: