module Snap.Snaplet.SqliteSimple.JwtAuth.Util where
import Data.Aeson
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS8
import Data.Int (Int64)
import Snap
import System.Directory (doesFileExist)
import Web.ClientSession (randomKey)
finishEarly :: MonadSnap m => Int -> B.ByteString -> m b
finishEarly code str = do
modifyResponse $ setResponseStatus code str
modifyResponse $ addHeader "Content-Type" "text/plain"
writeBS str
getResponse >>= finishWith
jsonResponse :: MonadSnap m => m ()
jsonResponse = modifyResponse $ setHeader "Content-Type" "application/json"
writeJSON :: (MonadSnap m, ToJSON a) => a -> m ()
writeJSON a = do
jsonResponse
writeLBS . encode $ a
reqJSON :: (MonadSnap m, FromJSON b) => m b
reqJSON = reqBoundedJSON 50000
reqBoundedJSON
:: (MonadSnap m, FromJSON a)
=> Int64
-> m a
reqBoundedJSON n = do
res <- getBoundedJSON n
case res of
Left e -> finishEarly 400 (BS8.pack e)
Right a -> return a
getBoundedJSON
:: (MonadSnap m, FromJSON a)
=> Int64
-> m (Either String a)
getBoundedJSON n = do
bodyVal <- decode `fmap` readRequestBody (fromIntegral n)
return $ case bodyVal of
Nothing -> Left "Can't find JSON data in POST body"
Just v -> case fromJSON v of
Error e -> Left e
Success a -> Right a
getKey :: FilePath
-> IO B.ByteString
getKey keyFile = do
exists <- doesFileExist keyFile
if exists
then B.readFile keyFile
else newKey
where
newKey = do
(bs, _) <- randomKey
B.writeFile keyFile bs
return bs