gonito/PersistSHA1.hs

67 lines
1.7 KiB
Haskell
Raw Normal View History

2015-08-29 13:13:16 +02:00
module PersistSHA1 where
import ClassyPrelude.Yesod
import Database.Persist.Sql
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
2015-09-04 10:02:33 +02:00
import qualified Data.Text as T
2015-08-29 13:13:16 +02:00
import Numeric (showHex)
data SHA1 = SHA1 ByteString
2018-11-16 12:43:44 +01:00
deriving (Eq, Show)
2015-08-29 13:13:16 +02:00
toHex :: ByteString -> ByteString
2015-09-04 06:47:49 +02:00
toHex = BC.pack . concat . (map ("\\x"++)) . (map (flip showHex "")) . B.unpack
toSHA1 :: ByteString -> SHA1
toSHA1 x = SHA1 $ B.concat ["E'\\\\x", x, "'"]
2015-08-29 13:13:16 +02:00
2015-09-04 10:02:33 +02:00
fromTextToSHA1 :: Text -> SHA1
fromTextToSHA1 = SHA1 . B.pack . (map hexByteToWord8) . (T.chunksOf 2)
2016-02-12 13:00:33 +01:00
fromSHA1ToText :: SHA1 -> Text
fromSHA1ToText (SHA1 bs) = T.pack $ concat $ map word8ToHex $ B.unpack bs
2015-09-04 10:02:33 +02:00
hexByteToWord8 :: Text -> Word8
hexByteToWord8 t = (hexNibbleToWord8 $ T.head t) * 16 + (hexNibbleToWord8 $ T.index t 1)
2016-02-12 13:00:33 +01:00
word8ToHex :: Word8 -> String
word8ToHex e = case h of
[c] -> ['0', c]
s -> s
where h = showHex e ""
2015-09-04 10:02:33 +02:00
hexNibbleToWord8 :: Char -> Word8
hexNibbleToWord8 '0' = 0
hexNibbleToWord8 '1' = 1
hexNibbleToWord8 '2' = 2
hexNibbleToWord8 '3' = 3
hexNibbleToWord8 '4' = 4
hexNibbleToWord8 '5' = 5
hexNibbleToWord8 '6' = 6
hexNibbleToWord8 '7' = 7
hexNibbleToWord8 '8' = 8
hexNibbleToWord8 '9' = 9
hexNibbleToWord8 'A' = 10
hexNibbleToWord8 'a' = 10
hexNibbleToWord8 'B' = 11
hexNibbleToWord8 'b' = 11
hexNibbleToWord8 'C' = 12
hexNibbleToWord8 'c' = 12
hexNibbleToWord8 'D' = 13
hexNibbleToWord8 'd' = 13
hexNibbleToWord8 'E' = 14
hexNibbleToWord8 'e' = 14
hexNibbleToWord8 'F' = 15
hexNibbleToWord8 'f' = 15
2015-08-29 13:13:16 +02:00
instance PersistField SHA1 where
2015-09-04 10:02:33 +02:00
toPersistValue (SHA1 t) = PersistByteString t
2015-08-29 13:13:16 +02:00
2015-09-04 10:02:33 +02:00
fromPersistValue (PersistByteString t) = Right $ SHA1 t
fromPersistValue _ = Left "Unexpected value"
2015-08-29 13:13:16 +02:00
instance PersistFieldSql SHA1 where
2015-09-04 10:02:33 +02:00
sqlType _ = SqlBlob