{-# LANGUAGE OverloadedStrings #-} module Application where import Breve.Generator import Breve.UrlTable import Paths_breve (getDataFileName) import Views import Data.Monoid import Control.Monad.IO.Class (liftIO) import Data.Aeson hiding (json) import Data.Text (Text) import qualified Data.Text.Format as F import Web.Spock.Safe import Network.HTTP.Types.Status import Network.Wai (Middleware) import Network.Wai.Middleware.Static import Network.Wai.Middleware.RequestLogger serveStatic :: FilePath -> Middleware serveStatic = staticPolicy . addBase reply :: Status -> Text -> ActionT IO () reply code text = setStatus code >> render (message text) app :: Url -> UrlTable -> SpockT IO () app url' table = do static <- liftIO (getDataFileName "static/") middleware (serveStatic static) middleware logStdout get "/" $ render index get var $ \name -> do url <- liftIO (extract table name) case url of Nothing -> reply status404 "404: does not exist" Just url -> do F.print "Resolved {} -> {} " (name, url) redirect url post "/" $ do url <- param "url" case url of Nothing -> reply status400 "400: bad request" Just url -> do name <- liftIO (insert table url) F.print "Registered {} -> {} " (url, name) let link = url' <> name render (done link) post "api" $ do url <- param "url" case url of Nothing -> do setStatus status400 json $ object [ "error" .= ("bad request" :: Text ) , "msg" .= ("missing url field" :: Text ) ] Just url -> do name <- liftIO (insert table url) F.print "Registered {} -> {} " (url, name) json $ object [ "link" .= (url' <> name) , "name" .= name , "original" .= url ]