src/Gargantext/Prelude/Crypto/Share.hs

   1 {-|
   2 Module      : Gargantext.Prelude.Crypto.Share
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 # Random work/research (WIP)
  11
  12 Goal: share secretly a sequence of random actions (either [Bool] or
  13 [Ordering] for instances here) but without sharing secrets.
  14
  15 Motivation: useful to share clustering algorithm reproduction using BAC
  16 (Ballades Aléatoires Courtes).
  17
  18 Question: how to certify the author of such (random) actions ? Solution
  19 later ;)
  20
  21 -}
  22
  23 ------------------------------------------------------------------------
  24 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  25 ------------------------------------------------------------------------
  26 module Gargantext.Prelude.Crypto.Share
  27   where
  28
  29 import Data.Maybe
  30 import System.Random
  31 import Prelude (fromEnum, toEnum)
  32 import Gargantext.Core.Types (Ordering)
  33 import Gargantext.Prelude
  34
  35 ------------------------------------------------------------------------
  36 -- | Main Types
  37 newtype Seed = Seed Int
  38 type Private = Seed
  39 type Public  = Seed
  40
  41 ------------------------------------------------------------------------
  42 instance Random Ordering where
  43   randomR (a, b) g =
  44     case randomR (fromEnum a, fromEnum b) g of
  45       (x, g') -> (toEnum x, g')
  46   random g = randomR (minBound, maxBound) g
  47
  48
  49 randomOrdering :: Maybe Seed -> Int -> IO [Ordering]
  50 randomOrdering = randomWith
  51
  52 randomBool :: Maybe Seed -> Int -> IO [Bool]
  53 randomBool= randomWith
  54
  55 ------------------------------------------------------------------
  56
  57 randomWith :: Random a => Maybe Seed -> Int -> IO [a]
  58 randomWith seed n = do
  59   g <- case seed of
  60     Nothing        -> newStdGen
  61     Just  (Seed s) -> pure $ mkStdGen s
  62
  63   pure $ take n $ (randoms g)
  64
  65 genWith :: Private -> Public -> Int -> IO [Bool]
  66 genWith privateSeed publicSeed n = do
  67   xs <- randomBool (Just  privateSeed) n
  68   ys <- randomBool (Just  publicSeed ) n
  69   pure $ zipWith xor xs ys
  70
  71 {-
  72 - TODO WIP
  73 searchSeeds :: Int -> IO [Int]
  74 searchSeeds xs = mapM (\n -> randomWith (Just n) l) [1..]
  75   where
  76     l = length xs
  77
  78 shareSeed = undefined
  79
  80 certifySeed = undefined
  81 -}