Ob.hs (4277B)
1 {-# LANGUAGE BangPatterns #-} 2 3 -- | 4 -- Module: Urbit.Ob.Ob 5 -- Copyright: (c) 2019 Jared Tobin 6 -- License: MIT 7 -- 8 -- Maintainer: Jared Tobin <jared@jtobin.io> 9 -- Stability: unstable 10 -- Portability: ghc 11 -- 12 -- Integer obfuscation functions. 13 -- 14 -- Analogous to the +ob arm in hoon.hoon. 15 16 module Urbit.Ob.Ob ( 17 fein 18 , fynd 19 , feis 20 , tail 21 , fe 22 , fen 23 , capF 24 , capFe 25 , capFen 26 ) where 27 28 import Data.Bits 29 import Data.Word (Word32) 30 import Prelude hiding (tail) 31 import Urbit.Ob.Muk (muk) 32 33 -- | Conceal structure v3. 34 fein :: (Integral a, Bits a) => a -> a 35 fein = mach feis 36 37 -- | Restore structure v3. 38 fynd :: (Integral a, Bits a) => a -> a 39 fynd = mach tail 40 41 -- | Sausage machine powering 'fein' and 'feis'. 42 mach :: (Integral a, Bits a) => (Word32 -> Word32) -> a -> a 43 mach f = loop where 44 loop !x = 45 let lo = x .&. 0xFFFFFFFF 46 hi = x .&. 0xFFFFFFFF00000000 47 x32 = fromIntegral x :: Word32 48 in if x >= 0x10000 && x <= 0xFFFFFFFF 49 then 0x10000 + fromIntegral (f (x32 - 0x10000)) 50 else if x >= 0x100000000 && x <= 0xFFFFFFFFFFFFFFFF 51 then hi .|. loop lo 52 else x 53 54 -- | Generalised Feistel cipher. 55 -- 56 -- See: Black and Rogaway (2002), "Ciphers with arbitrary finite domains." 57 -- 58 -- Note that this has been adjusted from the reference paper in order to 59 -- support some legacy behaviour. 60 feis :: Word32 -> Word32 61 feis = capFe 4 0xFFFF 0x10000 0xFFFFFFFF capF 62 63 -- | Reverse 'feis'. 64 -- 65 -- See: Black and Rogaway (2002), "Ciphers with arbitrary finite domains." 66 -- 67 -- Note that this has been adjusted from the reference paper in order to 68 -- support some legacy behaviour. 69 tail :: Word32 -> Word32 70 tail = capFen 4 0xFFFF 0x10000 0xFFFFFFFF capF 71 72 -- | A PRF for j in [0, .., 3] 73 capF :: Int -> Word32 -> Word32 74 capF j key = fromIntegral (muk seed key) where 75 seed = raku !! fromIntegral j 76 raku = [ 77 0xb76d5eed 78 , 0xee281300 79 , 0x85bcae01 80 , 0x4b387af7 81 ] 82 83 -- | 'Fe' in B&R (2002). 84 capFe 85 :: Int 86 -> Word32 87 -> Word32 88 -> Word32 89 -> (Int -> Word32 -> Word32) 90 -> Word32 91 -> Word32 92 capFe r a b k f m 93 | c < k = c 94 | otherwise = fe r a b f c 95 where 96 c = fe r a b f m 97 98 -- | 'fe' in B&R (2002). 99 fe 100 :: Int 101 -> Word32 102 -> Word32 103 -> (Int -> Word32 -> Word32) 104 -> Word32 105 -> Word32 106 fe r a b f m = loop 1 capL capR where 107 capL = m `mod` a 108 capR = m `div` a 109 loop j !ell !arr 110 | j > r = 111 if odd r || arr == a 112 then a * arr + ell 113 else a * ell + arr 114 | otherwise = 115 let eff = f (pred j) arr 116 -- NB (jtobin): 117 -- 118 -- note that the "extra" modulo operators here are not redundant as 119 -- the addition of ell and eff can (silently) overflow Word32. 120 -- modulo p does not distribute over addition, but it does 121 -- "distribute modulo p," so this ensures we stay sufficiently 122 -- small. 123 tmp = if odd j 124 then (ell `mod` a + eff `mod` a) `mod` a 125 else (ell `mod` b + eff `mod` b) `mod` b 126 127 in loop (succ j) arr tmp 128 129 -- | 'Fen' in B&R (2002). 130 capFen 131 :: Int 132 -> Word32 133 -> Word32 134 -> Word32 135 -> (Int -> Word32 -> Word32) 136 -> Word32 137 -> Word32 138 capFen r a b k f m 139 | c <= k = c 140 | otherwise = fen r a b f c 141 where 142 c = fen r a b f m 143 144 -- | 'fen' in B&R (2002). 145 fen 146 :: Int 147 -> Word32 148 -> Word32 149 -> (Int -> Word32 -> Word32) 150 -> Word32 151 -> Word32 152 fen r a b f m = loop r capL capR where 153 ahh = 154 if odd r 155 then m `div` a 156 else m `mod` a 157 158 ale = 159 if odd r 160 then m `mod` a 161 else m `div` a 162 163 capL = 164 if ale == a 165 then ahh 166 else ale 167 168 capR = 169 if ale == a 170 then ale 171 else ahh 172 173 loop j !ell !arr 174 | j < 1 = a * arr + ell 175 | otherwise = 176 let eff = f (pred j) ell 177 -- NB (jtobin): 178 -- 179 -- Slight deviation from B&R (2002) here to prevent negative 180 -- values. We add 'a' or 'b' to arr as appropriate and reduce 181 -- 'eff' modulo the same number before performing subtraction. 182 -- 183 tmp = if odd j 184 then (arr + a - (eff `mod` a)) `mod` a 185 else (arr + b - (eff `mod` b)) `mod` b 186 in loop (pred j) tmp ell 187