locators 0.2.4.4 → 0.3.0.2
raw patch · 10 files changed
+723/−374 lines, 10 files
Files
- LICENCE +0/−32
- LICENSE +19/−0
- lib/Data/Locator.hs +44/−20
- lib/Data/Locator/Common.hs +138/−0
- lib/Data/Locator/English16.hs +263/−0
- lib/Data/Locator/Latin25.hs +186/−0
- lib/Data/Locator/Locators.hs +0/−292
- locators.cabal +12/−10
- tests/TestSuite.hs +59/−19
- tests/check.hs +2/−1
− LICENCE
@@ -1,32 +0,0 @@-Human exchangable identifiers and locators--Copyright © 2013-2018 Operational Dynamics Consulting, Pty Ltd-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-- 1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- 2. Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.- - 3. Neither the name of the project nor the names of its contributors- may be used to endorse or promote products derived from this - software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright © 2013-2020 Athae Eredh Siniath and Others++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER+DEALINGS IN THE SOFTWARE.
lib/Data/Locator.hs view
@@ -1,7 +1,7 @@ -- -- Human exchangable identifiers and locators ----- Copyright © 2011-2017 Operational Dynamics Consulting, Pty Ltd+-- Copyright © 2011-2018 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:@@ -33,17 +33,26 @@ -- -- 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.+-- 'English16', a set of 16 letters and numbers that, when spoken in /English/,+-- have unique pronounciation and have been very successful in verbal+-- communications over noisy links. ----- 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.+-- Ironically, however, when used in written applications the English16 set is+-- a bit restrictive. When /looking/ at them they don't have much variety (it+-- turned out they're very blocky—so much so you have to squint). If the+-- application is transcription or identification visually then the criteria is+-- shapes that are distinct, rather than their sound. For these uses we provide+-- 'Latin25', a set of 25 symbols useful for identifiers in automated systems+-- that nevertheless have to be operated or debugged by humans. --+-- Finally, 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+ -- * English16: locators humans can exchange -- | 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@@ -53,20 +62,35 @@ -- -- @TODO@ /link to paper with pronunciation study when published./ --- Locator(..),- English16(..),- fromLocator16,- toLocator16,- toLocator16a,- hashStringToLocator16a,+ Locator(..)+ , English16(..)+ , fromEnglish16+ , toEnglish16+ , toEnglish16a+ , hashStringToEnglish16a - -- * Base62- toBase62,- fromBase62,- padWithZeros,- hashStringToBase62+ -- * Latin25: a visually distinct character set+ -- An althernate character set chosen for visual distinctiveness (rather+ -- than the aural distinctiveness goal of "English16").+ , Latin25(..)+ , fromLatin25+ , toLatin25+ , hashStringToLatin25 + -- * Base62: binary without punctuation+ , toBase62+ , fromBase62+ , padWithZeros+ , hashStringToBase62++ -- * Deprecated functions+ , fromLocator16+ , toLocator16+ , toLocator16a+ , hashStringToLocator16a ) where +import Data.Locator.Common import Data.Locator.Hashes-import Data.Locator.Locators+import Data.Locator.English16+import Data.Locator.Latin25
+ lib/Data/Locator/Common.hs view
@@ -0,0 +1,138 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2018 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 #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeApplications #-}++module Data.Locator.Common+ ( Locator(..)+ , represent+ , value+ , toLocatorUnique+ , multiply+ , fromLocator+ , concatToInteger+ , digest+ ) where++import Prelude hiding (toInteger)++import Crypto.Hash.SHA1 as Crypto+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++class (Ord α, Enum α, Bounded α) => Locator α where+ locatorToDigit :: α -> Char+ digitToLocator :: Char -> α+++represent :: Locator α => α -> Int -> Char+represent (_ :: α) n =+ locatorToDigit $ (toEnum n :: α)++{-+value :: Locator α => α -> Char -> Int+value c (_ :: α) =+ fromEnum $ (digitToLocator c :: α)+-}++value :: Locator α => α -> Char -> Int+value (_ :: α) c =+ fromEnum $ (digitToLocator c :: α)++--+-- | 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+--+toLocatorUnique :: Locator α => Int -> Int -> α -> String+toLocatorUnique limit n (_ :: α) =+ let+ n' = abs n+ ls = convert n' (replicate limit (minBound @α))+ (_,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 :: Locator α => α -> Int -> Char -> Int+multiply (locator :: a) acc c =+ let+ base = fromEnum (maxBound @a) + 1+ in+ (acc * base) + (value locator c)++--+-- | Given a number encoded as a Locator, convert it back to an integer.+--+fromLocator :: Locator α => α -> String -> Int+fromLocator locator ss =+ foldl (multiply locator) 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+
+ lib/Data/Locator/English16.hs view
@@ -0,0 +1,263 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2018 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 #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeApplications #-}++module Data.Locator.English16+ ( Locator(..)+ , English16(..)+ , fromEnglish16+ , toEnglish16+ , toEnglish16a+ , hashStringToEnglish16a++ -- Deprecated+ , fromLocator16+ , toLocator16+ , toLocator16a+ , hashStringToLocator16a+ ) where++import Prelude hiding (toInteger)++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as S+import Data.List (mapAccumL)+import Data.Set (Set)+import qualified Data.Set as Set+import Numeric (showIntAtBase)++import Data.Locator.Common++--+-- | 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)++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"++instance Show English16 where+ show x = [c]+ where+ c = locatorToDigit x++--+-- | Given a number, convert it to a string in the English16 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.+--+toEnglish16 :: Int -> String+toEnglish16 x =+ showIntAtBase 16 (represent Yankee) x ""++--+-- | Represent a number in English16a 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.+--+-- >>> toEnglish16a 6 4369+-- 12C40F+--+toEnglish16a :: Int -> Int -> String+toEnglish16a limit n+ | limit > 16 = error "Can only request a maximum of 16 English16a characters, not " ++ (show limit)+ | otherwise =+ 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++--+-- | Given a number encoded in Locator16, convert it back to an integer.+--+fromEnglish16 :: [Char] -> Int+fromEnglish16 ss =+ foldl (multiply Yankee) 0 ss++--+-- | Take an arbitrary sequence of bytes, hash it with SHA1, then format as a+-- short @digits@-long Locator16 string.+--+-- >>> hashStringToLocator16a 6 "Hello World"+-- M48HR0+--+hashStringToEnglish16a :: Int -> ByteString -> ByteString+hashStringToEnglish16a 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+++toLocator16 :: Int -> String+toLocator16 = toEnglish16+{-# DEPRECATED toLocator16 "Use toEnglish16 instead" #-}++toLocator16a :: Int -> Int -> String+toLocator16a = toEnglish16a+{-# DEPRECATED toLocator16a "Use toEnglish16a instead" #-}++fromLocator16 :: [Char] -> Int+fromLocator16 = fromEnglish16+{-# DEPRECATED fromLocator16 "Use fromEnglish16 instead" #-}+++hashStringToLocator16a :: Int -> ByteString -> ByteString+hashStringToLocator16a = hashStringToEnglish16a+{-# DEPRECATED hashStringToLocator16a "Use hashStringToEnglish16a instead" #-}
+ lib/Data/Locator/Latin25.hs view
@@ -0,0 +1,186 @@+--+-- Human exchangable identifiers and locators+--+-- Copyright © 2011-2018 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 #-}+{-# LANGUAGE InstanceSigs #-}++module Data.Locator.Latin25+ ( Latin25(..)+ , toLatin25+ , fromLatin25+ , hashStringToLatin25+ ) where++import Prelude hiding (toInteger)++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as S+import Numeric (showIntAtBase)++import Data.Locator.Common+import Data.Locator.Hashes (padWithZeros)++--+-- | A symbol set with twenty-five visually distinct characters.+--+-- These are not protected against similar pronounciations; if you need to+-- read your identifiers /aloud/ use 'English16' instead.+--+{-++ -- | Two -- Obvious conflict with Z+ -- | Five -- Obvious conflict with S+ -- | Six -- Too close to G+ -- | Bravo -- Too close to 8+ -- | Delta -- Shape of D too close to O+ -- | Foxtrot -- A bit close to E, and since we've included S, skip+ -- | India -- Too close to 1 and J+ -- | Oscar -- Obvious conflict with 0+ -- | Quebec -- The tail on Q is too easy to miss, thereby colliding with O/0+ -- | Romeo -- Dropped in favour of P+ -- | Uniform -- Too close to V++-}+data Latin25+ = Zero' -- ^ @\'0\'@ /0th/+ | One' -- ^ @\'1\'@ /1st/+ | Three' -- ^ @\'3\'@ /2nd/+ | Four' -- ^ @\'4\'@ /3rd/+ | Seven' -- ^ @\'7\'@ /4th/+ | Eight' -- ^ @\'8\'@ /5th/+ | Nine' -- ^ @\'9\'@ /6th/+ | Alpha' -- ^ @\'A\'@ /7th/+ | Charlie' -- ^ @\'C\'@ /8th/+ | Echo' -- ^ @\'E\'@ /9th/+ | Golf' -- ^ @\'G\'@ /10th/+ | Hotel' -- ^ @\'H\'@ /11th/+ | Juliet' -- ^ @\'J\'@ /12th/+ | Kilo' -- ^ @\'K\'@ /13th/+ | Lima' -- ^ @\'L\'@ /14th/+ | Mike' -- ^ @\'M\'@ /15th/+ | November' -- ^ @\'N\'@ /16th/+ | Papa' -- ^ @\'P\'@ /17th/+ | Sierra' -- ^ @\'S\'@ /18th/+ | Tango' -- ^ @\'T\'@ /19th/+ | Victor' -- ^ @\'V\'@ /20th/+ | Whiskey' -- ^ @\'W\'@ /21st/+ | XRay' -- ^ @\'X\'@ /22nd/+ | Yankee' -- ^ @\'Y\'@ /23rd/+ | Zulu' -- ^ @\'Z\'@ /24th/+ deriving (Eq, Ord, Enum, Bounded)++instance Locator Latin25 where+ locatorToDigit x =+ case x of+ Zero' -> '0'+ One' -> '1'+ Three' -> '3'+ Four' -> '4'+ Seven' -> '7'+ Eight' -> '8'+ Nine' -> '9'+ Alpha' -> 'A'+ Charlie' -> 'C'+ Echo' -> 'E'+ Golf' -> 'G'+ Hotel' -> 'H'+ Juliet' -> 'J'+ Kilo' -> 'K'+ Lima' -> 'L'+ Mike' -> 'M'+ November' -> 'N'+ Papa' -> 'P'+ Sierra' -> 'S'+ Tango' -> 'T'+ Victor' -> 'V'+ Whiskey'-> 'W'+ XRay' -> 'X'+ Yankee' -> 'Y'+ Zulu' -> 'Z'++ digitToLocator :: Char -> Latin25+ digitToLocator c =+ case c of+ '0' -> Zero'+ '1' -> One'+ '3' -> Three'+ '4' -> Four'+ '7' -> Seven'+ '8' -> Eight'+ '9' -> Nine'+ 'A' -> Alpha'+ 'C' -> Charlie'+ 'E' -> Echo'+ 'G' -> Golf'+ 'H' -> Hotel'+ 'J' -> Juliet'+ 'K' -> Kilo'+ 'L' -> Lima'+ 'M' -> Mike'+ 'N' -> November'+ 'P' -> Papa'+ 'S' -> Sierra'+ 'T' -> Tango'+ 'W' -> Whiskey'+ 'V' -> Victor'+ 'X' -> XRay'+ 'Y' -> Yankee'+ 'Z' -> Zulu'+ _ -> error "Illegal digit"+++instance Show Latin25 where+ show x = [c]+ where+ c = locatorToDigit x++--+-- | Given a number, convert it to a string in the Latin25 base 25 symbol+-- alphabet. This is useful for primary keys and object identifiers that you+-- need to scan for in log output, for example.+--+toLatin25 :: Int -> String+toLatin25 x =+ showIntAtBase 25 (represent Zulu') x ""++--+-- | Given a number encoded in Locator16, convert it back to an integer.+--+fromLatin25 :: String -> Int+fromLatin25 ss =+ foldl (multiply Zulu') 0 ss++--+-- | Take an arbitrary sequence of bytes, hash it with SHA1, then format as a+-- short @limit@-long Latin25 string.+--+-- >>> hashStringToLatin25 5 "You'll get used to it. Or, you'll have a psychotic episode"+-- XSAV1+--+-- 17 characters is the widest hash you can request.+--+hashStringToLatin25 :: Int -> ByteString -> ByteString+hashStringToLatin25 limit s'+ | limit > 17 = error "Can only request a maximum width of 17, sorry"+ | otherwise =+ let+ s = S.unpack s'+ n = digest s -- SHA1 hash+ r = mod n upperBound -- trim to specified number of base 25 chars+ x = toLatin25 r -- express in Latin25+ b' = S.pack (padWithZeros limit x)+ in+ b'+ where+ upperBound = 25 ^ limit
− lib/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-
locators.cabal view
@@ -1,9 +1,9 @@ cabal-version: 1.24 name: locators-version: 0.2.4.4+version: 0.3.0.2 synopsis: Human exchangable identifiers and locators-license: BSD3-license-file: LICENCE+license: MIT+license-file: LICENSE description: /Overview/ .@@ -11,11 +11,11 @@ systems) using a subset of the Latin1 alphabet whose characters are unambigious when written or spoken. -author: Andrew Cowie <andrew@operationaldynamics.com>-maintainer: Andrew Cowie <andrew@operationaldynamics.com>-copyright: © 2013-2018 Operational Dynamics Consulting, Pty Ltd and Others+author: Andrew Cowie <istathar@gmail.com>+maintainer: Andrew Cowie <istathar@gmail.com>+copyright: © 2013-2020 Athae Eredh Siniath and Others category: Other-tested-with: GHC == 8.2.2, GHC == 8.4.2+tested-with: GHC == 8.8.3 stability: experimental build-type: Simple@@ -32,8 +32,10 @@ include-dirs: . exposed-modules: Data.Locator- other-modules: Data.Locator.Hashes,- Data.Locator.Locators+ other-modules: Data.Locator.Common,+ Data.Locator.Hashes,+ Data.Locator.English16+ Data.Locator.Latin25 ghc-options: -Wall@@ -77,7 +79,7 @@ source-repository head type: git- location: git@github.com:afcowie/locators.git+ location: git@github.com:aesiniath/locators.git -- vim: set tabstop=21 expandtab:
tests/TestSuite.hs view
@@ -1,7 +1,7 @@ -- -- Human exchangable identifiers and locators ----- Copyright © 2013-2017 Operational Dynamics Consulting, Pty Ltd+-- Copyright © 2013-2018 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:@@ -17,13 +17,13 @@ module TestSuite where +import Control.Exception (evaluate) import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit import Test.QuickCheck (elements, property) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) - -- -- Otherwise redundent imports, but useful for testing in GHCi. --@@ -42,24 +42,31 @@ suite :: Spec suite = do- describe "Locators" $ do- testRoundTripLocator16- testKnownLocator16a+ describe "Locators (English16)" $ do+ testRoundTripEnglish16+ testKnownEnglish16a testProblematicEdgeCases testNegativeNumbers+ testWidthGuardsEnglish16a + describe "Locators (Latin25)" $ do+ testKnownLatin25+ testRoundTripLatin25+ testHashLatin25+ testWidthGuardsHashing+ describe "Hashes" $ do testPaddingRefactored -testRoundTripLocator16 =- prop "safe conversion to/from Locator16" prop_Locator16+testRoundTripEnglish16 =+ prop "safe conversion to/from English16" prop_English16 -prop_Locator16 :: Int -> Bool-prop_Locator16 i =+prop_English16 :: Int -> Bool+prop_English16 i = let n = abs i- decoded = fromLocator16 (toLocator16 n)+ decoded = fromEnglish16 (toEnglish16 n) in n == decoded @@ -67,17 +74,17 @@ -- -- Have to do these manually, since Locator16a is not round-trip safe. ---testKnownLocator16a =- it "constrains Locator16a to unique digits" $ do- toLocator16a 6 0x111111 `shouldBe` "12C4FH"- toLocator16a 6 0x777777 `shouldBe` "789KLM"- toLocator16a 6 0xCCCCCC `shouldBe` "MRXY01"+testKnownEnglish16a =+ it "constrains English16a to unique digits" $ do+ toEnglish16a 6 0x111111 `shouldBe` "12C4FH"+ toEnglish16a 6 0x777777 `shouldBe` "789KLM"+ toEnglish16a 6 0xCCCCCC `shouldBe` "MRXY01" testProblematicEdgeCases = it "converstion to Locator16a correct on corner cases" $ do- toLocator16a 6 0x0 `shouldBe` "012C4F"- hashStringToLocator16a 6 "perf_data" `shouldBe` "FHL417"- hashStringToLocator16a 6 "perf_data/bletchley" `shouldBe` "K48F01"+ toEnglish16a 6 0x0 `shouldBe` "012C4F"+ hashStringToEnglish16a 6 "perf_data" `shouldBe` "FHL417"+ hashStringToEnglish16a 6 "perf_data/bletchley" `shouldBe` "K48F01" testPaddingRefactored = it "correctly pads strings" $ do@@ -88,4 +95,37 @@ testNegativeNumbers = it "doesn't explode if fed a negative number" $ do- toLocator16a 1 (-1) `shouldBe` "1"+ toEnglish16a 1 (-1) `shouldBe` "1"++testKnownLatin25 =+ it "base 25 is correct" $ do+ toLatin25 0 `shouldBe` "0"+ toLatin25 1 `shouldBe` "1"+ toLatin25 24 `shouldBe` "Z"+ toLatin25 25 `shouldBe` "10"++testRoundTripLatin25 =+ prop "safe conversion to/from Latin25" prop_English16++prop_Latin25 :: Int -> Bool+prop_Latin25 i =+ let+ n = abs i+ encoded = toLatin25 n+ decoded = fromLatin25 encoded+ in+ n == decoded++testHashLatin25 =+ it "hashToLatin25 generates an appropriate hash" $ do+ hashStringToLatin25 5 "You'll get used to it. Or, you'll have a psychotic episode"+ `shouldBe` "XSAV1"++testWidthGuardsEnglish16a =+ it "errors if asking for more than 16 English16a characters" $ do+ evaluate (toEnglish16a 17 1) `shouldThrow` anyErrorCall++testWidthGuardsHashing =+ it "errors if asking for more than 17 hash digits" $ do+ S.length (hashStringToLatin25 17 "a") `shouldBe` 17+ evaluate (hashStringToLatin25 18 "a") `shouldThrow` anyErrorCall
tests/check.hs view
@@ -1,7 +1,7 @@ -- -- Human exchangable identifiers and locators ----- Copyright © 2013-2017 Operational Dynamics Consulting, Pty Ltd+-- Copyright © 2013-2018 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:@@ -18,3 +18,4 @@ main :: IO () main = do hspec suite+ putStrLn "Ok"