{-# LANGUAGE OverloadedStrings, CPP #-}
module Yesod.Core.Internal.Request
    ( parseWaiRequest
    , RequestBodyContents
    , FileInfo
    , fileName
    , fileContentType
    , fileMove
    , mkFileInfoLBS
    , mkFileInfoFile
    , mkFileInfoSource
    , FileUpload (..)
    , tooLargeResponse
    , tokenKey
    , langKey
    , textQueryString
    -- The below are exported for testing.
    , randomString
    ) where

import Data.String (IsString)
import Control.Arrow (second)
import qualified Network.Wai.Parse as NWP
import qualified Network.Wai as W
import Web.Cookie (parseCookiesText)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy.Char8 as LS8
import Data.Text (Text, pack)
import Network.HTTP.Types (queryToQueryText, Status (Status))
import Data.Maybe (fromMaybe, catMaybes)
import qualified Data.ByteString.Lazy as L
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With, decodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Conduit
import Data.Word (Word8, Word64)
import Control.Exception (throwIO)
import Control.Monad ((<=<), liftM)
import Yesod.Core.Types
import qualified Data.Map as Map
import Data.IORef
import qualified Data.Vector.Storable as V
import Data.ByteString.Internal (ByteString (PS))
import qualified Data.Word8 as Word8

-- | Impose a limit on the size of the request body.
limitRequestBody :: Word64 -> W.Request -> IO W.Request
limitRequestBody :: Word64 -> Request -> IO Request
limitRequestBody Word64
maxLen Request
req = do
    IORef Word64
ref <- Word64 -> IO (IORef Word64)
forall a. a -> IO (IORef a)
newIORef Word64
maxLen
    Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
req
        { requestBody :: IO ByteString
W.requestBody = do
            ByteString
bs <- Request -> IO ByteString
W.requestBody Request
req
            Word64
remaining <- IORef Word64 -> IO Word64
forall a. IORef a -> IO a
readIORef IORef Word64
ref
            let len :: Word64
len = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S8.length ByteString
bs
                remaining' :: Word64
remaining' = Word64
remaining Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
len
            if Word64
remaining Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
len
                then HandlerContents -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (HandlerContents -> IO ByteString)
-> HandlerContents -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Response -> HandlerContents
HCWai (Response -> HandlerContents) -> Response -> HandlerContents
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Response
tooLargeResponse Word64
maxLen Word64
len
                else do
                    IORef Word64 -> Word64 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word64
ref Word64
remaining'
                    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
        }

tooLargeResponse :: Word64 -> Word64 -> W.Response
tooLargeResponse :: Word64 -> Word64 -> Response
tooLargeResponse Word64
maxLen Word64
bodyLen = Status -> ResponseHeaders -> ByteString -> Response
W.responseLBS
    (Int -> ByteString -> Status
Status Int
413 ByteString
"Too Large")
    [(HeaderName
"Content-Type", ByteString
"text/plain")]
    ([ByteString] -> ByteString
L.concat 
        [ ByteString
"Request body too large to be processed. The maximum size is "
        , ([Char] -> ByteString
LS8.pack (Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
maxLen))
        , ByteString
" bytes; your request body was "
        , ([Char] -> ByteString
LS8.pack (Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
bodyLen))
        , ByteString
" bytes. If you're the developer of this site, you can configure the maximum length with the `maximumContentLength` or `maximumContentLengthIO` function on the Yesod typeclass."
        ])

parseWaiRequest :: W.Request
                -> SessionMap
                -> Bool
                -> Maybe Word64 -- ^ max body size
                -> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
parseWaiRequest :: Request
-> SessionMap
-> Bool
-> Maybe Word64
-> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
parseWaiRequest Request
env SessionMap
session Bool
useToken Maybe Word64
mmaxBodySize =
    -- In most cases, we won't need to generate any random values. Therefore,
    -- we split our results: if we need a random generator, return a Right
    -- value, otherwise return a Left and avoid the relatively costly generator
    -- acquisition.
    case Either (Maybe Text) (IO Int -> IO (Maybe Text))
etoken of
        Left Maybe Text
token -> IO YesodRequest
-> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
forall a b. a -> Either a b
Left (IO YesodRequest
 -> Either (IO YesodRequest) (IO Int -> IO YesodRequest))
-> IO YesodRequest
-> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO YesodRequest
mkRequest Maybe Text
token
        Right IO Int -> IO (Maybe Text)
mkToken -> (IO Int -> IO YesodRequest)
-> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
forall a b. b -> Either a b
Right ((IO Int -> IO YesodRequest)
 -> Either (IO YesodRequest) (IO Int -> IO YesodRequest))
-> (IO Int -> IO YesodRequest)
-> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO YesodRequest
mkRequest (Maybe Text -> IO YesodRequest)
-> (IO Int -> IO (Maybe Text)) -> IO Int -> IO YesodRequest
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO Int -> IO (Maybe Text)
mkToken
  where
    mkRequest :: Maybe Text -> IO YesodRequest
mkRequest Maybe Text
token' = do
        Request
envLimited <- (Request -> IO Request)
-> (Word64 -> Request -> IO Request)
-> Maybe Word64
-> Request
-> IO Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Word64 -> Request -> IO Request
limitRequestBody Maybe Word64
mmaxBodySize Request
env
        YesodRequest -> IO YesodRequest
forall (m :: * -> *) a. Monad m => a -> m a
return YesodRequest :: [(Text, Text)]
-> [(Text, Text)]
-> Request
-> [Text]
-> Maybe Text
-> SessionMap
-> [ByteString]
-> YesodRequest
YesodRequest
            { reqGetParams :: [(Text, Text)]
reqGetParams  = [(Text, Text)]
gets
            , reqCookies :: [(Text, Text)]
reqCookies    = [(Text, Text)]
cookies
            , reqWaiRequest :: Request
reqWaiRequest = Request
envLimited
            , reqLangs :: [Text]
reqLangs      = [Text]
langs''
            , reqToken :: Maybe Text
reqToken      = Maybe Text
token'
            , reqSession :: SessionMap
reqSession    = if Bool
useToken
                                then Text -> SessionMap -> SessionMap
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
forall a. IsString a => a
tokenKey SessionMap
session
                                else SessionMap
session
            , reqAccept :: [ByteString]
reqAccept     = Request -> [ByteString]
httpAccept Request
env
            }
    gets :: [(Text, Text)]
gets = Request -> [(Text, Text)]
textQueryString Request
env
    reqCookie :: Maybe ByteString
reqCookie = HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Cookie" (ResponseHeaders -> Maybe ByteString)
-> ResponseHeaders -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> ResponseHeaders
W.requestHeaders Request
env
    cookies :: [(Text, Text)]
cookies = [(Text, Text)]
-> (ByteString -> [(Text, Text)])
-> Maybe ByteString
-> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ByteString -> [(Text, Text)]
parseCookiesText Maybe ByteString
reqCookie
    acceptLang :: Maybe ByteString
acceptLang = HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Accept-Language" (ResponseHeaders -> Maybe ByteString)
-> ResponseHeaders -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> ResponseHeaders
W.requestHeaders Request
env
    langs :: [Text]
langs = (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
pack ([Char] -> Text) -> (ByteString -> [Char]) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
S8.unpack) ([ByteString] -> [Text]) -> [ByteString] -> [Text]
forall a b. (a -> b) -> a -> b
$ [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ByteString -> [ByteString]
NWP.parseHttpAccept Maybe ByteString
acceptLang

    lookupText :: k -> Map k ByteString -> Maybe Text
lookupText k
k = (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode) (Maybe ByteString -> Maybe Text)
-> (Map k ByteString -> Maybe ByteString)
-> Map k ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Map k ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k

    -- The language preferences are prioritized as follows:
    langs' :: [Text]
langs' = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
forall a. IsString a => a
langKey [(Text, Text)]
gets -- Query _LANG
                       , Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
forall a. IsString a => a
langKey [(Text, Text)]
cookies     -- Cookie _LANG
                       , Text -> SessionMap -> Maybe Text
forall k. Ord k => k -> Map k ByteString -> Maybe Text
lookupText Text
forall a. IsString a => a
langKey SessionMap
session -- Session _LANG
                       ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
langs                    -- Accept-Language(s)

    -- Github issue #195. We want to add an extra two-letter version of any
    -- language in the list.
    langs'' :: [Text]
langs'' = ([Text] -> [Text], Set Text) -> [Text] -> [Text]
addTwoLetters ([Text] -> [Text]
forall a. a -> a
id, Set Text
forall a. Set a
Set.empty) [Text]
langs'

    -- If sessions are disabled tokens should not be used (any
    -- tokenKey present in the session is ignored). If sessions
    -- are enabled and a session has no tokenKey a new one is
    -- generated.
    etoken :: Either (Maybe Text) (IO Int -> IO (Maybe Text))
etoken
        | Bool
useToken =
            case Text -> SessionMap -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
forall a. IsString a => a
tokenKey SessionMap
session of
                -- Already have a token, use it.
                Just ByteString
bs -> Maybe Text -> Either (Maybe Text) (IO Int -> IO (Maybe Text))
forall a b. a -> Either a b
Left (Maybe Text -> Either (Maybe Text) (IO Int -> IO (Maybe Text)))
-> Maybe Text -> Either (Maybe Text) (IO Int -> IO (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
bs
                -- Don't have a token, get a random generator and make a new one.
                Maybe ByteString
Nothing -> (IO Int -> IO (Maybe Text))
-> Either (Maybe Text) (IO Int -> IO (Maybe Text))
forall a b. b -> Either a b
Right ((IO Int -> IO (Maybe Text))
 -> Either (Maybe Text) (IO Int -> IO (Maybe Text)))
-> (IO Int -> IO (Maybe Text))
-> Either (Maybe Text) (IO Int -> IO (Maybe Text))
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (IO Text -> IO (Maybe Text))
-> (IO Int -> IO Text) -> IO Int -> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO Int -> IO Text
forall (m :: * -> *). Monad m => Int -> m Int -> m Text
randomString Int
40
        | Bool
otherwise = Maybe Text -> Either (Maybe Text) (IO Int -> IO (Maybe Text))
forall a b. a -> Either a b
Left Maybe Text
forall a. Maybe a
Nothing

textQueryString :: W.Request -> [(Text, Text)]
textQueryString :: Request -> [(Text, Text)]
textQueryString = ((Text, Maybe Text) -> (Text, Text))
-> [(Text, Maybe Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Text -> Text) -> (Text, Maybe Text) -> (Text, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Maybe Text -> Text) -> (Text, Maybe Text) -> (Text, Text))
-> (Maybe Text -> Text) -> (Text, Maybe Text) -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"") ([(Text, Maybe Text)] -> [(Text, Text)])
-> (Request -> [(Text, Maybe Text)]) -> Request -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> [(Text, Maybe Text)]
queryToQueryText (Query -> [(Text, Maybe Text)])
-> (Request -> Query) -> Request -> [(Text, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Query
W.queryString

-- | Get the list of accepted content types from the WAI Request\'s Accept
-- header.
--
-- Since 1.2.0
httpAccept :: W.Request -> [ContentType]
httpAccept :: Request -> [ByteString]
httpAccept = ByteString -> [ByteString]
NWP.parseHttpAccept
           (ByteString -> [ByteString])
-> (Request -> ByteString) -> Request -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
S8.empty
           (Maybe ByteString -> ByteString)
-> (Request -> Maybe ByteString) -> Request -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Accept"
           (ResponseHeaders -> Maybe ByteString)
-> (Request -> ResponseHeaders) -> Request -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ResponseHeaders
W.requestHeaders

addTwoLetters :: ([Text] -> [Text], Set.Set Text) -> [Text] -> [Text]
addTwoLetters :: ([Text] -> [Text], Set Text) -> [Text] -> [Text]
addTwoLetters ([Text] -> [Text]
toAdd, Set Text
exist) [] =
    (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
exist) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
toAdd []
addTwoLetters ([Text] -> [Text]
toAdd, Set Text
exist) (Text
l:[Text]
ls) =
    Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text] -> [Text], Set Text) -> [Text] -> [Text]
addTwoLetters ([Text] -> [Text]
toAdd', Set Text
exist') [Text]
ls
  where
    ([Text] -> [Text]
toAdd', Set Text
exist')
        | Text -> Int
T.length Text
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 = ([Text] -> [Text]
toAdd ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> Text
T.take Int
2 Text
lText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:), Set Text
exist)
        | Bool
otherwise = ([Text] -> [Text]
toAdd, Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
l Set Text
exist)

-- | Generate a random String of alphanumerical characters
-- (a-z, A-Z, and 0-9) of the given length using the given
-- random number generator.
randomString :: Monad m => Int -> m Int -> m Text
randomString :: Int -> m Int -> m Text
randomString Int
len m Int
gen =
    (Vector Word8 -> Text) -> m (Vector Word8) -> m Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (Vector Word8 -> ByteString) -> Vector Word8 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> ByteString
fromByteVector) (m (Vector Word8) -> m Text) -> m (Vector Word8) -> m Text
forall a b. (a -> b) -> a -> b
$ Int -> m Word8 -> m (Vector Word8)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
V.replicateM Int
len m Word8
asciiChar
  where
    asciiChar :: m Word8
asciiChar =
      let loop :: m Word8
loop = do
            Int
x <- m Int
gen
            let y :: Word8
y = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
64
            case () of
              ()
                | Word8
y Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
26 -> Word8 -> m Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> m Word8) -> Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Word8
y Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
Word8._A
                | Word8
y Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
52 -> Word8 -> m Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> m Word8) -> Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Word8
y Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
Word8._a Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
26
                | Word8
y Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
62 -> Word8 -> m Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> m Word8) -> Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Word8
y Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
Word8._0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
52
                | Bool
