eidolon/Helper.hs
2014-08-24 21:42:42 +02:00

76 lines
1.9 KiB
Haskell

module Helper
( getUserIdFromText
, extractKey
-- , getUserNameById
, fromHex
, fromHex'
, toHex
, makeRandomToken
, generateSalt
)
where
import Prelude
import Model
import Control.Applicative
import Control.Monad.Trans.Class
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BC
import qualified Data.Text as T
import Database.Persist
import Database.Persist.Types
import System.FilePath
import System.Random
import Yesod.Persist.Core
import Yesod.Core.Types
import Numeric (readHex, showHex)
getUserIdFromText :: T.Text -> UserId
getUserIdFromText tempUserId =
Key $ PersistInt64 $ fromIntegral $ read $ T.unpack tempUserId
extractKey :: KeyBackend backend entity -> T.Text
extractKey = extractKey' . unKey
where
extractKey' (PersistInt64 k) = T.pack $ show k
extractKey' _ = ""
--getUserNameById :: UserId -> Text
--getUserNameById userId =
-- let
-- user = runDB $ getJust $ userId
-- in
-- userName user
fromHex :: String -> BL.ByteString
fromHex = BL.pack . hexToWords
where hexToWords (c:c':text) =
let hex = [c, c']
word = case readHex hex of
(d,_):_ -> d
[] -> error "empty list"
_ -> error "fuckup"
-- (word, _):_ = readHex hex
in word : hexToWords text
hexToWords _ = []
-- strict variant
fromHex' :: String -> B.ByteString
fromHex' = B.concat . BL.toChunks . fromHex
toHex :: B.ByteString -> T.Text
toHex = T.pack . concatMap mapByte . B.unpack
where mapByte = pad 2 '0' . flip showHex ""
pad len padding s
| length s < len = pad len padding $ padding:s
| otherwise = s
makeRandomToken :: IO T.Text
makeRandomToken = (T.pack . take 16 . randoms) `fmap` newStdGen
generateSalt :: IO B.ByteString
generateSalt = (B.pack . take 8 . randoms) <$> getStdGen