trasa-extra (empty) → 0.1.0.0

raw patch · 5 files changed

+199/−0 lines, 5 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, case-insensitive, containers, cookie, http-types, mtl, path-pieces, quantification, text, trasa, trasa-server

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• src/Trasa/Extra.hs +116/−0
• trasa-extra.cabal +46/−0

@@ -0,0 +1,5 @@+# Revision history for trasa-extra++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2019, goolord++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of goolord nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,116 @@+{-# language LambdaCase #-}+{-# language OverloadedStrings #-}+{-# language ScopedTypeVariables #-}+{-# language RankNTypes #-}+{-# language DataKinds #-}+{-# language KindSignatures #-}++{-# OPTIONS_GHC -Wall #-}++module Trasa.Extra +  ( -- * Route Functions+    IsRoute (..)+  , link+  , encodeRoute+  , decodeRoute+  , redirect+    -- * Header Functions+  , getHeader+  , currentHeader+  , setHeader+  , getCookies+  , lookupCookie+    -- * Codecs and Parsing+  , setCookie+  , pathPieceCodec+  , bodyAeson+  , aeson+  , decodeInt+  , err404+  ) where++import Control.Monad.Except (throwError)+import Control.Monad.Reader+import Control.Monad.State+import Data.Aeson (ToJSON(..), FromJSON(..), encode, eitherDecode', decode')+import Data.Bifunctor (first)+import Data.CaseInsensitive+import Data.Text (Text)+import Network.HTTP.Types as HTTP+import Trasa.Core hiding (optional)+import Trasa.Server+import Web.PathPieces+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Map.Strict as M+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Read as TR+import qualified Trasa.Method+import qualified Web.Cookie as Cookie++-- | Meta information about your route+class IsRoute route where+  metaF :: route caps qrys req resp -> MetaCodec caps qrys req resp++link :: IsRoute route => Concealed route -> Url+link c = concealedToPrepared c (linkWith (mapMeta captureEncoding captureEncoding id id . metaF))++encodeRoute :: IsRoute route => Concealed route -> Text +encodeRoute c = encodeUrl $ link c++decodeRoute :: IsRoute route => Router route -> Text -> Maybe (Concealed route)+decodeRoute router t = do+  let url = decodeUrl t+  either (const Nothing) Just (parseWith (mapMeta id captureDecoding (mapMany bodyDecoding) id . metaF) router Trasa.Method.get url Nothing)++redirect :: IsRoute route => Prepared route response -> LBS.ByteString -> TrasaT IO a+redirect route message = do+  setHeader "Location" (encodeRoute $ conceal route)+  throwError $ TrasaErr HTTP.status302 message++getHeader :: CI BS.ByteString -> TrasaT IO (Maybe T.Text)+getHeader idt = fmap (M.lookup idt . trasaHeaders) ask++currentHeader :: CI BS.ByteString -> TrasaT IO (Maybe T.Text)+currentHeader idt = fmap (M.lookup idt) get++setHeader :: CI BS.ByteString -> T.Text -> TrasaT IO ()+setHeader idt header = modify (M.insert idt header)++getCookies :: TrasaT IO (Maybe Cookie.Cookies)+getCookies = getHeader "Cookie" >>= \case+  Nothing -> pure Nothing+  Just rawCookie -> pure $ Just $ Cookie.parseCookies $ T.encodeUtf8 rawCookie++lookupCookie :: BS.ByteString -> TrasaT IO (Maybe BS.ByteString)+lookupCookie name = do+  getCookies >>= \case +    Nothing -> pure Nothing+    Just cookies -> pure $ lookup name cookies++setCookie :: Cookie.SetCookie -> TrasaT IO ()+setCookie cookie = do+  let cookie' :: Text+      cookie' = T.decodeUtf8 $ BL.toStrict $ BB.toLazyByteString $ Cookie.renderSetCookie cookie+  setHeader "Set-Cookie" cookie'++pathPieceCodec :: PathPiece piece => CaptureCodec piece+pathPieceCodec = CaptureCodec toPathPiece fromPathPiece++bodyAeson :: (ToJSON a, FromJSON a) => BodyCodec a+bodyAeson = BodyCodec (pure "application/json") encode (first T.pack . eitherDecode')++aeson :: (ToJSON a, FromJSON a) => CaptureCodec a+aeson = CaptureCodec (T.decodeUtf8 . LBS.toStrict . encode) (decode' . LBS.fromStrict .  T.encodeUtf8)++decodeInt :: Text -> Maybe Int+decodeInt x = case TR.decimal x of+  Left _ -> Nothing+  Right (i,leftover) -> if T.null leftover then Just i else Nothing++err404 :: Monad m => TrasaT m a+err404 = throwError (TrasaErr HTTP.status404 "Not found")+

@@ -0,0 +1,46 @@+cabal-version: 2.0+-- Initial package description 'trasa-extra.cabal' generated by 'cabal+-- init'. For further documentation, see+-- http://haskell.org/cabal/users-guide/++name: trasa-extra+version: 0.1.0.0+homepage: https://github.com/goolord/trasa-extra+synopsis: Extra functions for trasa+description: Boilerplate code for use with the trasa web framework+-- description:+-- bug-reports:+license: BSD3+license-file: LICENSE+author: goolord+maintainer: Zachary Churchill <zacharyachurchill@gmail.com>+-- copyright:+category: Web+build-type: Simple+extra-source-files: CHANGELOG.md++library+  exposed-modules: +    Trasa.Extra+  -- other-modules:+  -- other-extensions:+  build-depends: +      base >=4.10.0.0 && <5+    , aeson            >= 1.4.4 && < 1.6+    , bytestring       >= 0.10.8 && < 0.12+    , containers       >= 0.6.0 && < 0.8+    , text             >= 1.2.3 && < 1.5+    , case-insensitive >= 1.2.1 && < 1.5+    , cookie           >= 0.4.4 && < 0.6+    , http-types       >= 0.12.3 && < 0.15+    , mtl              >= 2.2.2 && < 2.4+    , path-pieces      >= 0.2.1 && < 0.4+    , quantification   >= 0.5.0 && < 0.7+    , trasa            >= 0.4 && < 0.8+    , trasa-server     >= 0.5 && < 0.8+  hs-source-dirs: src+  default-language: Haskell2010++source-repository head+  type:     git+  location: https://github.com/goolord/trasa-extra