{-# LANGUAGE OverloadedStrings #-}
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)
-- | Discard anything after this and return given status code to HTTP
-- client immediately.
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
-------------------------------------------------------------------------------
-- | Demand the presence of JSON in the body assuming it is not larger
-- than 50000 bytes.
reqJSON :: (MonadSnap m, FromJSON b) => m b
reqJSON = reqBoundedJSON 50000
-------------------------------------------------------------------------------
-- | Demand the presence of JSON in the body with a size up to N
-- bytes. If parsing fails for any reson, request is terminated early
-- and a server error is returned.
reqBoundedJSON
:: (MonadSnap m, FromJSON a)
=> Int64
-- ^ Maximum size in bytes
-> m a
reqBoundedJSON n = do
res <- getBoundedJSON n
case res of
Left e -> finishEarly 400 (BS8.pack e)
Right a -> return a
-------------------------------------------------------------------------------
-- | Parse request body into JSON or return an error string.
getBoundedJSON
:: (MonadSnap m, FromJSON a)
=> Int64
-- ^ Maximum size in bytes
-> 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
-- | Get a key from the given text file.
--
-- If the file does not exist, a random key will be generated and stored in
-- that file.
--
-- This code is borrowed from the clientsession package but it uses a
-- different signature. We just need the raw ByteString.
getKey :: FilePath -- ^ File name where key is stored.
-> IO B.ByteString -- ^ The actual key.
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