servant-auth-streaming.hs

#!/usr/bin/env nix-shell
#!nix-shell -i runhaskell -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [servant-server servant-auth-server servant-streaming-server ])"
#!nix-shell -I https://github.com/NixOS/nixpkgs/archive/299814b385d2c1553f60ada8216d3b0af3d8d3c6.tar.gz 

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}


import Network.Wai
import           Network.Wai.Handler.Warp (defaultSettings, runSettings,
                                           setPort)
import Servant
import Servant.Server
import           Servant.Server.Generic
import Data.Text
import Data.Monoid
import Servant.API.Generic
import Network.Wai.Handler.Warp (Port)
import Servant.Streaming.Server
import Control.Monad.Reader
import Servant.Auth
import Servant.Auth.Server
import Servant.Auth.Server.Internal.AddSetCookie (AddSetCookieApi, AddSetCookieApiVerb)
import Data.ByteString as BS
import System.IO              (stdout)
import Data.Aeson


-- the gist 

import Servant.Streaming (StreamResponse)

type instance AddSetCookieApi (StreamResponse method stat ctyps) = AddSetCookieApiVerb (StreamResponse method stat ctyps)

--
data Env = Env
  { stuff :: String
  }

type AppM = ReaderT Env IO


newtype UserId  = UserId Int deriving (Eq, Show, Generic, ToJSON, FromJSON)
instance FromJWT UserId
instance ToJWT UserId

type MyAuth = Auth '[Cookie] UserId

data Routes route = Routes
  { rTest :: route :- MyAuth :> "test" :> StreamResponseGet '[JSON]
  } deriving (Generic)

server :: (CookieSettings, JWTSettings) -> Routes (AsServerT (AppM))
server cookieConfig = Routes
  { rTest = undefined
  }

type RoutesType = ToServantApi Routes

routesApi :: Proxy RoutesType
routesApi = Proxy

main :: IO ()
main  = do
  cookieKey <- generateKey
  let jwtCfg = defaultJWTSettings cookieKey
      cookieCfg = defaultCookieSettings 
      cfg =  cookieCfg :. jwtCfg :. EmptyContext

      appToHandler :: AppM a -> Handler a
      appToHandler action = liftIO $ runReaderT action Env { stuff = "" }

  print "serving"
  runSettings (setPort 8000 defaultSettings) $
    serveWithContext routesApi cfg $
    hoistServerWithContext routesApi (Proxy :: Proxy '[CookieSettings, JWTSettings]) appToHandler (toServant $ server (cookieCfg, jwtCfg))