cookies (empty) → 0.1.0.0
raw patch · 5 files changed
+165/−0 lines, 5 filesdep +basedep +bytestringdep +chronossetup-changed
Dependencies added: base, bytestring, chronos, hashable, text, time
Files
- ChangeLog.md +5/−0
- Cookie.hs +103/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- cookies.cabal +25/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for cookies++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ Cookie.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Cookie+ ( Cookie(..)+ , CookieContent(..)+ , SameSite(..)+ , defaultCookie+ , encodeCookie+ , decodeCookie+ ) where++import Chronos.Types (Datetime, Timespan)+import Data.Bifunctor (second)+import Data.Bool (bool)+import Data.ByteString (ByteString)+import Data.Coerce (coerce)+import Data.Hashable (Hashable)+import Data.Monoid (Monoid)+import Data.Semigroup ((<>))+import Data.Text (Text)+import Data.Time (UTCTime(UTCTime), formatTime, defaultTimeLocale)+import qualified Chronos as C+import qualified Chronos.Types as C+import qualified Data.List as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy.Builder as TL+import qualified Data.Text.Lazy.Builder.Int as TL+import qualified Data.Time as UTC++data CookieContent a = CookieContent+ { cookieContentName :: !Text+ , cookieContentValue :: !a+ } deriving (Eq, Ord, Show, Functor, Foldable, Traversable)++data Cookie a = Cookie+ { cookieContent :: !(CookieContent a)+ , cookieExpires :: !(Maybe Datetime)+ , cookieMaxAge :: !(Maybe Timespan)+ , cookieDomain :: !(Maybe Text)+ , cookiePath :: !(Maybe [Text])+ , cookieSecure :: !Bool+ , cookieHttpOnly :: !Bool+ , cookieSameSite :: !(Maybe SameSite)+ } deriving (Eq, Ord, Show, Functor, Foldable, Traversable)++data SameSite+ = SameSiteLax+ | SameSiteStrict+ deriving (Eq, Ord, Show)++defaultCookie :: CookieContent a -> Cookie a+defaultCookie content = Cookie content Nothing Nothing Nothing Nothing False False Nothing++encodeCookie :: (a -> ByteString) -> Cookie a -> TL.Builder+encodeCookie encodeContent (Cookie (CookieContent name value) expires maxAge domain path secure httpOnly sameSite) =+ (mconcat . L.intersperse "; " . mconcat)+ [ [ TL.fromText name <> "=" <> (TL.fromText . TE.decodeUtf8 . encodeContent) value ]+ , maybeToList expires $ \ex -> "Expires=" <> TL.fromText (formatExpires $ datetimeToUTCTime ex)+ , maybeToList maxAge $ \ma -> "Max-Age=" <> TL.decimal (C.getTimespan ma `div` 1000000000)+ , maybeToList domain $ \d -> "Domain=" <> TL.fromText d+ , maybeToList path $ \p -> "Path=/" <> TL.fromText (T.intercalate "/" p)+ , bool [] ["Secure"] secure+ , bool [] ["HttpOnly"] httpOnly+ , maybeToList sameSite $ \case+ SameSiteLax -> "SameSite=Lax"+ SameSiteStrict -> "SameSite=Strict"+ ]+ where+ datetimeToUTCTime :: Datetime -> UTCTime+ datetimeToUTCTime dt@(C.Datetime _ (C.TimeOfDay h m n)) = UTCTime d undefined+ where+ dif = UTC.secondsToDiffTime $ fromIntegral (3600 * h + 60 * m + fromIntegral (n `div` 1000000000))+ d = UTC.ModifiedJulianDay $ fromIntegral $ C.getDay $ C.timeToDayTruncate $ C.datetimeToTime dt+ formatExpires :: UTCTime -> Text+ formatExpires = T.pack . formatTime defaultTimeLocale expiresFormat+ expiresFormat = "%a, %d-%b-%Y %X GMT"+ maybeToList m f = maybe [] ((:[]) . f) m++decodeCookie :: (Text -> Either Text a) -> Text -> Either Text (Cookie a)+decodeCookie decodeValue txt = case L.filter (\(x,_) -> x == "auth") (kvPairs txt) of+ ((name,value):_) ->+ flip fmap (decodeValue value) $ \v ->+ Cookie+ { cookieContent = CookieContent name v+ , cookieExpires = Nothing+ , cookieMaxAge = Nothing+ , cookieDomain = Nothing+ , cookiePath = Nothing+ , cookieSecure = False+ , cookieHttpOnly = False+ , cookieSameSite = Nothing+ }+ _ -> Left "Empty Cookie"+ where+ kvPairs = fmap (both (T.dropAround (==' ')) . breakOnDiscard "=") . L.filter (not . T.null) . T.splitOn ";"+ both f (x,y) = (f x, f y)+ breakOnDiscard b = second (T.drop 1) . T.breakOn b
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, chessai++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 chessai 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cookies.cabal view
@@ -0,0 +1,25 @@+name: cookies+version: 0.1.0.0+synopsis: web cookies+description: simple web cookies +homepage: https://github.com/chessai/cookies.git+license: BSD3+license-file: LICENSE+author: Kyle McKean, chessai+maintainer: chessai <chessai1996@gmail.com>+copyright: Copyright (c) Kyle McKean, chessai+category: Web+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++library+ exposed-modules: Cookie+ build-depends:+ base >=4.7 && < 5.0+ , bytestring >= 0.10+ , chronos+ , hashable+ , text+ , time+ default-language: Haskell2010