Browse Source

Update: Move ip loc stuff back to backend proxy, improve admin and add list view

Sebastian Kreisel 1 year ago
parent
commit
0b37aef7f4

+ 8 - 4
TODO.txt

@@ -1,5 +1,7 @@
 -- Urgent
 -------------------------------------------------------------------------------
+* Backend: Remove paging from rubble list view
+* Backend: Polish list view in rubble (add selection etc)
 
 
 -- Big picture, Summer update
@@ -10,23 +12,23 @@
 * Edit: Fix Parsing Bugs
 * Edit: Make parsing response work again
 * Docker: Find a way to output stdcout from docker
-* Files: Make upload error BIG AND RED
-* Files: Upload cross non-clickable
-* Imageviewer: Overflow for long names (art-schiele)
+* Edit: On acc/ptype-change re-fetch
 
 * Style Refact: XHR Prodcedure
 * Style Refact: Rework Promise flow
 * Style Refact: Frontend Response System
 * Style Refact: Catch all possible IO Exceptions in Haskell
+* Style Refact: filedirectory CSS+HTML mess
 
 * Feature: Backend: Content type and View for email transcripts
-* Feature: Backend: Rubble: Post title list only
 
+* Misc: Make consistent color scheme for all of admin
 * Misc: Backend: Decide if admin access is 5 or 10 and make consistent
 * Misc: Backend: In serveAdminSite use real access mod not magic 10
 * Misc: Backend: Make MathJax inclusion stricter
 * Misc: Git: Restructure doc/deploy/docker/config into seperated (private) repo
 * Misc: Git: Improve README.txt
+* Misc: Think about and add a LICENSE
 
 
 -- Short Term
@@ -55,6 +57,7 @@
 * Frontend: Stop automatic safe if POST failes twice and start again
 * Backend: Prevent file-paths like ../../../../../etc/passwd
 * Backend: Remove nav-bar post redirect frm main + sperate post / drivel
+* Backend+Frontend: Prevent post double submits also with draft saving
 
 
 -- Longterm/Infrastructure
@@ -66,6 +69,7 @@
 -- Housekeeping
 -------------------------------------------------------------------------------
 
+* Backend: Clean up new ip-location related code in model and endpoint
 * Backend: Check on the mess that is image (directory) serving
 * Backend: Edit Endpoint: Fetch Access Magic Number 10
 * Backend: Url encode properly

+ 3 - 2
elfcom-backend/elfcom-backend.cabal

@@ -65,12 +65,13 @@ executable elfcom-backend-exe
                      , base16-bytestring
                      , base64-bytestring
                      , cryptohash
-                     , HTTP
+                     --, HTTP
                      , http-types
+                     , http-conduit
                      , resourcet
                      , aeson
                      , directory
                      , unix
                      , parseck >= 0.0.1
                      -- Required for script scripts/ConverOldMd.hs
-                     --, mdparser
+                     --, mdparser

+ 27 - 3
elfcom-backend/src/Endpoint/AccessLog.hs

@@ -13,11 +13,14 @@ import Data.Time
 import Data.Time.Calendar.MonthDay (monthLength)
 import Database.Persist.Sql (fromSqlKey)
 import Data.Aeson hiding (json)
-import Data.HVect hiding (tail)
+import Data.HVect hiding (tail, pack)
 import qualified Data.Text as T
 import Web.Spock hiding (head, SessionId)
 import Control.Concurrent.STM.TVar
 import GHC.Generics
+import Network.HTTP.Simple
+import Data.Monoid ((<>))
+import Data.ByteString.Lazy.Char8 (pack)
 
 import Common
 import Model.AccessLog
