locators (empty) → 0.2.3.1
raw patch · 6 files changed
+573/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, bytestring, cereal, containers, cryptohash, hspec, hspec-expectations, text
Files
- Setup.hs +2/−0
- locators.cabal +83/−0
- src/Data/Locator.hs +71/−0
- src/Data/Locator/Hashes.hs +106/−0
- src/Data/Locator/Locators.hs +291/−0
- tests/check.hs +20/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ locators.cabal view
@@ -0,0 +1,83 @@+cabal-version: >= 1.10+name: locators+version: 0.2.3.1+synopsis: Human exchangable identifiers and locators+license: BSD3+author: Andrew Cowie <andrew@operationaldynamics.com>+maintainer: Andrew Cowie <andrew@operationaldynamics.com>+copyright: © 2013 Operational Dynamics Consultin, Pty Ltd and Others+category: Other+tested-with: GHC == 7.6+stability: experimental++build-type: Simple++library+ default-language: Haskell2010++ build-depends: base >= 4 && <5,+ bytestring,+ text,+ containers,+ cryptohash,+ cereal++ hs-source-dirs: src+ include-dirs: .++ exposed-modules: Data.Locator+ other-modules: Data.Locator.Hashes,+ Data.Locator.Locators+++ ghc-options: -O2+ -threaded+ -Wall+ -Wwarn+ -fwarn-tabs+ -funbox-strict-fields+ -fno-warn-missing-signatures+ -fno-warn-unused-do-bind++ ghc-prof-options: -prof -fprof-auto-top+++test-suite check+ type: exitcode-stdio-1.0++ default-language: Haskell2010++ build-depends: base >= 4 && <5,+ HUnit,+ hspec,+ hspec-expectations,+ QuickCheck,+ bytestring,+ text,+ containers,+ cryptohash,+ cereal++ hs-source-dirs: src,tests+ main-is: check.hs++ ghc-options: -O2+ -threaded+ -Wall+ -Wwarn+ -fwarn-tabs+ -funbox-strict-fields+ -fno-warn-missing-signatures+ -fno-warn-unused-do-bind++ include-dirs: .++ ghc-prof-options: -prof -fprof-auto-top+++source-repository head+ type: git+ location: git@github.com:afcowie/locators.git+++-- vim: set tabstop=21 expandtab:
+ src/Data/Locator.hs view
@@ -0,0 +1,71 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2014 Operational Dynamics Consulting, Pty Ltd+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the BSD licence.+--+-- This code originally licenced GPLv2. Relicenced BSD3 on 2 Jan 2014.+--++{-# LANGUAGE OverloadedStrings #-}++--+-- |+-- Maintainer: Andrew Cowie+-- Stability: Experimental+--+-- /Background/+--+-- We had a need for identifiers that could be used by humans.+--+-- The requirement to be able to say these over the phone complicates matters.+-- Most people have approached this problem by using a phonetic alphabet. The+-- trouble comes when you hear people saying stuff like \"A as in ... uh,+-- Apple?\" (should be Alpha, of course) and \"U as in ... um, what's a word+-- that starts with U?\" It gets worse. Ever been to a GPG keysigning? Listen+-- to people attempt to read out the digits of their key fingerprints. ...C 3 E+-- D 0 0 0 0 0 0 0 2 B D B D... \"Did you say \'C\' or \'D\'?\" and \"how+-- many zeros was that?\" Brutal.+--+-- So what we need is a symbol set where each digit is unambigious and doesn't+-- collide with the phonetics of another symbol. This package provides+-- Locator16, a set of 16 letters and numbers that, when spoken in English,+-- have unique pronounciation.+--+-- Also included is code to work in base 62, which is simply @[\'0\'@-@\'9\'@,+-- @\'A\'@-@\'Z\'@, and @\'a\'@-@\'z\']@. These are frequently used to express+-- short codes in URL redirectors; you may find them a more useful encoding for+-- expressing numbers than base 16 hexidecimal.+--+module Data.Locator+(+ -- * Locator16+ -- | This was somewhat inspired by the record locators used by the civilian+ -- air travel industry, but with the restriction that the symbol set is+ -- carefully chosen (aviation locators do heroic things like excluding+ -- \'I\' but not much else) and, in the case of Locator16a, to not repeat+ -- symbols. They're not a reversable encoding, but assuming you're just+ -- generating identifiers and storing them somewhere, they're quite handy.+ --+ -- @TODO@ /link to paper with pronunciation study when published./+ --+ Locator(..),+ English16(..),+ fromLocator16,+ toLocator16,+ toLocator16a,+ hashStringToLocator16a,++ -- * Base62+ toBase62,+ fromBase62,+ hashStringToBase62++) where++import Data.Locator.Hashes+import Data.Locator.Locators
+ src/Data/Locator/Hashes.hs view
@@ -0,0 +1,106 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2014 Operational Dynamics Consulting, Pty Ltd+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the BSD licence.+--+-- This code originally licenced GPLv2. Relicenced BSD3 on 2 Jan 2014.+--++{-# LANGUAGE OverloadedStrings #-}++module Data.Locator.Hashes ( toBase62, fromBase62, hashStringToBase62) where+++import Prelude hiding (toInteger)++import Crypto.Hash.SHA1 as Crypto+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as S+import Data.Char (chr, isDigit, isLower, isUpper, ord)+import Data.Word+import Numeric (showIntAtBase)++--+-- Conversion between decimal and base 62+--++represent :: Int -> Char+represent x+ | x < 10 = chr (48 + x)+ | x < 36 = chr (65 + x - 10)+ | x < 62 = chr (97 + x - 36)+ | otherwise = '@'++toBase62 :: Integer -> String+toBase62 x =+ showIntAtBase 62 represent x ""++padWithZeros :: Int -> Integer -> String+padWithZeros digits x =+ pad ++ str+ where+ pad = take len (replicate digits '0')+ len = digits - length str+ str = toBase62 x+++value :: Char -> Int+value c+ | isDigit c = ord c - 48+ | isUpper c = ord c - 65 + 10+ | isLower c = ord c - 97 + 36+ | otherwise = 0++multiply :: Integer -> Char -> Integer+multiply acc c =+ acc * 62 + (fromIntegral $ value c)++fromBase62 :: String -> Integer+fromBase62 ss =+ foldl multiply 0 ss+++concatToInteger :: [Word8] -> Integer+concatToInteger bytes =+ foldl fn 0 bytes+ where+ fn acc b = (acc * 256) + (fromIntegral b)+++digest :: String -> Integer+digest ws =+ i+ where+ i = concatToInteger h+ h = B.unpack h'+ h' = Crypto.hash x'+ x' = S.pack ws+++--+-- | Take an arbitrary string, hash it, then pad it with zeros up to be a+-- @digits@-long string in base 62.+--+-- You may be interested to know that the 160-bit SHA1 hash used here can be+-- expressed without loss as 27 digits of base 62, for example:+--+-- >>> hashStringToBase62 27 "Hello World"+-- 1T8Sj4C5jVU6iQXCwCwJEPSWX6u+--+hashStringToBase62 :: Int -> ByteString -> ByteString+hashStringToBase62 digits s' =+ r'+ where+ s = S.unpack s'+ n = digest s -- SHA1 hash+ limit = 62 ^ digits+ x = mod n limit -- trim to specified number base62 chars+ r = padWithZeros digits x -- convert to String+ r' = S.pack r+
+ src/Data/Locator/Locators.hs view
@@ -0,0 +1,291 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2014 Operational Dynamics Consulting, Pty Ltd+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the BSD licence.+--+-- This code originally licenced GPLv2. Relicenced BSD3 on 2 Jan 2014.+--++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Locator.Locators+(+ Locator(..),+ English16(..),+ fromLocator16,+ toLocator16,+ toLocator16a,+ hashStringToLocator16a+) where+++import Prelude hiding (toInteger)++import Crypto.Hash.SHA1 as Crypto+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as S+import Data.List (mapAccumL)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Word+import Numeric (showIntAtBase)+++--+-- | A symbol set with sixteen uniquely pronounceable digits.+--+-- The fact there are sixteen symbols is more an indication of a certain degree+-- of bullheaded-ness on the part of the author, and less of any kind of actual+-- requirement. We might have a slighly better readback score if we dropped to+-- 15 or 14 unique characters. It does mean you can match up with hexidecimal,+-- which is not entirely without merit.+--+-- The grouping of letters and numbers was the hard part; having come up with+-- the set and deconflicted the choices, the ordering is then entirely+-- arbitrary. Since there are some numbers, might as well have them at the same+-- place they correspond to in base 10; the letters were then allocated in+-- alpha order in the remaining slots.+--+{-+ -- 0 Conflicts with @\'O\'@ obviously, and @\'Q\'@ often enough+ --+ -- 2 @\'U\'@, @\'W\'@, and @\'2\'@. @\'W\'@ is disqualifed because of+ -- the way Australians butcher double-this and triple-that. \"Double+ -- @\'U\'@\" or \"@\'W\'@\"?+ --+ -- C @\'B\'@, @\'C\'@, @\'D\'@, @\'E\'@, @\'G\'@, @\'P\'@, @\'T\'@,+ -- @\'V\'@, and @\'3\'@ plus @\'Z\'@ because Americans can't pronounce+ -- Zed properly.+ --+ -- 4 @\'4\'@ and @\'5\'@ are often confused, and @\'5\'@, definitely+ -- out due to its collision with @\'I\'@ when spoken and @\'S\'@ in+ -- writing.+ --+ -- F @\'F\'@ and @\'S\'@ are notoriously confused, making the choice of+ -- @\'F\'@ borderline, but @\'S\'@ is already disqualified for looking+ -- like @\'5\'@.+ --+ -- K group of @\'A\'@, @\'J\'@, @\'K\'@.+ --+ -- L @\'L\'@ has good phonetics, and as long as it's upper case (which+ -- the whole 'English16' symbol set is) there's no conflict with+ -- @\'1\'@.+ --+ -- M choice from @\'M\'@ and @\'N\'@; the latter is a little too close+ -- to @\'7\'@.+ --+ -- X choice from @\'X\'@ and @\'6\'@.+ --+ -- Y choice from @\'I\'@, @\'Y\'@, @\'5\'@. @\'I\'@ is out for the+ -- usual reason of being similar to @\'1\'@.+-}+data English16+ = Zero -- ^ @\'0\'@ /0th/+ | One -- ^ @\'1\'@ /1st/+ | Two -- ^ @\'2\'@ /2nd/+ | Charlie -- ^ @\'C\'@ /3rd/+ | Four -- ^ @\'4\'@ /4th/+ | Foxtrot -- ^ @\'F\'@ /5th/+ | Hotel -- ^ @\'H\'@ /6th/+ | Seven -- ^ @\'7\'@ /7th/+ | Eight -- ^ @\'8\'@ /8th/+ | Nine -- ^ @\'9\'@ /9th/+ | Kilo -- ^ @\'K\'@ /10th/+ | Lima -- ^ @\'L\'@ /11th/+ | Mike -- ^ @\'M\'@ /12th/+ | Romeo -- ^ @\'R\'@ /13th/+ | XRay -- ^ @\'X\'@ /14th/+ | Yankee -- ^ @\'Y\'@ /15th/+ deriving (Eq, Ord, Enum, Bounded)+++class (Ord α, Enum α, Bounded α) => Locator α where+ locatorToDigit :: α -> Char+ digitToLocator :: Char -> α+++instance Locator English16 where++-- locatorToDigit :: English16 -> Char+ locatorToDigit x =+ case x of+ Zero -> '0'+ One -> '1'+ Two -> '2'+ Charlie -> 'C'+ Four -> '4'+ Foxtrot -> 'F'+ Hotel -> 'H'+ Seven -> '7'+ Eight -> '8'+ Nine -> '9'+ Kilo -> 'K'+ Lima -> 'L'+ Mike -> 'M'+ Romeo -> 'R'+ XRay -> 'X'+ Yankee -> 'Y'++-- digitToLocator :: Char -> English16+ digitToLocator c =+ case c of+ '0' -> Zero+ '1' -> One+ '2' -> Two+ 'C' -> Charlie+ '4' -> Four+ 'F' -> Foxtrot+ 'H' -> Hotel+ '7' -> Seven+ '8' -> Eight+ '9' -> Nine+ 'K' -> Kilo+ 'L' -> Lima+ 'M' -> Mike+ 'R' -> Romeo+ 'X' -> XRay+ 'Y' -> Yankee+ _ -> error "Illegal digit"++++represent :: Int -> Char+represent n =+ locatorToDigit $ (toEnum n :: English16) -- FIXME+++instance Show English16 where+ show x = [c]+ where+ c = locatorToDigit x+++++value :: Char -> Int+value c =+ fromEnum $ (digitToLocator c :: English16) -- FIXME++++--+-- | Given a number, convert it to a string in the Locator16 base 16 symbol+-- alphabet. You can use this as a replacement for the standard \'0\'-\'9\'+-- \'A\'-\'F\' symbols traditionally used to express hexidemimal, though really+-- the fact that we came up with 16 total unique symbols was a nice+-- co-incidence, not a requirement.+--+toLocator16 :: Int -> String+toLocator16 x =+ showIntAtBase 16 represent x ""+++--+-- | Represent a number in Locator16a format. This uses the Locator16 symbol+-- set, and additionally specifies that no symbol can be repeated. The /a/ in+-- Locator16a represents that this transformation is done on the cheap; when+-- converting if we end up with \'9\' \'9\' we simply pick the subsequent digit+-- in the enum, in this case getting you \'9\' \'K\'.+--+-- Note that the transformation is /not/ reversible. A number like @4369@+-- (which is @0x1111@, incidentally) encodes as @12C4@. So do @4370@, @4371@,+-- and @4372@. The point is not uniqueness, but readibility in adverse+-- conditions. So while you can count locators, they don't map continuously to+-- base10 integers.+--+-- The first argument is the number of digits you'd like in the locator; if the+-- number passed in is less than 16^limit, then the result will be padded.+--+-- >>> toLocator16a 6 4369+-- 12C40F+--+toLocator16a :: Int -> Int -> String+toLocator16a limit n =+ let+ ls = convert n (replicate limit minBound) :: [English16]+ (_,us) = mapAccumL uniq Set.empty ls+ in+ map locatorToDigit (take limit us)+ where+ convert :: Locator α => Int -> [α] -> [α]+ convert 0 xs = xs+ convert i xs =+ let+ (d,r) = divMod i 16+ x = toEnum r+ in+ convert d (x:xs)++ uniq :: Locator α => Set α -> α -> (Set α, α)+ uniq s x =+ if Set.member x s+ then uniq s (subsequent x)+ else (Set.insert x s, x)++ subsequent :: Locator α => α -> α+ subsequent x =+ if x == maxBound+ then minBound+ else succ x+++multiply :: Int -> Char -> Int+multiply acc c =+ acc * 16 + value c++--+-- | Given a number encoded in Locator16, convert it back to an integer.+--+fromLocator16 :: String -> Int+fromLocator16 ss =+ foldl multiply 0 ss+++--+-- Given a string, convert it into a N character hash.+--++concatToInteger :: [Word8] -> Int+concatToInteger bytes =+ foldl fn 0 bytes+ where+ fn acc b = (acc * 256) + (fromIntegral b)++digest :: String -> Int+digest ws =+ i+ where+ i = concatToInteger h+ h = B.unpack h'+ h' = Crypto.hash x'+ x' = S.pack ws+++--+-- | Take an arbitrary sequence of bytes, hash it with SHA1, then format as a+-- short @digits@-long Locator16 string.+--+-- >>> hashStringToLocator16a 6 "Hello World"+-- M48HR0+--++hashStringToLocator16a :: Int -> ByteString -> ByteString+hashStringToLocator16a limit s' =+ let+ s = S.unpack s'+ n = digest s -- SHA1 hash+ r = mod n upperBound -- trim to specified number of base 16 chars+ x = toLocator16a limit r -- express in locator16+ b' = S.pack x+ in+ b'+ where+ upperBound = 16 ^ limit+
+ tests/check.hs view
@@ -0,0 +1,20 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2013-2014 Operational Dynamics Consulting, Pty Ltd+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the BSD licence.+--++module Main where++import Test.Hspec (hspec)++import TestSuite (suite)++main :: IO ()+main = do+ hspec suite