commit 79f29fba9542735d30f84b8ea8b2c10ef410d299
parent 6d54de5488de856466e2599bd5323a974c583ac6
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 6 Sep 2019 11:11:47 -0230
general large-scale hacking
Diffstat:
10 files changed, 384 insertions(+), 337 deletions(-)
diff --git a/README.md b/README.md
@@ -1,6 +1,7 @@
# urbit-hob
[![Build Status](https://secure.travis-ci.org/urbit/urbit-hob.png)](http://travis-ci.org/urbit/urbit-hob)
+[![Hackage Version](https://img.shields.io/hackage/v/urbit-hob.svg)](http://hackage.haskell.org/package/urbit-hob)
[![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT)
Utilities for phonetic base wrangling.
diff --git a/hob.cabal b/hob.cabal
@@ -1,32 +0,0 @@
-name: urbit-hob
-version: 0.1.0
-description: Hoon-style atom manipulation and printing functions
-homepage: https://github.com/urbit/urbit-hob#readme
-bug-reports: https://github.com/urbit/urbit-hob/issues
-author: Jared Tobin
-maintainer: jared@jtobin.io
-copyright: 2019 Jared Tobin
-license: MIT
-license-file: LICENSE
-build-type: Simple
-cabal-version: >= 1.10
-
-source-repository head
- type: git
- location: https://github.com/urbit/urbit-hob
-
-library
- default-language: Haskell2010
- hs-source-dirs: src
- other-modules: Paths_hob
- exposed-modules:
- Co,
- Muk,
- Ob
- build-depends:
- base >= 4.7 && < 6
- , bytestring >= 0.10 && < 1
- , containers >= 0.5 && < 1
- , murmur3 >= 1.0 && < 2
- , text >= 1.2 && < 2
-
diff --git a/lib/Urbit/Ob.hs b/lib/Urbit/Ob.hs
@@ -0,0 +1,8 @@
+
+module Urbit.Ob (
+ module E
+ ) where
+
+import Urbit.Ob.Co as E
+import Urbit.Ob.Muk as E
+import Urbit.Ob.Ob as E
diff --git a/lib/Urbit/Ob/Co.hs b/lib/Urbit/Ob/Co.hs
@@ -0,0 +1,144 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Urbit.Ob.Co (
+ patp
+ , render
+ ) where
+
+import qualified Data.IntMap.Strict as IMS
+import Data.Maybe (fromMaybe)
+import Urbit.Ob.Ob (fein)
+import qualified Data.Text as T
+import qualified Data.Vector.Unboxed as VU
+import Data.Word (Word8)
+
+newtype Patp = Patp (VU.Vector (Word8, Word8))
+ deriving (Eq, Show)
+
+-- | Render a Patp value as Text.
+render :: Patp -> T.Text
+render (Patp p) = rendered where
+ folded
+ | VU.length p == 1 = case VU.unsafeHead p of
+ (0, su) -> fromMaybe (internalErr "render") $ do
+ suf <- IMS.lookup (fromIntegral su) suffixes
+ return (T.cons '~' suf)
+
+ _ -> VU.foldl' alg mempty p
+
+ | otherwise = VU.foldl' alg mempty p
+
+ rendered = case T.uncons folded of
+ Just (_, pp) -> T.cons '~' pp
+ Nothing -> internalErr "render"
+
+ alg acc x = acc <> "-" <> glue x
+
+ glue (pr, su) = fromMaybe (internalErr "render") $ do
+ pre <- IMS.lookup (fromIntegral pr) prefixes
+ suf <- IMS.lookup (fromIntegral su) suffixes
+ return (pre <> suf)
+
+internalErr :: String -> a
+internalErr fn = error $
+ "urbit-hob (" <> fn <> "): internal error -- please report this as a bug!"
+
+-- | Convert a nonnegative Int to a Patp value.
+patp :: Int -> Patp
+patp n
+ | n >= 0 = _patp
+ | otherwise = error "urbit-hob (patp): input out of range"
+ where
+ _patp
+ | dyx <= 1 = Patp (VU.singleton (0, fromIntegral sxz))
+ | otherwise = Patp (loop sxz 0 mempty)
+
+ sxz = fein n
+ dyx = met 3 sxz
+ dyy = met 4 sxz
+
+ loop !tsxz !timp !acc =
+ let lug = end 4 1 tsxz
+ -- FIXME index
+ etc =
+ if timp `mod` 4 /= 0
+ then "-"
+ else if timp == 0
+ then ""
+ else "--"
+
+ pre = rsh 3 1 lug
+ suf = end 3 1 lug
+ res = VU.cons (fromIntegral pre, fromIntegral suf) acc
+
+ in if timp == dyy
+ then acc
+ else loop (rsh 4 1 tsxz) (succ timp) res
+
+prefixes :: IMS.IntMap T.Text
+prefixes = IMS.fromList $ zip [0..]
+ ["doz","mar","bin","wan","sam","lit","sig","hid","fid","lis","sog","dir"
+ ,"wac","sab","wis","sib","rig","sol","dop","mod","fog","lid","hop","dar"
+ ,"dor","lor","hod","fol","rin","tog","sil","mir","hol","pas","lac","rov"
+ ,"liv","dal","sat","lib","tab","han","tic","pid","tor","bol","fos","dot"
+ ,"los","dil","for","pil","ram","tir","win","tad","bic","dif","roc","wid"
+ ,"bis","das","mid","lop","ril","nar","dap","mol","san","loc","nov","sit"
+ ,"nid","tip","sic","rop","wit","nat","pan","min","rit","pod","mot","tam"
+ ,"tol","sav","pos","nap","nop","som","fin","fon","ban","mor","wor","sip"
+ ,"ron","nor","bot","wic","soc","wat","dol","mag","pic","dav","bid","bal"
+ ,"tim","tas","mal","lig","siv","tag","pad","sal","div","dac","tan","sid"
+ ,"fab","tar","mon","ran","nis","wol","mis","pal","las","dis","map","rab"
+ ,"tob","rol","lat","lon","nod","nav","fig","nom","nib","pag","sop","ral"
+ ,"bil","had","doc","rid","moc","pac","rav","rip","fal","tod","til","tin"
+ ,"hap","mic","fan","pat","tac","lab","mog","sim","son","pin","lom","ric"
+ ,"tap","fir","has","bos","bat","poc","hac","tid","hav","sap","lin","dib"
+ ,"hos","dab","bit","bar","rac","par","lod","dos","bor","toc","hil","mac"
+ ,"tom","dig","fil","fas","mit","hob","har","mig","hin","rad","mas","hal"
+ ,"rag","lag","fad","top","mop","hab","nil","nos","mil","fop","fam","dat"
+ ,"nol","din","hat","nac","ris","fot","rib","hoc","nim","lar","fit","wal"
+ ,"rap","sar","nal","mos","lan","don","dan","lad","dov","riv","bac","pol"
+ ,"lap","tal","pit","nam","bon","ros","ton","fod","pon","sov","noc","sor"
+ ,"lav","mat","mip","fip"]
+
+suffixes :: IMS.IntMap T.Text
+suffixes = IMS.fromList $ zip [0..]
+ ["zod","nec","bud","wes","sev","per","sut","let","ful","pen","syt","dur"
+ ,"wep","ser","wyl","sun","ryp","syx","dyr","nup","heb","peg","lup","dep"
+ ,"dys","put","lug","hec","ryt","tyv","syd","nex","lun","mep","lut","sep"
+ ,"pes","del","sul","ped","tem","led","tul","met","wen","byn","hex","feb"
+ ,"pyl","dul","het","mev","rut","tyl","wyd","tep","bes","dex","sef","wyc"
+ ,"bur","der","nep","pur","rys","reb","den","nut","sub","pet","rul","syn"
+ ,"reg","tyd","sup","sem","wyn","rec","meg","net","sec","mul","nym","tev"
+ ,"web","sum","mut","nyx","rex","teb","fus","hep","ben","mus","wyx","sym"
+ ,"sel","ruc","dec","wex","syr","wet","dyl","myn","mes","det","bet","bel"
+ ,"tux","tug","myr","pel","syp","ter","meb","set","dut","deg","tex","sur"
+ ,"fel","tud","nux","rux","ren","wyt","nub","med","lyt","dus","neb","rum"
+ ,"tyn","seg","lyx","pun","res","red","fun","rev","ref","mec","ted","rus"
+ ,"bex","leb","dux","ryn","num","pyx","ryg","ryx","fep","tyr","tus","tyc"
+ ,"leg","nem","fer","mer","ten","lus","nus","syl","tec","mex","pub","rym"
+ ,"tuc","fyl","lep","deb","ber","mug","hut","tun","byl","sud","pem","dev"
+ ,"lur","def","bus","bep","run","mel","pex","dyt","byt","typ","lev","myl"
+ ,"wed","duc","fur","fex","nul","luc","len","ner","lex","rup","ned","lec"
+ ,"ryd","lyd","fen","wel","nyd","hus","rel","rud","nes","hes","fet","des"
+ ,"ret","dun","ler","nyr","seb","hul","ryl","lud","rem","lys","fyn","wer"
+ ,"ryc","sug","nys","nyl","lyn","dyn","dem","lux","fed","sed","bec","mun"
+ ,"lyr","tes","mud","nyt","byr","sen","weg","fyr","mur","tel","rep","teg"
+ ,"pec","nel","nev","fes"]
+
+bex :: Integral a => a -> a
+bex = (^) 2
+
+rsh :: Integral a => a -> a -> a -> a
+rsh a b c = c `div` bex (bex a * b)
+
+met :: Integral a => a -> a -> a
+met = loop 0 where
+ loop !acc a !b
+ | b == 0 = acc
+ | otherwise = loop (succ acc) a (rsh a 1 b)
+
+end :: Integral a => a -> a -> a -> a
+end a b c = c `mod` bex (bex a * b)
+
diff --git a/lib/Urbit/Ob/Muk.hs b/lib/Urbit/Ob/Muk.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -Wall #-}
+
+module Urbit.Ob.Muk (
+ muk
+ ) where
+
+import Data.Bits
+import qualified Data.ByteString.Char8 as B8
+import Data.Char
+import Data.Word (Word32)
+import qualified Data.Hash.Murmur as M
+
+-- | A specific murmur3 variant.
+muk :: Word32 -> Word32 -> Word32
+muk syd key = M.murmur3 syd kee where
+ kee = chr lo `B8.cons` chr hi `B8.cons` mempty
+ lo = fromIntegral (key .&. 0xFF)
+ hi = fromIntegral (key .&. 0xFF00 `div` 256)
+
diff --git a/lib/Urbit/Ob/Ob.hs b/lib/Urbit/Ob/Ob.hs
@@ -0,0 +1,178 @@
+{-# OPTIONS_GHC -Wall #-}
+
+module Urbit.Ob.Ob (
+ fein
+ , fynd
+ , feis
+ , tail
+ , fe
+ , fen
+ , capF
+ , capFe
+ , capFen
+ ) where
+
+import Data.Bits
+import Data.Word (Word32)
+import Urbit.Ob.Muk (muk)
+import Prelude hiding (tail)
+
+-- | Conceal structure v3.
+fein :: (Integral a, Bits a) => a -> a
+fein = loop where
+ loop pyn =
+ let lo = pyn .&. 0xFFFFFFFF
+ hi = pyn .&. 0xFFFFFFFF00000000
+ p32 = fromIntegral pyn :: Word32
+ in if pyn >= 0x10000 && pyn <= 0xFFFFFFFF
+ then 0x10000 + fromIntegral (feis (p32 - 0x10000))
+ else if pyn >= 0x100000000 && pyn <= 0xFFFFFFFFFFFFFFFF
+ then hi .|. loop lo
+ else pyn
+
+-- | Restore structure v3.
+fynd :: (Integral a, Bits a) => a -> a
+fynd = loop where
+ loop cry =
+ let lo = cry .&. 0xFFFFFFFF
+ hi = cry .&. 0xFFFFFFFF00000000
+ c32 = fromIntegral cry :: Word32
+ in if cry >= 0x10000 && cry <= 0xFFFFFFFF
+ then 0x10000 + fromIntegral (tail (c32 - 0x10000))
+ else if cry >= 0x100000000 && cry <= 0xFFFFFFFFFFFFFFFF
+ then hi .|. loop lo
+ else cry
+
+-- | Generalised Feistel cipher
+--
+-- See: Black and Rogaway (2002), "Ciphers with arbitrary finite domains."
+--
+-- Note that this has been adjusted from the reference paper in order to
+-- support some legacy behaviour.
+feis :: Word32 -> Word32
+feis = capFe 4 65535 65536 0xFFFFFFFF capF
+
+-- | Reverse 'feis'.
+--
+-- See: Black and Rogaway (2002), "Ciphers with arbitrary finite domains."
+--
+-- Note that this has been adjusted from the reference paper in order to
+-- support some legacy behaviour.
+tail :: Word32 -> Word32
+tail = capFen 4 65535 65536 0xFFFFFFFF capF
+
+-- | A PRF for j in [0, .., 3]
+capF :: Int -> Word32 -> Word32
+capF j key = fromIntegral (muk seed key) where
+ seed = raku !! fromIntegral j
+ raku = [
+ 0xb76d5eed
+ , 0xee281300
+ , 0x85bcae01
+ , 0x4b387af7
+ ]
+
+-- | 'Fe' in B&R (2002).
+capFe
+ :: Integral a
+ => Int
+ -> a
+ -> a
+ -> a
+ -> (Int -> a -> a)
+ -> a
+ -> a
+capFe r a b k f m
+ | c < k = c
+ | otherwise = fe r a b f c
+ where
+ c = fe r a b f m
+
+-- | 'fe' in B&R (2002).
+fe
+ :: Integral a
+ => Int
+ -> a
+ -> a
+ -> (Int -> a -> a)
+ -> a
+ -> a
+fe r a b f m = loop 1 capL capR where
+ capL = m `mod` a
+ capR = m `div` a
+ loop j ell arr
+ | j > r =
+ if odd r
+ then a * arr + ell
+ else if arr == a
+ then a * arr + ell
+ else a * ell + arr
+ | otherwise =
+ let eff = f (pred j) arr
+ tmp = if odd j
+ then (ell + eff) `mod` a
+ else (ell + eff) `mod` b
+ in loop (succ j) arr tmp
+
+-- | 'Fen' in B&R (2002).
+capFen
+ :: Integral a
+ => Int
+ -> a
+ -> a
+ -> a
+ -> (Int -> a -> a)
+ -> a
+ -> a
+capFen r a b k f m
+ | c <= k = c
+ | otherwise = fen r a b f c
+ where
+ c = fen r a b f m
+
+-- | 'fen' in B&R (2002).
+fen
+ :: Integral a
+ => Int
+ -> a
+ -> a
+ -> (Int -> a -> a)
+ -> a
+ -> a
+fen r a b f m = loop r capL capR where
+ ahh =
+ if odd r
+ then m `div` a
+ else m `mod` a
+
+ ale =
+ if odd r
+ then m `mod` a
+ else m `div` a
+
+ capL =
+ if ale == a
+ then ahh
+ else ale
+
+ capR =
+ if ale == a
+ then ale
+ else ahh
+
+ loop j ell arr
+ | j < 1 = a * arr + ell
+ | otherwise =
+ let eff = f (pred j) ell
+ -- NB (jtobin):
+ --
+ -- Slight deviation from B&R (2002) here to prevent negative
+ -- values. We add 'a' or 'b' to arr as appropriate and reduce
+ -- 'eff' modulo the same number before performing subtraction.
+ --
+ tmp = if odd j
+ then (arr + a - (eff `mod` a)) `mod` a
+ else (arr + b - (eff `mod` b)) `mod` b
+ in loop (pred j) tmp ell
+
+
diff --git a/src/Co.hs b/src/Co.hs
@@ -1,113 +0,0 @@
-{-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Co (
- patp
- ) where
-
-import qualified Data.IntMap.Strict as IMS
-import Ob (fein)
-import qualified Data.Text as T
-
-newtype Patp = Patp T.Text
- deriving Eq
-
-instance Show Patp where
- show = T.unpack . render
-
-render :: Patp -> T.Text
-render (Patp p) = T.cons '~' p
-
-patp :: Int -> Maybe Patp
-patp n
- | dyx <= 1 = fmap Patp (IMS.lookup sxz suffixes)
- | otherwise = fmap Patp (loop sxz 0 mempty)
- where
- sxz = fein n
- dyx = met 3 sxz
- dyy = met 4 sxz
-
- loop !tsxz !timp !trep = do
- let lug = end 4 1 tsxz
- etc =
- if timp `mod` 4 /= 0
- then "-"
- else if timp == 0
- then ""
- else "--"
-
- pre <- IMS.lookup (rsh 3 1 lug) prefixes
- suf <- IMS.lookup (end 3 1 lug) suffixes
-
- let res = pre <> suf <> etc <> trep
-
- if timp == dyy
- then return trep
- else loop (rsh 4 1 tsxz) (succ timp) res
-
-prefixes :: IMS.IntMap T.Text
-prefixes = IMS.fromList $ zip [0..]
- ["doz","mar","bin","wan","sam","lit","sig","hid","fid","lis","sog","dir"
- ,"wac","sab","wis","sib","rig","sol","dop","mod","fog","lid","hop","dar"
- ,"dor","lor","hod","fol","rin","tog","sil","mir","hol","pas","lac","rov"
- ,"liv","dal","sat","lib","tab","han","tic","pid","tor","bol","fos","dot"
- ,"los","dil","for","pil","ram","tir","win","tad","bic","dif","roc","wid"
- ,"bis","das","mid","lop","ril","nar","dap","mol","san","loc","nov","sit"
- ,"nid","tip","sic","rop","wit","nat","pan","min","rit","pod","mot","tam"
- ,"tol","sav","pos","nap","nop","som","fin","fon","ban","mor","wor","sip"
- ,"ron","nor","bot","wic","soc","wat","dol","mag","pic","dav","bid","bal"
- ,"tim","tas","mal","lig","siv","tag","pad","sal","div","dac","tan","sid"
- ,"fab","tar","mon","ran","nis","wol","mis","pal","las","dis","map","rab"
- ,"tob","rol","lat","lon","nod","nav","fig","nom","nib","pag","sop","ral"
- ,"bil","had","doc","rid","moc","pac","rav","rip","fal","tod","til","tin"
- ,"hap","mic","fan","pat","tac","lab","mog","sim","son","pin","lom","ric"
- ,"tap","fir","has","bos","bat","poc","hac","tid","hav","sap","lin","dib"
- ,"hos","dab","bit","bar","rac","par","lod","dos","bor","toc","hil","mac"
- ,"tom","dig","fil","fas","mit","hob","har","mig","hin","rad","mas","hal"
- ,"rag","lag","fad","top","mop","hab","nil","nos","mil","fop","fam","dat"
- ,"nol","din","hat","nac","ris","fot","rib","hoc","nim","lar","fit","wal"
- ,"rap","sar","nal","mos","lan","don","dan","lad","dov","riv","bac","pol"
- ,"lap","tal","pit","nam","bon","ros","ton","fod","pon","sov","noc","sor"
- ,"lav","mat","mip","fip"]
-
-suffixes :: IMS.IntMap T.Text
-suffixes = IMS.fromList $ zip [0..]
- ["zod","nec","bud","wes","sev","per","sut","let","ful","pen","syt","dur"
- ,"wep","ser","wyl","sun","ryp","syx","dyr","nup","heb","peg","lup","dep"
- ,"dys","put","lug","hec","ryt","tyv","syd","nex","lun","mep","lut","sep"
- ,"pes","del","sul","ped","tem","led","tul","met","wen","byn","hex","feb"
- ,"pyl","dul","het","mev","rut","tyl","wyd","tep","bes","dex","sef","wyc"
- ,"bur","der","nep","pur","rys","reb","den","nut","sub","pet","rul","syn"
- ,"reg","tyd","sup","sem","wyn","rec","meg","net","sec","mul","nym","tev"
- ,"web","sum","mut","nyx","rex","teb","fus","hep","ben","mus","wyx","sym"
- ,"sel","ruc","dec","wex","syr","wet","dyl","myn","mes","det","bet","bel"
- ,"tux","tug","myr","pel","syp","ter","meb","set","dut","deg","tex","sur"
- ,"fel","tud","nux","rux","ren","wyt","nub","med","lyt","dus","neb","rum"
- ,"tyn","seg","lyx","pun","res","red","fun","rev","ref","mec","ted","rus"
- ,"bex","leb","dux","ryn","num","pyx","ryg","ryx","fep","tyr","tus","tyc"
- ,"leg","nem","fer","mer","ten","lus","nus","syl","tec","mex","pub","rym"
- ,"tuc","fyl","lep","deb","ber","mug","hut","tun","byl","sud","pem","dev"
- ,"lur","def","bus","bep","run","mel","pex","dyt","byt","typ","lev","myl"
- ,"wed","duc","fur","fex","nul","luc","len","ner","lex","rup","ned","lec"
- ,"ryd","lyd","fen","wel","nyd","hus","rel","rud","nes","hes","fet","des"
- ,"ret","dun","ler","nyr","seb","hul","ryl","lud","rem","lys","fyn","wer"
- ,"ryc","sug","nys","nyl","lyn","dyn","dem","lux","fed","sed","bec","mun"
- ,"lyr","tes","mud","nyt","byr","sen","weg","fyr","mur","tel","rep","teg"
- ,"pec","nel","nev","fes"]
-
-bex :: Integral a => a -> a
-bex = (^) 2
-
-rsh :: Integral a => a -> a -> a -> a
-rsh a b c = c `div` bex (bex a * b)
-
-met :: Integral a => a -> a -> a
-met = loop 0 where
- loop !acc a !b
- | b == 0 = acc
- | otherwise = loop (succ acc) a (rsh a 1 b)
-
-end :: Integral a => a -> a -> a -> a
-end a b c = c `mod` bex (bex a * b)
-
diff --git a/src/Muk.hs b/src/Muk.hs
@@ -1,18 +0,0 @@
-{-# OPTIONS_GHC -Wall #-}
-
-module Muk (
- muk
- ) where
-
-import Data.Bits
-import qualified Data.ByteString.Char8 as B8
-import Data.Char
-import Data.Word (Word32)
-import qualified Data.Hash.Murmur as M
-
-muk :: Word32 -> Word32 -> Word32
-muk syd key = M.murmur3 syd kee where
- kee = chr lo `B8.cons` chr hi `B8.cons` mempty
- lo = fromIntegral (key .&. 0xFF)
- hi = fromIntegral (key .&. 0xFF00 `div` 256)
-
diff --git a/src/Ob.hs b/src/Ob.hs
@@ -1,174 +0,0 @@
-{-# OPTIONS_GHC -Wall #-}
-
-module Ob (
- fein
- , fynd
- , feis
- , tail
- , fe
- , fen
- , capF
- , capFe
- , capFen
- ) where
-
-import Data.Bits
-import Data.Word (Word32)
-import Muk (muk)
-import Prelude hiding (tail)
-
--- | A PRF for j in [0, .., 3]
-capF :: Int -> Word32 -> Word32
-capF j key = fromIntegral (muk seed key) where
- seed = raku !! fromIntegral j
- raku = [
- 0xb76d5eed
- , 0xee281300
- , 0x85bcae01
- , 0x4b387af7
- ]
-
--- | Conceal structure v3.
-fein :: (Integral a, Bits a) => a -> a
-fein = loop where
- loop pyn =
- let lo = pyn .&. 0xFFFFFFFF
- hi = pyn .&. 0xFFFFFFFF00000000
- p32 = fromIntegral pyn :: Word32
- in if pyn >= 0x10000 && pyn <= 0xFFFFFFFF
- then 0x10000 + fromIntegral (feis (p32 - 0x10000))
- else if pyn >= 0x100000000 && pyn <= 0xFFFFFFFFFFFFFFFF
- then hi .|. loop lo
- else pyn
-
--- | Restore structure v3.
-fynd :: (Integral a, Bits a) => a -> a
-fynd = loop where
- loop cry =
- let lo = cry .&. 0xFFFFFFFF
- hi = cry .&. 0xFFFFFFFF00000000
- c32 = fromIntegral cry :: Word32
- in if cry >= 0x10000 && cry <= 0xFFFFFFFF
- then 0x10000 + fromIntegral (tail (c32 - 0x10000))
- else if cry >= 0x100000000 && cry <= 0xFFFFFFFFFFFFFFFF
- then hi .|. loop lo
- else cry
-
--- | Generalised Feistel cipher
---
--- See: Black and Rogaway (2002), "Ciphers with arbitrary finite domains."
---
--- Note that this has been adjusted from the reference paper in order to
--- support some legacy behaviour.
-feis :: Word32 -> Word32
-feis = capFe 4 65535 65536 0xFFFFFFFF capF
-
--- | Reverse 'feis'.
---
--- See: Black and Rogaway (2002), "Ciphers with arbitrary finite domains."
---
--- Note that this has been adjusted from the reference paper in order to
--- support some legacy behaviour.
-tail :: Word32 -> Word32
-tail = capFen 4 65535 65536 0xFFFFFFFF capF
-
-capFe
- :: Integral a
- => Int
- -> a
- -> a
- -> a
- -> (Int -> a -> a)
- -> a
- -> a
-capFe r a b k f m
- | c < k = c
- | otherwise = fe r a b f c
- where
- c = fe r a b f m
-
-fe
- :: Integral a
- => Int
- -> a
- -> a
- -> (Int -> a -> a)
- -> a
- -> a
-fe r a b f m = loop 1 capL capR where
- capL = m `mod` a
- capR = m `div` a
- loop j ell arr
- | j > r =
- if odd r
- then a * arr + ell
- else if arr == a
- then a * arr + ell
- else a * ell + arr
- | otherwise =
- let eff = f (pred j) arr
- tmp = if odd j
- then (ell + eff) `mod` a
- else (ell + eff) `mod` b
- in loop (succ j) arr tmp
-
-capFen
- :: Integral a
- => Int
- -> a
- -> a
- -> a
- -> (Int -> a -> a)
- -> a
- -> a
-capFen r a b k f m
- | c <= k = c
- | otherwise = fen r a b f c
- where
- c = fen r a b f m
-
-fen
- :: Integral a
- => Int
- -> a
- -> a
- -> (Int -> a -> a)
- -> a
- -> a
-fen r a b f m = loop r capL capR where
- ahh =
- if odd r
- then m `div` a
- else m `mod` a
-
- ale =
- if odd r
- then m `mod` a
- else m `div` a
-
- capL =
- if ale == a
- then ahh
- else ale
-
- capR =
- if ale == a
- then ale
- else ahh
-
- loop j ell arr
- | j < 1 = a * arr + ell
- | otherwise =
- let eff = f (pred j) ell
- -- NB (jtobin):
- --
- -- Slight deviation from B&R (2002) here to prevent negative
- -- values. We add 'a' or 'b' to arr as appropriate and reduce
- -- 'eff' modulo the same number before performing subtraction.
- --
- tmp = if odd j
- then (arr + a - (eff `mod` a)) `mod` a
- else (arr + b - (eff `mod` b)) `mod` b
- in loop (pred j) tmp ell
-
-
diff --git a/urbit-hob.cabal b/urbit-hob.cabal
@@ -0,0 +1,34 @@
+name: urbit-hob
+version: 0.1.0
+description: Hoon-style atom manipulation and printing functions
+homepage: https://github.com/urbit/urbit-hob#readme
+bug-reports: https://github.com/urbit/urbit-hob/issues
+author: Jared Tobin
+maintainer: jared@jtobin.io
+copyright: 2019 Jared Tobin
+license: MIT
+license-file: LICENSE
+build-type: Simple
+cabal-version: >= 1.10
+
+source-repository head
+ type: git
+ location: https://github.com/urbit/urbit-hob
+
+library
+ default-language: Haskell2010
+ hs-source-dirs: lib
+ other-modules: Paths_hob
+ exposed-modules:
+ Urbit.Ob
+ , Urbit.Ob.Co
+ , Urbit.Ob.Muk
+ , Urbit.Ob.Ob
+ build-depends:
+ base >= 4.7 && < 6
+ , bytestring >= 0.10 && < 1
+ , containers >= 0.5 && < 1
+ , murmur3 >= 1.0 && < 2
+ , text >= 1.2 && < 2
+ , vector >= 0.12 && < 1
+