88 lines
2.4 KiB
Haskell
88 lines
2.4 KiB
Haskell
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
---------------------------------------------------------
|
|
--
|
|
-- Module : Yesod.Definitions
|
|
-- Copyright : Michael Snoyman
|
|
-- License : BSD3
|
|
--
|
|
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
|
-- Stability : Stable
|
|
-- Portability : portable
|
|
--
|
|
-- Definitions throughout Restful.
|
|
--
|
|
---------------------------------------------------------
|
|
module Yesod.Definitions
|
|
( Verb (..)
|
|
, Resource
|
|
, Approot
|
|
, Language
|
|
, Location (..)
|
|
, showLocation
|
|
-- * Constant values
|
|
, authCookieName
|
|
, authDisplayName
|
|
, encryptedCookies
|
|
, langKey
|
|
) where
|
|
|
|
import qualified Network.Wai as W
|
|
import Data.Convertible.Text
|
|
import Control.Exception (Exception)
|
|
import Data.Typeable (Typeable)
|
|
import Language.Haskell.TH.Syntax
|
|
import Data.ByteString.Char8 (pack, ByteString)
|
|
|
|
-- FIXME replace with Method?
|
|
data Verb = Get | Put | Delete | Post
|
|
deriving (Eq, Show, Enum, Bounded)
|
|
instance Lift Verb where
|
|
lift = return . ConE . mkName . show
|
|
instance ConvertAttempt String Verb where
|
|
convertAttempt "Get" = return Get
|
|
convertAttempt "Put" = return Put
|
|
convertAttempt "Delete" = return Delete
|
|
convertAttempt "Post" = return Post
|
|
convertAttempt s = failure $ InvalidVerb s
|
|
newtype InvalidVerb = InvalidVerb String
|
|
deriving (Show, Typeable)
|
|
instance Exception InvalidVerb
|
|
|
|
instance ConvertSuccess W.Method Verb where
|
|
convertSuccess W.PUT = Put
|
|
convertSuccess W.DELETE = Delete
|
|
convertSuccess W.POST = Post
|
|
convertSuccess _ = Get
|
|
|
|
type Resource = [String]
|
|
|
|
-- | An absolute URL to the base of this application. This can almost be done
|
|
-- programatically, but due to ambiguities in different ways of doing URL
|
|
-- rewriting for (fast)cgi applications, it should be supplied by the user.
|
|
type Approot = String
|
|
|
|
type Language = String
|
|
|
|
-- | A location string. Can either be given absolutely or as a suffix for the
|
|
-- 'Approot'.
|
|
data Location = AbsLoc String | RelLoc String
|
|
|
|
-- | Display a 'Location' in absolute form.
|
|
showLocation :: Approot -> Location -> String
|
|
showLocation _ (AbsLoc s) = s
|
|
showLocation ar (RelLoc s) = ar ++ s
|
|
|
|
authCookieName :: String
|
|
authCookieName = "IDENTIFIER"
|
|
|
|
authDisplayName :: String
|
|
authDisplayName = "DISPLAY_NAME"
|
|
|
|
encryptedCookies :: [ByteString]
|
|
encryptedCookies = [pack authDisplayName, pack authCookieName]
|
|
|
|
langKey :: String
|
|
langKey = "_LANG"
|