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)) -- (\ps req resp -> runAction routeContext (viewRootHandler HTML ps) req resp)) 70 , ("/", hn (viewRootHandler HTML)) 71 , ("/api", hn (viewRootHandler JSON)) 72 , ("/robots.txt", hn viewRobotsTxtHandler) 73 74 , ("/api/user", hn (userHandler JSON)) 75 , ("/user", hn (userHandler HTML)) 76 , ("/api/user/login", hnm (loginHandler JSON)) 77 , ("/user/login", hnm (loginHandler HTML)) 78 , ("/user/logout", hn (postLogoutHandler HTML)) 79 , ("/api/user/logout", hn (postLogoutHandler JSON)) 80 , ("/user/register", hnm (registerHandler HTML)) 81 , ("/api/user/register", hnm (registerHandler JSON)) 82 , ("/user/password", hnm (passwordResetHandler HTML)) 83 , ("/api/user/password", hnm (passwordResetHandler JSON)) 84 -- login token x 2 85 , ("/party/:partyId/investigator", hn resendInvestigatorHandler) 86 87 -- , ("/party/:partyId", hnm (partyHandler HTML)) -- get, post 88 -- , ("/profile", hnm (partyHandler JSON)) -- get, post 89 -- , ("/api/party/:partyId", hnm (partyHandler JSON)) -- get, post 90 -- , ("/api/profile", hnm (partyHandler JSON)) -- get, post 91 -- , ("/party/party/:partyId/edit", hn viewPartyEditHandler) -- get 92 -- , ("/party/profile/edit", hn viewPartyEditHandler) -- get 93 , ("/party/create", hn0 viewPartyCreateHandler) 94 -- , route viewAuthorize 95 -- , route postAuthorize 96 -- , route deleteAuthorize 97 -- , route postAuthorizeNotFound 98 -- , ("/party/:partyId/avatar", hn avatarHandler) -- get 99 -- , route viewPartyActivity -- 2nd pass 100 --, ("/party", hnm (createPartyHandler HTML)) -- post, get <<<<<<<<< 101 --, ("/api/party", hnm (createPartyHandler JSON)) -- post, get <<<<<<<< 102 --, ("/party/:partyId/delete", hnm (deletePartyHandler HTML)) -- post, get 103 , ("/party/admin", hn0 adminPartiesHandler) 104 , ("/party/csv", hn0 csvPartiesHandler) 105 , ("/party/duplicate/csv", hn0 csvDuplicatePartiesHandler) 106 107 -- , route viewVolume 108 -- , route postVolume 109 -- , route viewVolumeEdit 110 -- , route postVolumeAccess 111 -- , route postVolumeLinks 112 -- , route postVolumeFunding -- 2nd pass 113 -- , route deleteVolumeFunder -- 2nd pass 114 -- , route postVolumeAssist 115 , ("/volume/create", hn0 viewVolumeCreateHandler) 116 -- , route createVolume <<<<<< 117 -- , route queryVolumes <<<<< 118 -- , route $ zipVolume False 119 -- , route $ zipVolume True 120 -- , route viewVolumeDescription 121 -- , route thumbVolume 122 -- , route csvVolume 123 -- , route viewVolumeActivity -- 2nd pass 124 125 -- , route createContainer -- all 2nd pass 126 -- , route $ viewSlot False 127 -- , route viewContainerEdit 128 -- , route postContainer 129 -- , route deleteContainer 130 -- , route viewContainerActivity -- 2nd pass 131 -- , route $ zipContainer False 132 -- , route $ zipContainer True 133 -- , route thumbSlot 134 135 , ("asset/formats", hn0 viewFormatsHandler) 136 137 -- , route viewAsset -- all 2nd pass 138 -- , route postAsset 139 -- , route deleteAsset 140 -- , route downloadAsset 141 -- , route downloadOrigAsset 142 -- , route thumbAsset 143 -- , route createAsset 144 -- , route createSlotAsset 145 146 -- , route (viewAssetSegment False) -- all 2nd pass 147 -- , route downloadAssetSegment 148 -- , route downloadOrigAssetSegment 149 -- , route (thumbAssetSegment False) 150 -- , route postExcerpt 151 -- , route deleteExcerpt 152 153 -- , route createRecord -- all 2nd pass 154 -- , route viewRecord 155 -- , route postRecordMeasure 156 -- , route deleteRecord 157 -- , route postRecordSlot 158 -- , route deleteRecordSlot 159 -- , route deleteRecordAllSlot 160 161 -- , route postVolumeMetric -- all 2nd pass 162 -- , route deleteVolumeMetric 163 -- , route postVolumeState 164 -- , route deleteVolumeState 165 166 -- , route queryTags -- 2nd pass 167 -- , route postTag -- 2nd pass 168 -- , route deleteTag -- 2nd pass 169 -- , route postComment -- 2nd pass 170 171 , ("/search", hn0 (postSearchHandler HTML)) 172 , ("/api/search", hn0 (postSearchHandler JSON)) 173 174 -- , route uploadStart -- 2nd pass 175 -- , route uploadChunk <<<<<<<<<<< 176 -- , route testChunk <<<<<<<<< 177 178 179 , ("/api/constants", hn viewConstantsHandler) 180 , ("/api/cite", hn0 getCitationHandler) 181 , ("/api/funder", hn0 queryFunderHandler) 182 -- , route remoteTranscode -- second pass 183 , ("/api/activity", hn0 viewSiteActivityHandler) 184 -- , ("/activity", hn0 (viewSiteActivityHandler HTML)) 185 186 -- , route viewNotifications <<<<<<<< 187 -- , route deleteNotification -- second pass 188 -- , route deleteNotifications -- second pass 189 -- , route viewNotify <<<<<<<<<< 190 -- , route postNotify <<<<<<<<< 191 192 , ("/admin/transcode", hn0 viewTranscodesHandler) 193 -- , route postTranscode -- second pass 194 -- , route viewIngest -- second pass 195 -- , route postIngest -- second pass 196 -- , route detectParticipantCSV -- second pass 197 -- , route runParticipantUpload -- second pass 198 , ("/admin/periodic", hnm periodicHandler) 199 200 -- , route webFile -- hard? 201 202 -- hack to override not found 203 -- TODO: add below back? can clash with above 204 {- 205 , ("/:a", (\ps req respond -> runAction routeContext (notFoundResponseHandler ps) req respond)) 206 -} 207 ] 208 where 209 hn0 :: Action -> WaiRoute.Handler IO -- make handler 210 hn0 act = \_ req responder -> actionApp routeContext act req responder 211 hn :: ([(BS.ByteString, BS.ByteString)] -> Action) -> WaiRoute.Handler IO -- make handler 212 hn mkAction = \ps req responder -> actionApp routeContext (mkAction ps) req responder 213 hnm :: (HTM.Method -> [(BS.ByteString, BS.ByteString)] -> Action) -> WaiRoute.Handler IO -- make handler with method 214 hnm mkAction = \ps req responder -> actionApp routeContext (mkAction (WAI.requestMethod req) ps) req responder 215 216 -- | Map of route actions handled by web-inv-routes. 217 routeMapInvertible :: RouteMap Action 218 routeMapInvertible = routes 219 [ 220 -- route viewRoot 221 -- , route viewRobotsTxt 222 223 -- route viewUser 224 --, route postUser 225 -- route viewLogin 226 -- , route postLogin 227 -- route postLogout 228 -- route viewRegister 229 --, route postRegister 230 -- route viewPasswordReset 231 -- , route postPasswordReset 232 route viewLoginToken 233 , route postPasswordToken 234 -- , route resendInvestigator 235 236 , route viewParty 237 , route postParty 238 , route viewPartyEdit 239 -- , route viewPartyCreate 240 , route viewPartyDelete 241 , route viewAuthorize 242 , route postAuthorize 243 , route deleteAuthorize 244 , route postAuthorizeNotFound 245 , route viewAvatar 246 , route viewPartyActivity 247 , route createParty 248 , route deleteParty 249 , route queryParties 250 -- , route adminParties 251 -- , route csvParties 252 -- , route csvDuplicateParties 253 254 , route viewVolume 255 , route postVolume 256 , route viewVolumeEdit 257 , route postVolumeAccess 258 , route postVolumeLinks 259 , route postVolumeFunding 260 , route deleteVolumeFunder 261 , route postVolumeAssist 262 -- , route viewVolumeCreate 263 , route createVolume 264 , route queryVolumes 265 , route $ zipVolume False 266 , route $ zipVolume True 267 , route viewVolumeDescription 268 , route thumbVolume 269 , route csvVolume 270 , route viewVolumeActivity 271 272 , route createContainer 273 , route $ viewSlot False 274 , route viewContainerEdit 275 , route postContainer 276 , route deleteContainer 277 , route viewContainerActivity 278 , route $ zipContainer False 279 , route $ zipContainer True 280 , route thumbSlot 281 282 -- , route viewFormats 283 284 , route viewAsset 285 , route postAsset 286 , route deleteAsset 287 , route downloadAsset 288 , route downloadOrigAsset 289 , route thumbAsset 290 , route createAsset 291 , route createSlotAsset 292 293 , route (viewAssetSegment False) 294 , route downloadAssetSegment 295 , route downloadOrigAssetSegment 296 , route (thumbAssetSegment False) 297 , route postExcerpt 298 , route deleteExcerpt 299 300 , route createRecord 301 , route viewRecord 302 , route postRecordMeasure 303 , route deleteRecord 304 , route postRecordSlot 305 , route deleteRecordSlot 306 , route deleteRecordAllSlot 307 308 , route postVolumeMetric 309 , route deleteVolumeMetric 310 , route postVolumeState 311 , route deleteVolumeState 312 313 , route queryTags 314 , route postTag 315 , route deleteTag 316 , route postComment 317 318 -- , route postSearch 319 320 , route uploadStart 321 , route uploadChunk 322 , route testChunk 323 324 -- , route viewConstants 325 -- , route getCitation 326 -- , route queryFunder 327 , route remoteTranscode 328 -- , route viewSiteActivity 329 330 , route viewNotifications 331 , route deleteNotification 332 , route deleteNotifications 333 , route viewNotify 334 , route postNotify 335 336 -- , route viewTranscodes 337 , route postTranscode 338 , route viewIngest 339 , route postIngest 340 , route detectParticipantCSV 341 , route runParticipantUpload 342 -- , route viewPeriodic 343 -- , route postPeriodic 344 345 , route webFile 346 ] where 347 route = routeCase