otherwise -> m Word8
loop
       in m Word8
loop

fromByteVector :: V.Vector Word8 -> ByteString
fromByteVector :: Vector Word8 -> ByteString
fromByteVector Vector Word8
v =
    ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fptr Int
offset Int
idx
  where
    (ForeignPtr Word8
fptr, Int
offset, Int
idx) = Vector Word8 -> (ForeignPtr Word8, Int, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Int, Int)
V.unsafeToForeignPtr Vector Word8
v
{-# INLINE fromByteVector #-}

mkFileInfoLBS :: Text -> Text -> L.ByteString -> FileInfo
mkFileInfoLBS :: Text -> Text -> ByteString -> FileInfo
mkFileInfoLBS Text
name Text
ct ByteString
lbs =
    Text
-> Text
-> ConduitT () ByteString (ResourceT IO) ()
-> ([Char] -> IO ())
-> FileInfo
FileInfo Text
name Text
ct (ByteString -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) lazy strict i.
(Monad m, LazySequence lazy strict) =>
lazy -> ConduitT i strict m ()
sourceLazy ByteString
lbs) ([Char] -> ByteString -> IO ()
`L.writeFile` ByteString
lbs)

mkFileInfoFile :: Text -> Text -> FilePath -> FileInfo
mkFileInfoFile :: Text -> Text -> [Char] -> FileInfo
mkFileInfoFile Text
name Text
ct [Char]
fp = Text
-> Text
-> ConduitT () ByteString (ResourceT IO) ()
-> ([Char] -> IO ())
-> FileInfo
FileInfo Text
name Text
ct ([Char] -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
[Char] -> ConduitT i ByteString m ()
sourceFile [Char]
fp) (\[Char]
dst -> ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
[Char] -> ConduitT i ByteString m ()
sourceFile [Char]
fp ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| [Char] -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
[Char] -> ConduitT ByteString o m ()
sinkFile [Char]
dst)

mkFileInfoSource :: Text -> Text -> ConduitT () ByteString (ResourceT IO) () -> FileInfo
mkFileInfoSource :: Text
-> Text -> ConduitT () ByteString (ResourceT IO) () -> FileInfo
mkFileInfoSource Text
name Text
ct ConduitT () ByteString (ResourceT IO) ()
src = Text
-> Text
-> ConduitT () ByteString (ResourceT IO) ()
-> ([Char] -> IO ())
-> FileInfo
FileInfo Text
name Text
ct ConduitT () ByteString (ResourceT IO) ()
src (\[Char]
dst -> ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString (ResourceT IO) ()
src ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| [Char] -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
[Char] -> ConduitT ByteString o m ()
sinkFile [Char]
dst)

tokenKey :: IsString a => a
tokenKey :: a
tokenKey = a
"_TOKEN"

langKey :: IsString a => a
langKey :: a
langKey = a
"_LANG"