-- -- 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