1 {-# LANGUAGE DataKinds #-}
    2 {-# LANGUAGE FlexibleInstances #-}
    3 {-# LANGUAGE MultiParamTypeClasses #-}
    4 {-# LANGUAGE OverloadedStrings #-}
    5 {-# LANGUAGE RankNTypes #-}
    6 {-# LANGUAGE ScopedTypeVariables #-}
    7 {-# LANGUAGE TypeOperators #-}
    8 -- | This module describes the routes served by Databrary.
    9 --
   10 -- It is a tale of systems that evolve over time. Writing these words on
   11 -- 2018-05-23, I am beginning to serve routes with Servant. Meanwhile, ~90
   12 -- routes are still served by the original system, web-inv-routes; and ~30 are
   13 -- served by Wai.Route as a temporary stopgap.
   14 --
   15 -- This module glues the API description to a particular service implementation.
   16 -- See "Databrary.API" for a pure description of the Servant-described API.
   17 module Databrary.Routes
   18   (
   19   -- * Temporary measures: Wai.Route
   20     routeMapWai
   21   -- * OG route descriptions: web-inv-routes
   22   , routeMapInvertible
   23   ) where
   24 
   25 import Web.Route.Invertible (RouteMap, routes, routeCase)
   26 import qualified Data.ByteString as BS
   27 import qualified Network.HTTP.Types.Method as HTM
   28 import qualified Network.Wai as WAI
   29 import qualified Network.Wai.Route as WaiRoute
   30 
   31 import Databrary.Action
   32 import Databrary.Controller.Root
   33 import Databrary.Controller.Login
   34 import Databrary.Controller.Register
   35 import Databrary.Controller.Token
   36 import Databrary.Controller.Party
   37 import Databrary.Controller.Authorize
   38 import Databrary.Controller.Volume
   39 import Databrary.Controller.VolumeAccess
   40 import Databrary.Controller.Funding
   41 import Databrary.Controller.Container
   42 import Databrary.Controller.Slot
   43 import Databrary.Controller.Record
   44 import Databrary.Controller.Metric
   45 import Databrary.Controller.Citation
   46 import Databrary.Controller.Upload
   47 import Databrary.Controller.Format
   48 import Databrary.Controller.Asset
   49 import Databrary.Controller.AssetSegment
   50 import Databrary.Controller.Excerpt
   51 import Databrary.Controller.Zip
   52 import Databrary.Controller.Tag
   53 import Databrary.Controller.Comment
   54 import Databrary.Controller.CSV
   55 import Databrary.Controller.VolumeState
   56 import Databrary.Controller.Activity
   57 import Databrary.Controller.Transcode
   58 import Databrary.Controller.Ingest
   59 import Databrary.Controller.Web
   60 import Databrary.Controller.Search
   61 import Databrary.Controller.Periodic
   62 import Databrary.Controller.Notification
   63 import Databrary.Action.Run (actionApp)
   64 import Databrary.Service.Types (Service)
   65 
   66 -- | Map of route actions managed by Wai Routes.
   67 routeMapWai :: Service -> [(BS.ByteString, WaiRoute.Handler IO)]
   68 routeMapWai routeContext =
   69     [   ("", hn (viewRootHandler HTML)) -- no params/use hn0
   70       , ("/", hn (viewRootHandler HTML)) -- no params/use hn0
   71       , ("/api", hn (viewRootHandler JSON)) -- no params/use hn0
   72       , ("/robots.txt", hn viewRobotsTxtHandler) -- no params/use hn0
   73       , ("/api/user", hn (userHandler JSON)) -- no params/use hn0
   74       , ("/user", hn (userHandler HTML)) -- no params/use hn0
   75       , ("/api/user/login", hnm (loginHandler JSON)) -- no params/use hn0
   76       , ("/user/login", hnm (loginHandler HTML)) -- no params/use hn0
   77       , ("/user/logout", hn (postLogoutHandler HTML)) -- no params/use hn0
   78       , ("/api/user/logout", hn (postLogoutHandler JSON)) -- no params/use hn0
   79       , ("/user/register", hnm (registerHandler HTML)) -- no params/use hn0
   80       , ("/api/user/register", hnm (registerHandler JSON)) -- no params/use hn0
   81       , ("/user/password", hnm (passwordResetHandler HTML)) -- no params/use hn0
   82       , ("/api/user/password", hnm (passwordResetHandler JSON)) -- no params/use hn0
   83       , ("/party/:partyId/investigator", hn resendInvestigatorHandler)
   84       , ("/party/create", hn0 viewPartyCreateHandler)
   85       , ("/party/admin", hn0 adminPartiesHandler)
   86       , ("/party/csv", hn0 csvPartiesHandler)
   87       , ("/party/duplicate/csv", hn0 csvDuplicatePartiesHandler)
   88       , ("/volume/create", hn0 viewVolumeCreateHandler)
   89       , ("asset/formats", hn0 viewFormatsHandler)
   90       , ("/search", hn0 (postSearchHandler HTML))
   91       , ("/api/search", hn0 (postSearchHandler JSON))
   92       , ("/api/constants", hn viewConstantsHandler) -- no params/use hn0
   93       , ("/api/cite", hn0 getCitationHandler)
   94       , ("/api/funder", hn0 queryFunderHandler)
   95       , ("/api/activity", hn0 viewSiteActivityHandler)
   96       , ("/admin/transcode", hn0 viewTranscodesHandler)
   97       , ("/admin/periodic", hnm periodicHandler) -- no params/use hn0
   98     ]
   99   where
  100     hn0 :: Action -> WaiRoute.Handler IO  -- make handler
  101     hn0 act = \_ req responder -> actionApp routeContext act req responder
  102     hn :: ([(BS.ByteString, BS.ByteString)] -> Action) -> WaiRoute.Handler IO  -- make handler
  103     hn mkAction = \ps req responder -> actionApp routeContext (mkAction ps) req responder
  104     hnm :: (HTM.Method -> [(BS.ByteString, BS.ByteString)] -> Action) -> WaiRoute.Handler IO  -- make handler with method
  105     hnm mkAction = \ps req responder -> actionApp routeContext (mkAction (WAI.requestMethod req) ps) req responder
  106 
  107 -- | Map of route actions handled by web-inv-routes.
  108 routeMapInvertible :: RouteMap Action
  109 routeMapInvertible = routes
  110   [ route viewLoginToken
  111   , route postPasswordToken
  112   , route viewParty
  113   , route postParty
  114   , route viewPartyEdit
  115   , route viewPartyDelete
  116   , route viewAuthorize
  117   , route postAuthorize
  118   , route deleteAuthorize
  119   , route postAuthorizeNotFound
  120   , route viewAvatar
  121   , route viewPartyActivity
  122   , route createParty
  123   , route deleteParty
  124   , route queryParties
  125   , route viewVolume
  126   , route postVolume
  127   , route viewVolumeEdit
  128   , route postVolumeAccess
  129   , route postVolumeLinks
  130   , route postVolumeFunding
  131   , route deleteVolumeFunder
  132   , route postVolumeAssist
  133   , route createVolume
  134   , route queryVolumes
  135   , route (zipVolume False)
  136   , route (zipVolume True)
  137   , route viewVolumeDescription
  138   , route thumbVolume
  139   , route csvVolume
  140   , route viewVolumeActivity
  141   , route createContainer
  142   , route (viewSlot False)
  143   , route viewContainerEdit
  144   , route postContainer
  145   , route deleteContainer
  146   , route viewContainerActivity
  147   , route (zipContainer False)
  148   , route (zipContainer True)
  149   , route thumbSlot
  150   , route viewAsset
  151   , route postAsset
  152   , route deleteAsset
  153   , route downloadAsset
  154   , route downloadOrigAsset
  155   , route thumbAsset
  156   , route createAsset
  157   , route createSlotAsset
  158   , route (viewAssetSegment False)
  159   , route downloadAssetSegment
  160   , route downloadOrigAssetSegment
  161   , route (thumbAssetSegment False)
  162   , route postExcerpt
  163   , route deleteExcerpt
  164   , route createRecord
  165   , route viewRecord
  166   , route postRecordMeasure
  167   , route deleteRecord
  168   , route postRecordSlot
  169   , route deleteRecordSlot
  170   , route deleteRecordAllSlot
  171   , route postVolumeMetric
  172   , route deleteVolumeMetric
  173   , route postVolumeState
  174   , route deleteVolumeState
  175   , route queryTags
  176   , route postTag
  177   , route deleteTag
  178   , route postComment
  179   , route uploadStart
  180   , route uploadChunk
  181   , route testChunk
  182   , route remoteTranscode
  183   , route viewNotifications
  184   , route deleteNotification
  185   , route deleteNotifications
  186   , route viewNotify
  187   , route postNotify
  188   , route postTranscode
  189   , route viewIngest
  190   , route postIngest
  191   , route detectParticipantCSV
  192   , route runParticipantUpload
  193   , route webFile
  194   ] where
  195   route = routeCase