From eb50e5e5a02a10e921f960a33080a6f809080e04 Mon Sep 17 00:00:00 2001 From: Jack Wines Date: Mon, 12 Jun 2023 12:30:36 -0700 Subject: [PATCH] pesky changing ids bug squashed & added js libraries Now that the bug is squashed, I no longer need to pin acid-state to a specific version (I previously thought it was a bad version, it was actually storing the StdGen in the DB). Also you can now get a ballot (though not submit it). --- public/static/Sortable.min.js | 2 + public/static/script.js | 10 ++++ public/static/style.css | 10 +++- rcv-site.cabal | 2 +- src/API.hs | 2 +- src/AppM.hs | 8 ++- src/Database.hs | 18 ++----- src/Main.hs | 94 ++++++++++++++++++++++++++--------- src/Poll.hs | 2 +- 9 files changed, 104 insertions(+), 44 deletions(-) create mode 100644 public/static/Sortable.min.js create mode 100644 public/static/script.js diff --git a/public/static/Sortable.min.js b/public/static/Sortable.min.js new file mode 100644 index 0000000..17bb16c --- /dev/null +++ b/public/static/Sortable.min.js @@ -0,0 +1,2 @@ +/*! Sortable 1.15.0 - MIT | git://github.com/SortableJS/Sortable.git */ +!function(t,e){"object"==typeof exports&&"undefined"!=typeof module?module.exports=e():"function"==typeof define&&define.amd?define(e):(t=t||self).Sortable=e()}(this,function(){"use strict";function e(e,t){var n,o=Object.keys(e);return Object.getOwnPropertySymbols&&(n=Object.getOwnPropertySymbols(e),t&&(n=n.filter(function(t){return Object.getOwnPropertyDescriptor(e,t).enumerable})),o.push.apply(o,n)),o}function M(o){for(var t=1;tt.length)&&(e=t.length);for(var n=0,o=new Array(e);n"===e[0]&&(e=e.substring(1)),t))try{if(t.matches)return t.matches(e);if(t.msMatchesSelector)return t.msMatchesSelector(e);if(t.webkitMatchesSelector)return t.webkitMatchesSelector(e)}catch(t){return}}function N(t,e,n,o){if(t){n=n||document;do{if(null!=e&&(">"!==e[0]||t.parentNode===n)&&p(t,e)||o&&t===n)return t}while(t!==n&&(t=(i=t).host&&i!==document&&i.host.nodeType?i.host:i.parentNode))}var i;return null}var g,m=/\s+/g;function I(t,e,n){var o;t&&e&&(t.classList?t.classList[n?"add":"remove"](e):(o=(" "+t.className+" ").replace(m," ").replace(" "+e+" "," "),t.className=(o+(n?" "+e:"")).replace(m," ")))}function P(t,e,n){var o=t&&t.style;if(o){if(void 0===n)return document.defaultView&&document.defaultView.getComputedStyle?n=document.defaultView.getComputedStyle(t,""):t.currentStyle&&(n=t.currentStyle),void 0===e?n:n[e];o[e=!(e in o||-1!==e.indexOf("webkit"))?"-webkit-"+e:e]=n+("string"==typeof n?"":"px")}}function v(t,e){var n="";if("string"==typeof t)n=t;else do{var o=P(t,"transform")}while(o&&"none"!==o&&(n=o+" "+n),!e&&(t=t.parentNode));var i=window.DOMMatrix||window.WebKitCSSMatrix||window.CSSMatrix||window.MSCSSMatrix;return i&&new i(n)}function b(t,e,n){if(t){var o=t.getElementsByTagName(e),i=0,r=o.length;if(n)for(;i=n.left-e&&i<=n.right+e,e=r>=n.top-e&&r<=n.bottom+e;return o&&e?a=t:void 0}}),a);if(e){var n,o={};for(n in t)t.hasOwnProperty(n)&&(o[n]=t[n]);o.target=o.rootEl=e,o.preventDefault=void 0,o.stopPropagation=void 0,e[j]._onDragOver(o)}}var i,r,a}function Yt(t){q&&q.parentNode[j]._isOutsideThisEl(t.target)}function Bt(t,e){if(!t||!t.nodeType||1!==t.nodeType)throw"Sortable: `el` must be an HTMLElement, not ".concat({}.toString.call(t));this.el=t,this.options=e=a({},e),t[j]=this;var n,o,i={group:null,sort:!0,disabled:!1,store:null,handle:null,draggable:/^[uo]l$/i.test(t.nodeName)?">li":">*",swapThreshold:1,invertSwap:!1,invertedSwapThreshold:null,removeCloneOnHide:!0,direction:function(){return It(t,this.options)},ghostClass:"sortable-ghost",chosenClass:"sortable-chosen",dragClass:"sortable-drag",ignore:"a, img",filter:null,preventOnFilter:!0,animation:0,easing:null,setData:function(t,e){t.setData("Text",e.textContent)},dropBubble:!1,dragoverBubble:!1,dataIdAttr:"data-id",delay:0,delayOnTouchOnly:!1,touchStartThreshold:(Number.parseInt?Number:window).parseInt(window.devicePixelRatio,10)||1,forceFallback:!1,fallbackClass:"sortable-fallback",fallbackOnBody:!1,fallbackTolerance:0,fallbackOffset:{x:0,y:0},supportPointer:!1!==Bt.supportPointer&&"PointerEvent"in window&&!u,emptyInsertThreshold:5};for(n in K.initializePlugins(this,t,i),i)n in e||(e[n]=i[n]);for(o in Pt(e),this)"_"===o.charAt(0)&&"function"==typeof this[o]&&(this[o]=this[o].bind(this));this.nativeDraggable=!e.forceFallback&&Mt,this.nativeDraggable&&(this.options.touchStartThreshold=1),e.supportPointer?h(t,"pointerdown",this._onTapStart):(h(t,"mousedown",this._onTapStart),h(t,"touchstart",this._onTapStart)),this.nativeDraggable&&(h(t,"dragover",this),h(t,"dragenter",this)),Et.push(this.el),e.store&&e.store.get&&this.sort(e.store.get(this)||[]),a(this,x())}function Ft(t,e,n,o,i,r,a,l){var s,c,u=t[j],d=u.options.onMove;return!window.CustomEvent||y||w?(s=document.createEvent("Event")).initEvent("move",!0,!0):s=new CustomEvent("move",{bubbles:!0,cancelable:!0}),s.to=e,s.from=t,s.dragged=n,s.draggedRect=o,s.related=i||e,s.relatedRect=r||k(e),s.willInsertAfter=l,s.originalEvent=a,t.dispatchEvent(s),c=d?d.call(u,s,a):c}function jt(t){t.draggable=!1}function Ht(){Ct=!1}function Lt(t){return setTimeout(t,0)}function Kt(t){return clearTimeout(t)}Bt.prototype={constructor:Bt,_isOutsideThisEl:function(t){this.el.contains(t)||t===this.el||(gt=null)},_getDirection:function(t,e){return"function"==typeof this.options.direction?this.options.direction.call(this,t,e,q):this.options.direction},_onTapStart:function(e){if(e.cancelable){var n=this,o=this.el,t=this.options,i=t.preventOnFilter,r=e.type,a=e.touches&&e.touches[0]||e.pointerType&&"touch"===e.pointerType&&e,l=(a||e).target,s=e.target.shadowRoot&&(e.path&&e.path[0]||e.composedPath&&e.composedPath()[0])||l,c=t.filter;if(!function(t){Tt.length=0;var e=t.getElementsByTagName("input"),n=e.length;for(;n--;){var o=e[n];o.checked&&Tt.push(o)}}(o),!q&&!(/mousedown|pointerdown/.test(r)&&0!==e.button||t.disabled)&&!s.isContentEditable&&(this.nativeDraggable||!u||!l||"SELECT"!==l.tagName.toUpperCase())&&!((l=N(l,t.draggable,o,!1))&&l.animated||J===l)){if(nt=B(l),it=B(l,t.draggable),"function"==typeof c){if(c.call(this,e,l,this))return U({sortable:n,rootEl:s,name:"filter",targetEl:l,toEl:o,fromEl:o}),z("filter",n,{evt:e}),void(i&&e.cancelable&&e.preventDefault())}else if(c=c&&c.split(",").some(function(t){if(t=N(s,t.trim(),o,!1))return U({sortable:n,rootEl:t,name:"filter",targetEl:l,fromEl:o,toEl:o}),z("filter",n,{evt:e}),!0}))return void(i&&e.cancelable&&e.preventDefault());t.handle&&!N(s,t.handle,o,!1)||this._prepareDragStart(e,a,l)}}},_prepareDragStart:function(t,e,n){var o,i=this,r=i.el,a=i.options,l=r.ownerDocument;n&&!q&&n.parentNode===r&&(o=k(n),$=r,V=(q=n).parentNode,Q=q.nextSibling,J=n,at=a.group,st={target:Bt.dragged=q,clientX:(e||t).clientX,clientY:(e||t).clientY},ht=st.clientX-o.left,ft=st.clientY-o.top,this._lastX=(e||t).clientX,this._lastY=(e||t).clientY,q.style["will-change"]="all",o=function(){z("delayEnded",i,{evt:t}),Bt.eventCanceled?i._onDrop():(i._disableDelayedDragEvents(),!s&&i.nativeDraggable&&(q.draggable=!0),i._triggerDragStart(t,e),U({sortable:i,name:"choose",originalEvent:t}),I(q,a.chosenClass,!0))},a.ignore.split(",").forEach(function(t){b(q,t.trim(),jt)}),h(l,"dragover",Xt),h(l,"mousemove",Xt),h(l,"touchmove",Xt),h(l,"mouseup",i._onDrop),h(l,"touchend",i._onDrop),h(l,"touchcancel",i._onDrop),s&&this.nativeDraggable&&(this.options.touchStartThreshold=4,q.draggable=!0),z("delayStart",this,{evt:t}),!a.delay||a.delayOnTouchOnly&&!e||this.nativeDraggable&&(w||y)?o():Bt.eventCanceled?this._onDrop():(h(l,"mouseup",i._disableDelayedDrag),h(l,"touchend",i._disableDelayedDrag),h(l,"touchcancel",i._disableDelayedDrag),h(l,"mousemove",i._delayedDragTouchMoveHandler),h(l,"touchmove",i._delayedDragTouchMoveHandler),a.supportPointer&&h(l,"pointermove",i._delayedDragTouchMoveHandler),i._dragStartTimer=setTimeout(o,a.delay)))},_delayedDragTouchMoveHandler:function(t){t=t.touches?t.touches[0]:t;Math.max(Math.abs(t.clientX-this._lastX),Math.abs(t.clientY-this._lastY))>=Math.floor(this.options.touchStartThreshold/(this.nativeDraggable&&window.devicePixelRatio||1))&&this._disableDelayedDrag()},_disableDelayedDrag:function(){q&&jt(q),clearTimeout(this._dragStartTimer),this._disableDelayedDragEvents()},_disableDelayedDragEvents:function(){var t=this.el.ownerDocument;f(t,"mouseup",this._disableDelayedDrag),f(t,"touchend",this._disableDelayedDrag),f(t,"touchcancel",this._disableDelayedDrag),f(t,"mousemove",this._delayedDragTouchMoveHandler),f(t,"touchmove",this._delayedDragTouchMoveHandler),f(t,"pointermove",this._delayedDragTouchMoveHandler)},_triggerDragStart:function(t,e){e=e||"touch"==t.pointerType&&t,!this.nativeDraggable||e?this.options.supportPointer?h(document,"pointermove",this._onTouchMove):h(document,e?"touchmove":"mousemove",this._onTouchMove):(h(q,"dragend",this),h($,"dragstart",this._onDragStart));try{document.selection?Lt(function(){document.selection.empty()}):window.getSelection().removeAllRanges()}catch(t){}},_dragStarted:function(t,e){var n;yt=!1,$&&q?(z("dragStarted",this,{evt:e}),this.nativeDraggable&&h(document,"dragover",Yt),n=this.options,t||I(q,n.dragClass,!1),I(q,n.ghostClass,!0),Bt.active=this,t&&this._appendGhost(),U({sortable:this,name:"start",originalEvent:e})):this._nulling()},_emulateDragOver:function(){if(ct){this._lastX=ct.clientX,this._lastY=ct.clientY,kt();for(var t=document.elementFromPoint(ct.clientX,ct.clientY),e=t;t&&t.shadowRoot&&(t=t.shadowRoot.elementFromPoint(ct.clientX,ct.clientY))!==e;)e=t;if(q.parentNode[j]._isOutsideThisEl(t),e)do{if(e[j])if(e[j]._onDragOver({clientX:ct.clientX,clientY:ct.clientY,target:t,rootEl:e})&&!this.options.dragoverBubble)break}while(e=(t=e).parentNode);Rt()}},_onTouchMove:function(t){if(st){var e=this.options,n=e.fallbackTolerance,o=e.fallbackOffset,i=t.touches?t.touches[0]:t,r=Z&&v(Z,!0),a=Z&&r&&r.a,l=Z&&r&&r.d,e=Ot&&bt&&E(bt),a=(i.clientX-st.clientX+o.x)/(a||1)+(e?e[0]-_t[0]:0)/(a||1),l=(i.clientY-st.clientY+o.y)/(l||1)+(e?e[1]-_t[1]:0)/(l||1);if(!Bt.active&&!yt){if(n&&Math.max(Math.abs(i.clientX-this._lastX),Math.abs(i.clientY-this._lastY))n.right+10||t.clientX<=n.right&&t.clientY>n.bottom&&t.clientX>=n.left:t.clientX>n.right&&t.clientY>n.top||t.clientX<=n.right&&t.clientY>n.bottom+10}(n,r,this)&&!g.animated){if(g===q)return O(!1);if((l=g&&a===n.target?g:l)&&(w=k(l)),!1!==Ft($,a,q,o,l,w,n,!!l))return x(),g&&g.nextSibling?a.insertBefore(q,g.nextSibling):a.appendChild(q),V=a,A(),O(!0)}else if(g&&function(t,e,n){n=k(X(n.el,0,n.options,!0));return e?t.clientX * { +.options > * { flex-direction: row; display: flex; + background-color: white; } diff --git a/rcv-site.cabal b/rcv-site.cabal index a691c18..1915ad7 100644 --- a/rcv-site.cabal +++ b/rcv-site.cabal @@ -37,7 +37,7 @@ executable server hs-source-dirs: src build-depends: - acid-state == 0.16.1.2, + acid-state, aeson, base, bytestring, diff --git a/src/API.hs b/src/API.hs index b5699e0..fdf64c0 100644 --- a/src/API.hs +++ b/src/API.hs @@ -11,7 +11,7 @@ type RCVAPI = :<|> "create" :> ReqBody '[JSON] P.CreatePollInfo :> Post '[SL.HTML] (L.Html ()) :<|> "create" :> "newInput" :> Get '[SL.HTML] (L.Html ()) :<|> "create" :> "removeInput" :> Get '[SL.HTML] (L.Html ()) - -- :<|> "api" :> "poll" :> Capture "pollId" P.PollId :> "vote" :> Get '[JSON] P.CreatePollInfo + :<|> "poll" :> Capture "pollId" P.PollId :> Get '[SL.HTML] (L.Html ()) -- :<|> "api" :> "poll" :> Capture "pollId" P.PollId :> "vote" :> ReqBody '[JSON] B.Ballot :> Post '[JSON] () -- :<|> "api" :> "poll" :> Capture "pollId" P.PollId :> "results" :> Get '[JSON] P.Result :<|> StaticAPI diff --git a/src/AppM.hs b/src/AppM.hs index c66dec7..62953fa 100644 --- a/src/AppM.hs +++ b/src/AppM.hs @@ -3,11 +3,15 @@ import qualified Control.Monad.Reader as Rd import qualified Database as DB import Servant.Server import qualified Data.Acid as Ac +import qualified Data.Text as T +import qualified System.Random.Stateful as R -- presumably this will become more complex as we need other things in scope -newtype Env = Env +data Env = Env { - db :: Ac.AcidState DB.DB + db :: Ac.AcidState DB.DB, + script :: T.Text, + gen :: R.AtomicGenM R.StdGen } type AppM = Rd.ReaderT Env Handler diff --git a/src/Database.hs b/src/Database.hs index 980bbbd..6417893 100644 --- a/src/Database.hs +++ b/src/Database.hs @@ -2,31 +2,24 @@ module Database where import qualified Data.Acid as Ac import qualified Data.Map.Strict as M -import qualified Data.Set as S import qualified Control.Monad.Reader as MR import qualified Control.Monad.State as MS import qualified Data.SafeCopy as SC import qualified Data.Typeable as Ty import qualified Poll as P import qualified Ballot as B -import qualified System.Random as R -import qualified System.Random.SplitMix as SM -import qualified Data.Bifunctor as Bi data DB = DB { - gen :: R.StdGen, polls :: M.Map P.PollId P.Poll } deriving (Show, Ty.Typeable) deriving instance Ty.Typeable P.Poll deriving instance Ty.Typeable B.Ballot -createPoll :: MS.MonadState DB m => P.CreatePollInfo -> m P.PollId -createPoll createInfo = MS.state go +createPoll :: MS.MonadState DB m => P.CreatePollInfo -> P.PollId -> m () +createPoll createInfo pollId = MS.modify go where - go DB {..} = (pollId, DB {polls = M.insert pollId insertedPoll polls, gen = gen'}) - where - (pollId, gen') = Bi.first P.PollId . R.genWord32 $ gen + go DB {..} = DB {polls = M.insert pollId insertedPoll polls} insertedPoll = P.Poll { @@ -57,12 +50,9 @@ $(SC.deriveSafeCopy 0 'SC.base ''P.CreatePollInfo) $(SC.deriveSafeCopy 0 'SC.base ''B.Ballot) $(SC.deriveSafeCopy 0 'SC.base ''P.Poll) $(SC.deriveSafeCopy 0 'SC.base ''P.PollId) -$(SC.deriveSafeCopy 0 'SC.base ''SM.SMGen) -$(SC.deriveSafeCopy 0 'SC.base ''R.StdGen) $(SC.deriveSafeCopy 0 'SC.base ''DB) Ac.makeAcidic ''DB['createPoll, 'getPollForBallot, 'getPoll, 'postBallot, 'getPollIds, 'getDB] openLocalDB :: IO (Ac.AcidState DB) openLocalDB = do - gen <- R.getStdGen - Ac.openLocalStateFrom "state" $ DB gen M.empty + Ac.openLocalStateFrom "./state" $ DB M.empty diff --git a/src/Main.hs b/src/Main.hs index 844a6bb..b0846ef 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -16,22 +16,17 @@ import qualified Data.List.NonEmpty as LN import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as M import qualified Data.Maybe as My -import qualified Data.Set as S -import Lucid.Htmx as L import qualified Data.Text as T import qualified Database as DB import qualified Error as Er import qualified InstantRunoff as IR -import qualified Network.Wai as W import qualified Network.Wai.Handler.Warp as W import qualified Network.Wai.Handler.WarpTLS as WTLS import qualified Poll as P import qualified System.Environment as S +import qualified Data.Text.IO as TIO +import qualified System.Random.Stateful as R -getPollForBallot :: P.PollId -> AppM P.CreatePollInfo -getPollForBallot pollId = do - db <- Rd.asks db - getFromPollId pollId (liftIO . Ac.query db . DB.GetPollForBallot) throwOrLift :: AppM a -> Maybe a -> AppM a throwOrLift err = My.maybe err pure @@ -59,13 +54,14 @@ mapFromHash = M.fromList . map (\x -> (H.hash x, x)) makePoll :: P.CreatePollInfo -> AppM (L.Html ()) makePoll pollReq = do db <- Rd.asks db - (P.PollId pollId) <- liftIO $ Ac.update db (DB.CreatePoll pollReq) + gen <- Rd.asks gen + pollId <- P.PollId <$> R.uniformWord64 gen + liftIO $ Ac.update db (DB.CreatePoll pollReq pollId) let fillOutLink = T.append "https://rankedchoice.net/poll/" (T.pack . show $ pollId) pure $ do "done! people can fill out your poll at " with a_ [href_ fillOutLink] (toHtml fillOutLink) - vote :: P.PollId -> B.Ballot -> AppM () vote pollId ballot = do db <- Rd.asks db @@ -73,30 +69,63 @@ vote pollId ballot = do pure () server :: ServerT A.RCVAPI AppM -server = createPage :<|> makePoll :<|> pure optionInput :<|> (pure . pure $ ()) :<|> serveDirectoryWith ((defaultWebAppSettings "public")) +server = createPage + :<|> makePoll + :<|> pure optionInput + :<|> (pure . pure $ ()) + :<|> getPollForBallot + :<|> serveDirectoryWith ((defaultWebAppSettings "public")) -pageHead :: L.Html () -pageHead = head_ $ do - link_ [href_ "/static/style.css", rel_ "stylesheet"] - link_ [href_ "/static/paper.min.css", rel_ "stylesheet"] - link_ [href_ "/static/fonts.css", rel_ "stylesheet"] - with (script_ "") [src_ "/static/htmx.min.js"] - with (script_ "") [src_ "/static/json-enc.js"] + + +getPollForBallot :: P.PollId -> AppM (L.Html ()) +getPollForBallot pollId = do + db <- Rd.asks db + createInfo <- getFromPollId pollId (liftIO . Ac.query db . DB.GetPollForBallot) + fullPage $ do + My.maybe (pure ()) (h3_ . toHtml) (P.title createInfo) + h3_ . toHtml . P.question $ createInfo + with form_ [hxPost_ ""] $ do + with div_ [classes_ ["sortable", "options", "child-borders", "border-primary", "background-primary"]] . mconcat . map toFormInput . LN.toList . P.options $ createInfo + input_ [type_ "submit", classes_ ["paper-btn", "btn-primary"], value_ "submit"] + where + toFormInput :: T.Text -> L.Html () + toFormInput option = with div_ [classes_ []] $ input_ [type_ "hidden", value_ option, name_ "options"] <> toHtml option + +fullPage rest = do + customHead <- pageHead + pure $ doctypehtml_ $ do + customHead + pageBody rest + +pageHead :: AppM (L.Html ()) +pageHead = do + script <- Rd.asks script + pure . head_ $ do + link_ [href_ "/static/style.css", rel_ "stylesheet"] + link_ [href_ "/static/paper.min.css", rel_ "stylesheet"] + link_ [href_ "/static/fonts.css", rel_ "stylesheet"] + with (script_ "") [src_ "/static/Sortable.min.js"] + with (script_ "") [src_ "/static/htmx.min.js"] + with (script_ "") [src_ "/static/json-enc.js"] + script_ script + +pageBody :: L.Html () -> L.Html () +pageBody = with body_ [classes_ ["container", "container-sm", "paper"], hxExt_ "json-enc"] optionInput :: L.Html () optionInput = div_ $ input_ [required_ "true", name_ "options", maxlength_ "100"] <> - with button_ [classes_ ["btn", "btn-warning-outline"], hxGet_ "create/removeInput", hxSwap_ "delete", hxTarget_ "closest #options-create > *"] "remove" + with button_ [classes_ ["btn", "btn-warning-outline"], hxGet_ "create/removeInput", hxSwap_ "delete", hxTarget_ "closest .options > *"] "remove" createPage :: AppM (L.Html ()) -createPage = pure $ do - pageHead - with body_ [classes_ ["container", "container-sm", "paper"], hxExt_ "json-enc"] $ do +createPage = do + fullPage $ do h2_ "create a poll" with form_ [id_ "inputs", hxPost_ "/create", hxTarget_ "body"] $ do with label_ [for_ "title"] "title (optional)" <> input_ [name_ "title", type_ "text", maxlength_ "100"] with label_ [for_ "question"] "question" <> input_ [name_ "question", type_ "text", required_ "true", maxlength_ "100"] - with fieldset_ [name_ "options", id_ "options-create"] $ do + with fieldset_ [name_ "options", class_ "options"] $ do legend_ "options" optionInput optionInput @@ -106,18 +135,37 @@ createPage = pure $ do api :: Proxy A.RCVAPI api = Proxy -getEnv = Env <$> DB.openLocalDB +getEnv :: IO Env +getEnv = do + db <- DB.openLocalDB + script <- TIO.readFile "public/static/script.js" + let gen = R.globalStdGen + pure $ Env {..} runWithEnv :: Env -> AppM a -> Handler a runWithEnv = flip Rd.runReaderT +tlsSettings :: WTLS.TLSSettings tlsSettings = WTLS.tlsSettings "/etc/letsencrypt/live/rankedchoice.net/cert.pem" "/etc/letsencrypt/live/rankedchoice.net/privkey.pem" + +warpSettings :: W.Settings warpSettings = W.setPort 443 W.defaultSettings +examplePoll = P.CreatePollInfo { + title = Nothing, + question = "what's your favorite color?", + options = "red" LN.:| ["blue", "green", "yellow"] + } + main :: IO () main = do env <- getEnv opts <- S.getArgs + -- let gen = R.globalStdGen + -- pollId <- P.PollId <$> R.uniformWord64 gen + -- _ <- liftIO $ Ac.update (db env) (DB.CreatePoll examplePoll (pollId)) + pollids <- liftIO . Ac.query (db env) $ DB.GetPollIds + print pollids let application = serve api . hoistServer api (runWithEnv env) $ server case opts of ["--with-tls"] -> WTLS.runTLS tlsSettings warpSettings application diff --git a/src/Poll.hs b/src/Poll.hs index 6d74fcc..8dfbbb5 100644 --- a/src/Poll.hs +++ b/src/Poll.hs @@ -20,7 +20,7 @@ newtype Result = Result } deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON, DS.NFData) -newtype PollId = PollId Word32 deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON, DS.NFData) +newtype PollId = PollId Word64 deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON, DS.NFData) instance FromHttpApiData PollId where parseUrlPiece = Bi.second PollId . parseUrlPiece