@@ -26,6 +29,7 @@ handleAccessLogEndpoints :: ListContains n IsAdmin xs => TVar Bool -> T.Text ->
                             App (HVect xs)
 handleAccessLogEndpoints lock logD = do
   post (baseRoute <//> "fetch") $ connectH (accessLogFetchHandler lock logD)
+  post (baseRoute <//> "loc") $ connectH accessLogLocHandler
   where baseRoute = "api" <//> "admin" <//> "accesslog"
 
 accessLogFetchHandler :: TVar Bool -> T.Text -> AccessLogFetchReq ->
@@ -41,13 +45,33 @@ accessLogFetchHandler lock logD (AccessLogFetchReq mtime) = do
   logtext <- liftIO $ readAccessLogFiles lock logD tim
   return $ AccessLogFetchOkay $ buildIpSummaries (AccessLogQuery tim) logtext
 
+accessLogLocHandler :: AccessLogLocReq -> Action ctx AccessLogLocRsp
+accessLogLocHandler (AccessLogLocReq iptext) = do
+  mloc <- liftIO $ fetchIpLocation iptext
+  case mloc of
+    Nothing -> return $ AccessLogLocFail ""
+    Just loc -> return $ AccessLogLocOkay loc
+
+fetchIpLocation :: T.Text -> IO (Maybe IpLocation)
+fetchIpLocation iptext = do
+  let urll = "https://ipapi.co/" <> iptext <> "/json/"
+  result <- httpLBS (parseRequest_ $ T.unpack urll)
+  return (decode $ getResponseBody result)
 
 data AccessLogFetchReq = AccessLogFetchReq {
-  fetTime :: !(Maybe (UTCTime, UTCTime))
-  }
+  fetTime :: !(Maybe (UTCTime, UTCTime)) }
                        deriving (Show, Eq, Generic, ToJSON, FromJSON)
 
 data AccessLogFetchRsp = AccessLogFetchOkay {
   fetContent :: ![AccessLogSummary] }
                        | AccessLogFetchFail { fetError :: !T.Text }
                        deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+data AccessLogLocReq = AccessLogLocReq {
+  locIp :: !T.Text }
+                     deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+data AccessLogLocRsp = AccessLogLocOkay {
+  locLoc :: !IpLocation }
+                     | AccessLogLocFail { locError :: !T.Text }
+                     deriving (Show, Eq, Generic, ToJSON, FromJSON)

+ 6 - 1
elfcom-backend/src/Main.hs

@@ -44,6 +44,7 @@ import View.Files
 import View.FileDirectory
 import View.Drivel
 import View.Post
+--import View.Tbn
 import Endpoint.Edit
 import Endpoint.Login
 import Endpoint.Files
@@ -101,6 +102,8 @@ app (SiteConfig isDev sessDur _ _ filesD logD uplDir) = do
     get "logout" $ withMUser $ \mu -> do
       rndE <- liftIO $ getRandomElf st elfl
       blaze $ logoutSite (ViewInfo "/logout" rndE v mu)
+    --get "tbn" $ blaze tbnSite
+
 
     -- Drivel GET
     get "rubble" $ withMUser getDrivel
@@ -184,6 +187,7 @@ getDrivel mu = do
   mselcats :: Maybe T.Text <- param "categories"
   mptypes :: Maybe T.Text <- param "ptypes"
   mdaccess :: Maybe T.Text <- param "access"
+  mviewmode :: Maybe T.Text <- param "view"
   let acc = maybeUserToAccess mu
   let ppp = 10 -- TODO MAGIC NUMBER
   let selCats = foo $ T.splitOn "," (fromMaybe "" mselcats)
@@ -192,7 +196,7 @@ getDrivel mu = do
                                  (fmap (T.splitOn " " ) mptypes))
   let ptypes = catMaybes $ map readMaybe ptypesText
   let daccess = fromMaybe Nothing $ fmap (readMaybe . T.unpack) mdaccess
-
+  let viewmode = fromMaybe "default" mviewmode
   -- SECURITY CRITICAL
   -- This is the final access used in SQL queries
   -- If access less than 10 always use acc, if not use daccess if provided
@@ -222,6 +226,7 @@ getDrivel mu = do
                , selectedCategories = selCats
                , ptypes = ptypes
                , daccess = daccess
