Compare commits

..

6 Commits

Author SHA1 Message Date
56e1823589 Fix api 2018-09-29 22:24:21 +03:00
0cae4d898c Rename generator 2018-09-29 21:42:27 +03:00
c883efcf41 Prefix api path with api/ 2018-09-29 21:40:18 +03:00
f2665335b3 Remove preceding equals 2018-09-29 21:35:50 +03:00
e6cf2bc659 Ignore all the nix results 2018-09-29 21:30:33 +03:00
cdaf3339c8 Add cabal-install to shell dependencies 2018-09-29 21:29:44 +03:00
5 changed files with 15 additions and 16 deletions

2
.gitignore vendored
View File

@ -1,2 +1,2 @@
result
result*
dist/

View File

@ -52,7 +52,7 @@ executable rauhala-api
hs-source-dirs: executables
default-language: Haskell2010
executable generator
executable rauhala-api-js-gen
main-is: generator.hs
-- other-modules:
-- other-extensions:

View File

@ -16,6 +16,7 @@ let
_pkgs.binutils-unwrapped
haskellPackages.ghcid
haskellPackages.hasktags
haskellPackages.cabal-install
(haskellPackages.ghcWithHoogle (_: pkg.buildInputs ++ pkg.propagatedBuildInputs))
];
};

View File

@ -10,11 +10,11 @@ import ClassyPrelude
import qualified API.IPFS as IPFS
import Network.HTTP.Media ((//), (/:))
import Text.Pandoc.Class (runPure)
import Text.Pandoc.Options (def)
import Text.Pandoc.Readers.Markdown (readMarkdown)
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Class (runPure, PandocMonad)
import Text.Pandoc.Options (def)
import Network.HTTP.Media ((//), (/:))
data HTML
@ -29,7 +29,7 @@ instance MimeRender HTML Docs where
instance Accept HTML where
contentType _ = "text" // "html" /: ("charset", "utf-8")
type API = "ipfs" :> IPFS.API
type API = "api" :> ("ipfs" :> IPFS.API)
type DocumentedAPI = API
:<|> "help" :> Get '[PlainText, HTML] Docs

View File

@ -5,12 +5,10 @@
module Server.IPFS where
import API.IPFS
import Servant
import ClassyPrelude
import Network.DNS
import ClassyPrelude hiding (hash)
import Control.Lens (over, _Left)
import Network.DNS
import Servant
handler :: Server API
handler = liftIO getHash >>= either (const (throwError err500)) return
@ -23,6 +21,6 @@ handler = liftIO getHash >>= either (const (throwError err500)) return
-- This is terrible
return (eTxt >>= maybe (Left "Could not find dnslink") Right . hash)
hash [x] = case x of
(stripPrefix "dnslink" -> Just h) -> Just . VersionHash . decodeUtf8 $ h
(stripPrefix "dnslink=" -> Just h) -> Just . VersionHash . decodeUtf8 $ h
_ -> Nothing
hash _ = Nothing