urbit-hob 0.1.1 → 0.2.0
raw patch · 11 files changed
+340/−88 lines, 11 filesdep −cerealdep ~text
Dependencies removed: cereal
Dependency ranges changed: text
Files
- lib/Data/Serialize/Extended.hs +22/−0
- lib/Urbit/Ob/Co.hs +125/−59
- lib/Urbit/Ob/Muk.hs +13/−0
- lib/Urbit/Ob/Ob.hs +15/−2
- test/Co.hs +6/−8
- test/Co/Tests/Property.hs +42/−0
- test/Co/Tests/Unit.hs +40/−0
- test/Ob.hs +1/−1
- test/Ob/Tests/Property.hs +30/−2
- test/Ob/Tests/Unit.hs +23/−5
- urbit-hob.cabal +23/−11
+ lib/Data/Serialize/Extended.hs view
@@ -0,0 +1,22 @@++module Data.Serialize.Extended (+ roll+ , unroll+ ) where++import Data.Bits+import qualified Data.ByteString as BS+import Data.List (unfoldr)+import Numeric.Natural (Natural)++-- | Simple little-endian ByteString encoding for Naturals.+unroll :: Natural -> BS.ByteString+unroll = BS.pack . unfoldr step where+ step 0 = Nothing+ step i = Just (fromIntegral i, i `shiftR` 8)++-- | Simple little-endian ByteString decoding for Naturals.+roll :: BS.ByteString -> Natural+roll = foldr unstep 0 . BS.unpack where+ unstep b a = a `shiftL` 8 .|. fromIntegral b+
lib/Urbit/Ob/Co.hs view
@@ -1,70 +1,132 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} +-- |+-- Module: Urbit.Ob.Co+-- Copyright: (c) 2019 Jared Tobin+-- License: MIT+--+-- Maintainer: Jared Tobin <jared@jtobin.io>+-- Stability: unstable+-- Portability: ghc+--+-- General functions for atom printing.+--+-- Roughly analogous to the +co arm in hoon.hoon.+ module Urbit.Ob.Co ( Patp- , render , patp , fromPatp++ , render+ , parse ) where import qualified Data.ByteString as BS-import qualified Data.Vector as V-import qualified Data.Serialize as C+import Data.Char (isAsciiLower)+import Data.Foldable (foldrM)+import qualified Data.Serialize.Extended as C import qualified Data.Text as T-import Data.Word (Word8, Word16, Word)-import Urbit.Ob.Ob (fein, fynd)+import qualified Data.Vector as V+import Data.Word (Word8)+import Numeric.Natural (Natural)+import Prelude hiding (log)+import qualified Urbit.Ob.Ob as Ob (fein, fynd) +-- | Hoon's \@p encoding.+--+-- This encoding is an /obfuscated/ representation of some underlying number,+-- but a pronounceable, memorable, and unique one.+--+-- The representation exists for any natural number, but it's typically used+-- only for naming Azimuth points, and thus normal 32-bit Urbit ships.+--+-- (It's also used for naming comets, i.e. self-signed 128-bit Urbit ships.)+-- newtype Patp = Patp BS.ByteString- deriving (Eq, Show)+ deriving Eq --- | 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- sxz = fein n- sxz8 = fromIntegral sxz :: Word8+instance Show Patp where+ show = T.unpack . render - _patp- | met 3 sxz <= 1 = Patp (BS.cons 0 (BS.singleton sxz8))- | otherwise = Patp (C.encode (fromIntegral sxz :: Word))+unPatp :: Patp -> BS.ByteString+unPatp (Patp p) = p --- | Convert a Patp value to an Int.-fromPatp :: Patp -> Int-fromPatp (Patp p) = decoded where- decoded = case BS.length p of- 2 -> case C.decode p :: Either String Word16 of- Left _ -> internalErr "fromPatp"- Right x -> fynd (fromIntegral x)- _ -> case C.decode p :: Either String Word of- Left _ -> internalErr "fromPatp"- Right x -> fynd (fromIntegral x)+-- | Convert a 'Natural' to \@p.+--+-- >>> patp 0+-- ~zod+-- >>> patp 256+-- ~marzod+-- >>> patp 65536+-- ~dapnep-ronmyl+-- >>> patp 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF+-- ~fipfes-fipfes-fipfes-fipfes--fipfes-fipfes-fipfes-fipfes+--+patp :: Natural -> Patp+patp = Patp . BS.reverse . C.unroll . Ob.fein --- | Render a Patp value as Text.+-- | Convert a \@p value to its corresponding 'Natural'.+--+-- >>> let zod = patp 0+-- >>> fromPatp zod+-- 0+--+fromPatp :: Patp -> Natural+fromPatp = Ob.fynd . C.roll . BS.reverse . unPatp++-- | Render a \@p value as 'T.Text'.+--+-- >>> render (patp 0)+-- "~zod"+-- >>> render (patp 15663360)+-- "~nidsut-tomdun" render :: Patp -> T.Text-render (Patp p) = prefixed where- prefix = V.unsafeIndex prefixes . fromIntegral- suffix = V.unsafeIndex suffixes . fromIntegral+render (Patp bs) = render' bs - prefixed = case T.uncons encoded of- Just ('-', pp) -> T.cons '~' pp- Just _ -> T.cons '~' encoded- _ -> internalErr "render"+render' :: BS.ByteString -> T.Text+render' bs =+ T.cons '~'+ . snd+ . BS.foldr alg (0 :: Int, mempty)+ $ padded+ where+ alg val (idx, acc) =+ let syl = if even idx then suffix val else prefix val+ glue+ | idx `mod` 8 == 0 = if idx == 0 then mempty else "--"+ | even idx = "-"+ | otherwise = mempty+ in (succ idx, syl <> glue <> acc) - encoded = foldr alg mempty pruned where- alg (idx, x) acc- | odd idx = suffix x <> acc- | otherwise = "-" <> prefix x <> acc+ padded =+ let len = BS.length bs+ in if (odd len && len > 2) || len == 0+ then BS.cons 0 bs+ else bs - pruned =- let len = BS.length p- indexed = zip [len, pred len..] (BS.unpack p)- padding (idx, val) = idx /= 1 && val == 0- in dropWhile padding indexed+-- | Parse a \@p value existing as 'T.Text'.+--+-- >>> parse "~nidsut-tomdun"+-- Right ~nidsut-tomdun+-- > parse "~fipfes-fipfes-fipfes-doznec"+-- Right ~fipfes-fipfes-fipfes-doznec+--+parse :: T.Text -> Either T.Text Patp+parse p =+ fmap (Patp . snd)+ $ foldrM alg (0 :: Int, mempty) syls+ where+ alg syl (idx, acc) = do+ word <- if even idx then fromSuffix syl else fromPrefix syl+ return (succ idx, BS.cons word acc) + syls =+ T.chunksOf 3+ . T.filter isAsciiLower+ $ p+ prefixes :: V.Vector T.Text prefixes = V.fromList ["doz","mar","bin","wan","sam","lit","sig","hid","fid","lis","sog","dir"@@ -90,6 +152,16 @@ ,"lap","tal","pit","nam","bon","ros","ton","fod","pon","sov","noc","sor" ,"lav","mat","mip","fip"] +prefix :: Integral a => a -> T.Text+prefix = V.unsafeIndex prefixes . fromIntegral++fromPrefix :: T.Text -> Either T.Text Word8+fromPrefix syl = case V.findIndex (== syl) prefixes of+ Nothing -> Left (msg syl)+ Just x -> Right (fromIntegral x :: Word8)+ where+ msg s = "urbit-hob (fromPrefix): invalid prefix \"" <> s <> "\""+ suffixes :: V.Vector T.Text suffixes = V.fromList ["zod","nec","bud","wes","sev","per","sut","let","ful","pen","syt","dur"@@ -115,19 +187,13 @@ ,"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)+suffix :: Integral a => a -> T.Text+suffix = V.unsafeIndex suffixes . fromIntegral -internalErr :: String -> a-internalErr fn = error $- "urbit-hob (" <> fn <> "): internal error -- please report this as a bug!"+fromSuffix :: T.Text -> Either T.Text Word8+fromSuffix syl = case V.findIndex (== syl) suffixes of+ Nothing -> Left (msg syl)+ Just x -> Right (fromIntegral x :: Word8)+ where+ msg s = "urbit-hob (fromSuffix): invalid suffix \"" <> s <> "\""
lib/Urbit/Ob/Muk.hs view
@@ -1,4 +1,17 @@ +-- |+-- Module: Urbit.Ob.Muk+-- Copyright: (c) 2019 Jared Tobin+-- License: MIT+--+-- Maintainer: Jared Tobin <jared@jtobin.io>+-- Stability: unstable+-- Portability: ghc+--+-- A specific murmur3 variant.+--+-- Analogous to +muk in hoon.hoon.+ module Urbit.Ob.Muk ( muk ) where
lib/Urbit/Ob/Ob.hs view
@@ -1,5 +1,18 @@ {-# LANGUAGE BangPatterns #-} +-- |+-- Module: Urbit.Ob.Ob+-- Copyright: (c) 2019 Jared Tobin+-- License: MIT+--+-- Maintainer: Jared Tobin <jared@jtobin.io>+-- Stability: unstable+-- Portability: ghc+--+-- Integer obfuscation functions.+--+-- Analogous to the +ob arm in hoon.hoon.+ module Urbit.Ob.Ob ( fein , fynd@@ -14,8 +27,8 @@ import Data.Bits import Data.Word (Word32)-import Urbit.Ob.Muk (muk) import Prelude hiding (tail)+import Urbit.Ob.Muk (muk) -- | Conceal structure v3. fein :: (Integral a, Bits a) => a -> a@@ -43,7 +56,7 @@ then hi .|. loop lo else cry --- | Generalised Feistel cipher+-- | Generalised Feistel cipher. -- -- See: Black and Rogaway (2002), "Ciphers with arbitrary finite domains." --
test/Co.hs view
@@ -1,14 +1,12 @@ module Main where +import qualified Co.Tests.Property as P+import qualified Co.Tests.Unit as U import Test.Hspec-import Test.Hspec.Core.QuickCheck (modifyMaxSuccess)-import Test.QuickCheck-import qualified Urbit.Ob.Co as Co main :: IO ()-main = hspec $- describe "fromPatp" $- modifyMaxSuccess (const 1000) $- it "inverts patp" $- property $ \(NonNegative x) -> Co.fromPatp (Co.patp x) == x+main =+ hspec $ do+ context "property tests" P.tests+ context "unit tests" U.tests
+ test/Co/Tests/Property.hs view
@@ -0,0 +1,42 @@++module Co.Tests.Property (+ tests+ ) where++import qualified Data.Text as T+import Data.Word (Word32)+import Numeric.Natural (Natural)+import Test.Hspec+import Test.Hspec.Core.QuickCheck (modifyMaxSuccess)+import Test.QuickCheck+import qualified Urbit.Ob.Co as Co++nats :: Gen Natural+nats = fmap fromIntegral (arbitrary :: Gen Word32)++patps :: Gen Co.Patp+patps = fmap Co.patp nats++patpStrings :: Gen T.Text+patpStrings = fmap Co.render patps++tests :: Spec+tests = do+ describe "fromPatp" $+ modifyMaxSuccess (const 1000) $+ it "inverts patp" $+ forAll nats $ \x -> Co.fromPatp (Co.patp x) == x++ describe "patp" $+ modifyMaxSuccess (const 1000) $+ it "inverts fromPatp" $+ forAll patps $ \x -> Co.patp (Co.fromPatp x) == x++ describe "render" $+ modifyMaxSuccess (const 1000) $+ it "inverts parse" $+ forAll patpStrings $ \x ->+ case Co.parse x of+ Left _ -> False+ Right p -> Co.render p == x+
+ test/Co/Tests/Unit.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module Co.Tests.Unit (+ tests+ ) where++import Data.Word (Word32)+import Test.Hspec+import qualified Urbit.Ob.Co as Co++tests :: Spec+tests =+ describe "render" $ do+ it "matches 32-bit reference values" $ do+ Co.render (Co.patp 0) `shouldBe` "~zod"+ Co.render (Co.patp 255) `shouldBe` "~fes"+ Co.render (Co.patp 256) `shouldBe` "~marzod"+ Co.render (Co.patp 65535) `shouldBe` "~fipfes"+ Co.render (Co.patp 65536) `shouldBe` "~dapnep-ronmyl"+ Co.render (Co.patp 15663360) `shouldBe` "~nidsut-tomdun"+ Co.render (Co.patp 0xFFFFFFFF) `shouldBe` "~dostec-risfen"++ it "matches 64-bit reference values" $ do+ let big_64_01 = 0x0000000100000000+ Co.render (Co.patp big_64_01) `shouldBe` "~doznec-dozzod-dozzod"++ let big_64_02 = 0xFFFFFFFFFFFFFFFF+ Co.render (Co.patp big_64_02) `shouldBe` "~fipfes-fipfes-dostec-risfen"++ it "matches 128-bit reference values" $ do+ let big_128_01 = 0x00000000000000010000000000000000+ patp_128_01 = "~doznec--dozzod-dozzod-dozzod-dozzod"+ Co.render (Co.patp big_128_01) `shouldBe` patp_128_01++ let big_128_02 = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF+ patp_128_02 =+ "~fipfes-fipfes-fipfes-fipfes--fipfes-fipfes-fipfes-fipfes"++ Co.render (Co.patp big_128_02) `shouldBe` patp_128_02+
test/Ob.hs view
@@ -11,5 +11,5 @@ hspec $ do context "small input space" S.tests context "medium input space" M.tests- context "32-bit input space" P.tests+ context "propert tests" P.tests context "unit tests" U.tests
test/Ob/Tests/Property.hs view
@@ -3,20 +3,48 @@ tests ) where +import Data.Word (Word32, Word64)+import Numeric.Natural (Natural) import Test.Hspec import Test.Hspec.Core.QuickCheck (modifyMaxSuccess) import Test.QuickCheck import qualified Urbit.Ob.Ob as Ob +planets :: Gen Word32+planets = arbitrary `suchThat` (> 0xFFFF)++word64 :: Gen Word64+word64 = arbitrary++nat :: Gen Natural+nat = do+ a <- fmap fromIntegral word64+ b <- fmap fromIntegral word64+ return (a * b)+ tests :: Spec tests = do+ describe "fynd" $+ modifyMaxSuccess (const 1000) $+ it "inverts fein" $+ forAll nat $ \x ->+ Ob.fynd (Ob.fein x) == x++ describe "fein" $+ modifyMaxSuccess (const 1000) $+ it "inverts fynd" $+ forAll nat $ \x ->+ Ob.fein (Ob.fynd x) == x+ describe "feis" $ modifyMaxSuccess (const 1000) $ it "inverts tail" $- property $ \x -> Ob.feis (Ob.tail x) == x+ forAll planets $ \planet -> property $+ Ob.feis (Ob.tail planet) == planet describe "tail" $ modifyMaxSuccess (const 1000) $ it "inverts feis" $- property $ \x -> Ob.tail (Ob.feis x) == x+ forAll planets $ \planet -> property $+ Ob.tail (Ob.feis planet) == planet
test/Ob/Tests/Unit.hs view
@@ -3,13 +3,31 @@ tests ) where +import Data.Word (Word32) import Test.Hspec import qualified Urbit.Ob.Ob as Ob tests :: Spec-tests =- describe "tail . feis" $- context "when applied to 2052065766" $- it "should be the identity function" $- Ob.tail (Ob.feis 2052065766) `shouldBe` 2052065766+tests = do+ describe "fein" $+ it "matches reference values" $ do+ Ob.fein 123456789 `shouldBe` (1897766331 :: Int)+ Ob.fein 15663360 `shouldBe` (1208402137 :: Int)+ Ob.fein 0x10000000000000000 `shouldBe` (0x10000000000000000 :: Integer)++ describe "fynd" $+ it "matches reference values" $ do+ Ob.fynd 1208402137 `shouldBe` (15663360 :: Int)+ Ob.fynd 1897766331 `shouldBe` (123456789 :: Int)+ Ob.fynd 0x10000000000000000 `shouldBe` (0x10000000000000000 :: Integer)++ describe "feis" $+ it "matches reference values" $ do+ Ob.feis 123456789 `shouldBe` 2060458291+ Ob.feis 15663360 `shouldBe` 1195593620++ describe "tail" $+ it "matches reference values" $ do+ Ob.tail 123456789 `shouldBe` 1107963580+ Ob.tail 1195593620 `shouldBe` 15663360
urbit-hob.cabal view
@@ -1,5 +1,5 @@ name: urbit-hob-version: 0.1.1+version: 0.2.0 synopsis: Hoon-style atom manipulation and printing functions homepage: https://github.com/urbit/urbit-hob bug-reports: https://github.com/urbit/urbit-hob/issues@@ -16,20 +16,25 @@ base used by Urbit. The \@p encoding is used for naming ships; it uniquely represents a 32-bit number in a memorable and pronounceable fashion. .- The \@p encoding is an obfuscated representation of an underlying 32-bit+ The \@p encoding is an /obfuscated/ representation of an underlying 32-bit number, in particular, hence the \"ob\" in the library's name. . The @Urbit.Ob@ module exposes two functions, 'patp' and 'fromPatp', for- converting between representations. You can render a 'Patp' value via the- 'render' function.+ converting between representations. You can also render a 'Patp' value via+ the 'render' function, or parse one via 'parse'. .- Here's a quick example:+ Some quick examples: .- > import qualified Urbit.Ob as Ob- >- > let nidsut = Ob.patp 15663360- > Ob.render nidsut -- "~nidsut-tomdun"- > Ob.fromPatp nidsut -- 15663360+ >>> :set -XOverloadedStrings+ >>> import qualified Urbit.Ob as Ob+ >>>+ >>> let nidsut = Ob.patp 15663360+ >>> Ob.render nidsut+ "~nidsut-tomdun"+ >>> Ob.fromPatp nidsut+ 15663360+ >>> Ob.parse "~nidsut-tomdun"+ Right ~nidsut-tomdun source-repository head type: git@@ -54,10 +59,13 @@ , Urbit.Ob.Co , Urbit.Ob.Muk , Urbit.Ob.Ob++ other-modules:+ Data.Serialize.Extended+ build-depends: base >= 4.7 && < 6 , bytestring >= 0.10 && < 1- , cereal >= 0.5 && < 1 , murmur3 >= 1.0 && < 2 , text >= 1.2 && < 2 , vector >= 0.12 && < 1@@ -85,6 +93,9 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Co.hs+ other-modules:+ Co.Tests.Property+ Co.Tests.Unit default-language: Haskell2010 ghc-options: -rtsopts@@ -93,5 +104,6 @@ , hspec , hspec-core , QuickCheck+ , text , urbit-hob