+               , viewMode = viewmode
                , rndElf = rndE}
   let pquery = PostQuery
                { access = acc

+ 14 - 0
elfcom-backend/src/Model/AccessLog.hs

@@ -42,6 +42,20 @@ data AccessLogSummary = IpSummary {
   , sumAccessLine :: [(UTCTime, T.Text, T.Text)] }
                       deriving (Show, Eq, Generic, ToJSON, FromJSON)
 
+data IpLocation = IpLocation {
+  locIp :: T.Text
+  , locCity :: T.Text
+  , locCountry :: T.Text
+  , locCountryCode :: T.Text
+}
+                deriving (Show, Eq, Generic, ToJSON)
+
+instance FromJSON IpLocation where
+  parseJSON (Object v) = IpLocation <$> v .: "ip"
+                         <*> v .: "city"
+                         <*> v .: "country_name"
+                         <*> v .: "country"
+
 -- -------------------------------------------------------------------------
 
 queueAccessLogEntry :: TChan AccessLogEntry -> AccessLogEntry -> IO ()

+ 6 - 3
elfcom-backend/src/View/Admin.hs

@@ -41,12 +41,15 @@ adminMain now dailyImage post rubble userList = do
 adminAction :: Html
 adminAction = do
   div ! class_ "admin-action-entry" $ "What to do?"
+  --div ! class_ "admin-action-entry" $ "::"
+  --div ! class_ "admin-action-entry" $ a ! class_ "admin-alink"
+  --  ! href "/" $ "Home"
   div ! class_ "admin-action-entry" $ "::"
   div ! class_ "admin-action-entry" $ a ! class_ "admin-alink"
-    ! href "/" $ "Home"
+    ! href "/photos" $ "Photos"
   div ! class_ "admin-action-entry" $ "::"
   div ! class_ "admin-action-entry" $ a ! class_ "admin-alink"
-    ! href "/photos" $ "Photos"
+    ! href "/rubble?categories=List&ptypes=3&view=list" $ "Lists"
   div ! class_ "admin-action-entry" $ "::"
   div ! class_ "admin-action-entry" $ a ! class_ "admin-alink"
     ! href "/admin/edit" $ "Posts"
@@ -132,7 +135,7 @@ imageTime path =
 
 adminHeader :: Html
 adminHeader = div ! class_ "admin-header" $ do
-  a ! href "/admin" ! class_ "admin-header-link" $ "back to elfcom"
+  a ! href "/" ! class_ "admin-header-link" $ "back home"
 
 adminFooter :: Html
 adminFooter = div ! class_ "admin-footer" $ ""

+ 24 - 6
elfcom-backend/src/View/Drivel.hs

@@ -23,6 +23,7 @@ data DrivelState = DrivelState { currentTime :: UTCTime
                                , selectedCategories :: [T.Text]
                                , ptypes :: [Int]
                                , daccess :: Maybe Int
+                               , viewMode :: T.Text -- TODO: Make enum
                                , rndElf :: T.Text }
                  deriving Show
 
@@ -78,7 +79,7 @@ drivelRight dst acc = do
         div ! class_ "drivel-cat-cnt" $
           a!href (textValue$makeContHref cp selcats (togglePT 3 ptyps) dacc) !
           class_ (textValue $T.append "drivel-link " (foo (ptyps == [3]))) $
-          "Only Unlisted"
+          "Only Internal"
       _ -> return ()
     div ! class_ "drivel-cat-cnt" $
       a ! href "/rubble?p=0" ! class_ "drivel-link drivel-cat-inactive" $
@@ -114,7 +115,7 @@ togglePT x xs | xs == [x] = [1,2]
               | otherwise = [x]
 
 makeCatHref :: T.Text -> Bool -> DrivelState -> T.Text
-makeCatHref cat isSel (DrivelState _ cp _ _ selcats ptyps dacc _) =
+makeCatHref cat isSel (DrivelState _ cp _ _ selcats ptyps dacc _ _) =
   T.append "/rubble" (makeDrivelGetArgs cp
                       (textToMaybe $ T.intercalate "," (modSel (not isSel)))
                       ptyps dacc)
@@ -122,7 +123,7 @@ makeCatHref cat isSel (DrivelState _ cp _ _ selcats ptyps dacc _) =
         modSel False = delete cat selcats
 
 makeAccHref :: Int -> DrivelState -> T.Text
-makeAccHref selacc (DrivelState _ cp _ _ selcats ptyps dacc _) =
+makeAccHref selacc (DrivelState _ cp _ _ selcats ptyps dacc _ _) =
   T.append "/rubble" (makeDrivelGetArgs cp
                       (textToMaybe $ T.intercalate "," selcats)
                       ptyps (compacc dacc selacc))
@@ -149,8 +150,25 @@ drivelMiddle _ [] = div ! class_ "drivel-middle" $ do
       " all settings." :: Html
 drivelMiddle dst posts = div ! class_ "drivel-middle" $ do
   div ! class_ "drivel-middle-cnt" $ do
-    --toHtml $ postEntry (currentTime dst) True (head $ snd $ unzip posts)
-    toHtml $ map (postEntry (currentTime dst)) (snd $ unzip posts)
+    case (viewMode dst) of
+      "list" -> do
+        toHtml $ map (postListEntry (currentTime dst)) (snd $ unzip posts)
+      _ -> do
+        --toHtml $ postEntry (currentTime dst) True (head $ snd $ unzip posts)
+        toHtml $ map (postEntry (currentTime dst)) (snd $ unzip posts)
+
+postListEntry :: UTCTime -> Post -> Html
+postListEntry now (Post title _ url _ _ crtDate _ ptype _ _) = do
+  let timeDiff = diffUTCTime now crtDate
+  let timeString = formatTimeDuration timeDiff
+  div ! class_ "drivel-list-cnt" $ do
+    case ptype `elem` [1, 3] of
+      True -> do
+        div ! class_ "drivel-list-date" $ toHtml $ timeString ++ " ago"
+        div ! class_ "drivel-list-title font-info" $
+          a ! href (textValue url) ! class_ "drivel-post-link" $
+            toHtml (fromMaybe "" title)
+      False -> ""
 
 postEntry :: UTCTime -> Post -> Html
 postEntry now (Post title _ url cR _ crtDate _ ptype _ _) = do
@@ -239,7 +257,7 @@ drivelPage dst = do
                   | otherwise = " drivel-nav-link-unsel"
 
 makePageHref :: Int -> DrivelState -> T.Text
-makePageHref pth (DrivelState _ _ _ _ cats ptyps acc _) =
+makePageHref pth (DrivelState _ _ _ _ cats ptyps acc _ _) =
   T.append "/rubble" (makeDrivelGetArgs pth
                       (textToMaybe $ T.intercalate "," cats)
                       ptyps acc)

+ 14 - 0
elfcom-backend/static/css/site_drivel.css

@@ -113,6 +113,20 @@ div.drivel-post-readon {
     font-size: 12px;
 }
 
+div.drivel-list-cnt {
+  margin-bottom: 5px;
+  margin-left: 10px;
+}
+
+div.drivel-list-date {
+  display: inline-block;
+  font-size: 12px;
+  width: 100px;
+}
+
+div.drivel-list-title {
+  display: inline-block;
+}
 
 /* Right
  * ---------------------------------------------------------------------------

+ 17 - 22
elfcom-frontend/admin/log.js

@@ -187,34 +187,29 @@ function checkLocationStorage(ip) {
 
 function enqueueLocation(ip, locCont) {
   var locCounter = parseInt(window.localStorage.getItem("locCounter"));
-  if(locCounter < 140) {
+  if(locCounter < 300) {
     window.localStorage.setItem("locCounter", ("" + (locCounter + 1)));
-    fetch("https://geoip.nekudo.com/api/" + ip, {
-      mode: "cors",
-      method: "GET",
-      redirect: "follow",
-      referrer: "no-referrer",
-    })
+    var jsonObj = {
+      "locIp": ip,
+    };
+    Common.sendJson("/api/admin/accesslog/loc", jsonObj)
+      .then(res => res.json(),
+            () => { Common.fetchError("Fetch"); reject("ajax failed"); })
       .then(function(json) {
-        return json.json();
-      }, () => Common.generalError("ip loc svr"))
-      .then(function(resp) {
-        if(resp === undefined) {
-          return;
-        }
-        var validCC = typeof resp.country.code === "string";
-        var validCity = typeof resp.city === "string";
-        var loc = {
-          cc: (validCC ? resp.country.code : ""),
-          city: (validCity ? resp.city : ""),
-        };
-        if(validCC) {
+        if(json.tag === "AccessLogLocOkay") {
+          var loc = {
+            cc: json.locLoc.locCountryCode,
+            city: json.locLoc.locCity
+          };
+          console.log(loc);
           var locDict = JSON.parse(window.localStorage.getItem("locDict"));
           locDict[ip] = loc;
           window.localStorage.setItem("locDict", JSON.stringify(locDict));
+          setLocationContainer(loc, locCont);
+        } else {
+          Common.serverError("Fetch"); reject("server failed");
         }
-        setLocationContainer(loc, locCont);
-      }, () => Common.generalError("ip loc json"));
+      }, () => { Common.jsonError("Fetch"); reject("json failed"); });
   }
 }
 

+ 4 - 1
elfcom-frontend/files/upload.js

@@ -46,6 +46,7 @@ function uploadNext(sobjs) {
         .then(function() {
           c.uploadComplete = true;
           c.progDiv.innerHTML = "done";
+          c.progDiv.className += " files-usel-prog-done";
           c.domContentContainer.className = "files-usel-top files-usel-inactive";
           uploadNext(sobjs);
           var parentPath = sobjs.unmEl.value.split("/").slice(1).join("/");
@@ -55,6 +56,7 @@ function uploadNext(sobjs) {
         .catch(function() {
           c.hasError = true;
           c.progDiv.innerHTML = "error";
+          c.progDiv.className += " files-usel-prog-error";
           c.domContentContainer.className = "files-usel-top files-usel-inactive";
           uploadNext(sobjs);
           Common.generalError("Upload failed");
@@ -138,7 +140,8 @@ function createNode(sobjs, file) {
   var nameDiv = Common.createDomWith("div", "files-usel-name");
   var sizeDiv = Common.createDomWith("div", "files-usel-size");
   var progDiv = Common.createDomWith("div", "files-usel-prog");
-  var cancelDiv = Common.createDomWith("div", "files-usel-cancel");
+  var cancelDiv =
+    Common.createDomWith("div", "files-usel-cancel admin-noselect");
   nameDiv.innerHTML = file.name;
   sizeDiv.innerHTML = Common.formatBytes(file.size);
   progDiv.innerHTML = "0 B";