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 "API" for a pure description of the Servant-described API. 17 module 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 Action 32 import Controller.Root 33 import Controller.Login 34 import Controller.Register 35 import Controller.Token 36 import Controller.Party 37 import Controller.Authorize 38 import Controller.Volume 39 import Controller.VolumeAccess 40 import Controller.Funding 41 import Controller.Container 42 import Controller.Slot 43 import Controller.Record 44 import Controller.Metric 45 import Controller.Citation 46 import Controller.Upload 47 import Controller.Format 48 import Controller.Asset 49 import Controller.AssetSegment 50 import Controller.Excerpt 51 import Controller.Zip 52 import Controller.Tag 53 import Controller.Comment 54 import Controller.CSV 55 import Controller.VolumeState 56 import Controller.Activity 57 import Controller.Transcode 58 import Controller.Ingest 59 import Controller.Web 60 import Controller.Search 61 import Controller.Periodic 62 import Controller.Notification 63 import Action.Run (actionApp) 64 import 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