locators 0.2.4.3 → 0.2.4.4
raw patch · 8 files changed
+499/−502 lines, 8 filesdep −cerealdep −hspec-expectations
Dependencies removed: cereal, hspec-expectations
Files
- lib/Data/Locator.hs +72/−0
- lib/Data/Locator/Hashes.hs +119/−0
- lib/Data/Locator/Locators.hs +292/−0
- locators.cabal +5/−8
- src/Data/Locator.hs +0/−72
- src/Data/Locator/Hashes.hs +0/−119
- src/Data/Locator/Locators.hs +0/−292
- tests/TestSuite.hs +11/−11
+ lib/Data/Locator.hs view
@@ -0,0 +1,72 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2017 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,+ padWithZeros,+ hashStringToBase62++) where++import Data.Locator.Hashes+import Data.Locator.Locators
+ lib/Data/Locator/Hashes.hs view
@@ -0,0 +1,119 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2017 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,+ padWithZeros,+ 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 ""++--+-- | Utility function to prepend \'0\' characters to a string representing a+-- number. This allows you to ensure a fixed width for numbers that are less+-- than the desired width in size. This comes up frequently when representing+-- numbers in other bases greater than 10 as they are inevitably presented as+-- text, and not having them evenly justified can (at best) be ugly and (at+-- worst) actually lead to parsing and conversion bugs.+--+padWithZeros :: Int -> String -> String+padWithZeros digits str =+ pad ++ str+ where+ pad = take len (replicate digits '0')+ len = digits - length str+++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+ str = toBase62 x+ r = padWithZeros digits str -- convert to String+ r' = S.pack r+
+ lib/Data/Locator/Locators.hs view
@@ -0,0 +1,292 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2017 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+ n' = abs n+ 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+
locators.cabal view
@@ -1,6 +1,6 @@-cabal-version: >= 1.10+cabal-version: 1.24 name: locators-version: 0.2.4.3+version: 0.2.4.4 synopsis: Human exchangable identifiers and locators license: BSD3 license-file: LICENCE@@ -15,7 +15,7 @@ maintainer: Andrew Cowie <andrew@operationaldynamics.com> copyright: © 2013-2018 Operational Dynamics Consulting, Pty Ltd and Others category: Other-tested-with: GHC == 8.2+tested-with: GHC == 8.2.2, GHC == 8.4.2 stability: experimental build-type: Simple@@ -26,10 +26,9 @@ build-depends: base >= 4 && <5, bytestring, containers,- cryptohash,- cereal+ cryptohash - hs-source-dirs: src+ hs-source-dirs: lib include-dirs: . exposed-modules: Data.Locator@@ -55,12 +54,10 @@ build-depends: base >= 4 && <5, HUnit, hspec,- hspec-expectations, QuickCheck, bytestring, containers, cryptohash,- cereal, locators hs-source-dirs: tests
− src/Data/Locator.hs
@@ -1,72 +0,0 @@------ Human exchangable identifiers and locators------ Copyright © 2011-2017 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,- padWithZeros,- hashStringToBase62--) where--import Data.Locator.Hashes-import Data.Locator.Locators
− src/Data/Locator/Hashes.hs
@@ -1,119 +0,0 @@------ Human exchangable identifiers and locators------ Copyright © 2011-2017 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,- padWithZeros,- 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 ""------- | Utility function to prepend \'0\' characters to a string representing a--- number. This allows you to ensure a fixed width for numbers that are less--- than the desired width in size. This comes up frequently when representing--- numbers in other bases greater than 10 as they are inevitably presented as--- text, and not having them evenly justified can (at best) be ugly and (at--- worst) actually lead to parsing and conversion bugs.----padWithZeros :: Int -> String -> String-padWithZeros digits str =- pad ++ str- where- pad = take len (replicate digits '0')- len = digits - length str---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- str = toBase62 x- r = padWithZeros digits str -- convert to String- r' = S.pack r-
− src/Data/Locator/Locators.hs
@@ -1,292 +0,0 @@------ Human exchangable identifiers and locators------ Copyright © 2011-2017 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- n' = abs n- 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/TestSuite.hs view
@@ -69,23 +69,23 @@ -- testKnownLocator16a = it "constrains Locator16a to unique digits" $ do- assertEqual "Incorrect result" "12C4FH" (toLocator16a 6 0x111111)- assertEqual "Incorrect result" "789KLM" (toLocator16a 6 0x777777)- assertEqual "Incorrect result" "MRXY01" (toLocator16a 6 0xCCCCCC)+ toLocator16a 6 0x111111 `shouldBe` "12C4FH"+ toLocator16a 6 0x777777 `shouldBe` "789KLM"+ toLocator16a 6 0xCCCCCC `shouldBe` "MRXY01" testProblematicEdgeCases = it "converstion to Locator16a correct on corner cases" $ do- assertEqual "Incorrect result" "012C4F" (toLocator16a 6 0x0)- assertEqual "Incorrect result" "FHL417" (hashStringToLocator16a 6 "perf_data")- assertEqual "Incorrect result" "K48F01" (hashStringToLocator16a 6 "perf_data/bletchley")+ toLocator16a 6 0x0 `shouldBe` "012C4F"+ hashStringToLocator16a 6 "perf_data" `shouldBe` "FHL417"+ hashStringToLocator16a 6 "perf_data/bletchley" `shouldBe` "K48F01" testPaddingRefactored = it "correctly pads strings" $ do- assertEqual "Incorrect result" "00001" (padWithZeros 5 "1")- assertEqual "Incorrect result" "123456" (padWithZeros 5 "123456")- assertEqual "Incorrect result" "LygHa16AHYG" (padWithZeros 11 . toBase62 $ 2^64)- assertEqual "Incorrect result" "k8SQgkJtxLo" (hashStringToBase62 11 . S.pack . show $ 2^64)+ padWithZeros 5 "1" `shouldBe` "00001"+ padWithZeros 5 "123456" `shouldBe` "123456"+ (padWithZeros 11 . toBase62 $ 2^64) `shouldBe` "LygHa16AHYG"+ (hashStringToBase62 11 . S.pack . show $ 2^64) `shouldBe` "k8SQgkJtxLo" testNegativeNumbers = it "doesn't explode if fed a negative number" $ do- assertEqual "Incorrect outcome" "1" (toLocator16a 1 (-1))+ toLocator16a 1 (-1) `shouldBe` "1"